Init.hs

   1 -- This file is part of Intricacy
   2 -- Copyright (C) 2013 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 module Init where
  12
  13
  14 import           Control.Applicative
  15 import           Control.Monad
  16 import           Control.Monad.Trans
  17 import           Control.Monad.Trans.Maybe
  18 import           Control.Monad.Trans.State
  19 import           Data.Maybe
  20 import           System.Console.GetOpt
  21 import           System.Directory
  22 import           System.Environment
  23 import           System.Exit
  24 import           System.FilePath
  25
  26 import           Interact
  27 import           Lock
  28 import           MainState
  29 import           Mundanities
  30 import           Util
  31 import           Version
  32
  33 data Opt = LockSize Int | ForceCurses | Help | Version
  34     deriving (Eq, Ord, Show)
  35 options =
  36     [ Option ['c'] ["curses"] (NoArg ForceCurses) "force curses UI"
  37     , Option ['s'] ["locksize"] (ReqArg (LockSize . read) "SIZE") "locksize"
  38     , Option ['h'] ["help"] (NoArg Help) "show usage information"
  39     , Option ['v'] ["version"] (NoArg Version) "show version information"
  40     ]
  41
  42 usage :: String
  43 usage = usageInfo header options
  44     where header = "Usage: intricacy [OPTION...] [file]"
  45
  46 parseArgs :: [String] -> IO ([Opt],[String])
  47 parseArgs argv =
  48     case getOpt Permute options argv of
  49         (o,n,[])   -> return (o,n)
  50         (_,_,errs) -> ioError (userError (concat errs ++ usage))
  51
  52 setup :: IO (Maybe Lock,[Opt],Maybe String)
  53 setup = do
  54     argv <- getArgs
  55     (opts,args) <- parseArgs argv
  56     when (Help `elem` opts) $ putStr usage >> exitSuccess
  57     when (Version `elem` opts) $ putStrLn version >> exitSuccess
  58     let size = fromMaybe 8 $ listToMaybe [ size | LockSize size <- opts ]
  59     curDir <- getCurrentDirectory
  60     (fromJust <$>) $ runMaybeT $ msum
  61         [ do
  62             path <- liftMaybe ((curDir </>) <$> listToMaybe args)
  63             msum [ do
  64                     lock <- reframe.fst <$> MaybeT (readLock path)
  65                     return (Just lock,opts,Just path)
  66                 , return (Just $ baseLock size, opts, Just path) ]
  67         , return (Nothing,opts,Nothing) ]
  68
  69 main' :: (UIMonad s, UIMonad c) =>
  70         Maybe (s MainState -> IO (Maybe MainState)) ->
  71         Maybe (c MainState -> IO (Maybe MainState)) -> IO ()
  72 main' msdlUI mcursesUI = do
  73     (mlock,opts,mpath) <- setup
  74     initMState <- case mlock of
  75             Just lock -> return $ newEditState lock Nothing mpath
  76             Nothing   -> initMetaState
  77     void $ runMaybeT $ msum [ do
  78             finalState <- msum
  79                 [ do
  80                     guard $ ForceCurses `notElem` opts
  81                     sdlUI <- liftMaybe msdlUI
  82                     MaybeT $ sdlUI $ interactUI `execStateT` initMState
  83                 , do
  84                     cursesUI <- liftMaybe mcursesUI
  85                     MaybeT $ cursesUI $ interactUI `execStateT` initMState
  86                 ]
  87             lift $ writeMetaState finalState
  88             lift exitSuccess
  89         , lift exitFailure ]