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.Exit
  21 import System.Environment
  22 import System.Directory
  23 import System.FilePath
  24 import System.Console.GetOpt
  25
  26 import Lock
  27 import MainState
  28 import Interact
  29 import Util
  30 import Version
  31
  32 data Opt = LockSize Int | ForceCurses | Help | Version
  33     deriving (Eq, Ord, Show)
  34 options =
  35     [ Option ['c'] ["curses"] (NoArg ForceCurses) "force curses UI"
  36     , Option ['s'] ["locksize"] (ReqArg (LockSize . read) "SIZE") "locksize"
  37     , Option ['h'] ["help"] (NoArg Help) "show usage information"
  38     , Option ['v'] ["version"] (NoArg Version) "show version information"
  39     ]
  40
  41 usage :: String
  42 usage = usageInfo header options
  43     where header = "Usage: intricacy [OPTION...] [file]"
  44
  45 parseArgs :: [String] -> IO ([Opt],[String])
  46 parseArgs argv =
  47     case getOpt Permute options argv of
  48         (o,n,[]) -> return (o,n)
  49         (_,_,errs) -> ioError (userError (concat errs ++ usage))
  50
  51 setup :: IO (Maybe Lock,[Opt],Maybe String)
  52 setup = do
  53     argv <- getArgs
  54     (opts,args) <- parseArgs argv
  55     when (Help `elem` opts) $ putStr usage >> exitSuccess
  56     when (Version `elem` opts) $ putStrLn version >> exitSuccess
  57     let size = fromMaybe 8 $ listToMaybe [ size | LockSize size <- opts ]
  58     curDir <- getCurrentDirectory
  59     (fromJust <$>) $ runMaybeT $ msum
  60         [ do
  61             path <- liftMaybe ((curDir </>) <$> listToMaybe args)
  62             msum [ do
  63                     lock <- reframe.fst <$> MaybeT (readLock path)
  64                     return (Just lock,opts,Just path)
  65                 , return (Just $ baseLock size, opts, Just path) ]
  66         , return (Nothing,opts,Nothing) ]
  67
  68 main' :: (UIMonad s, UIMonad c) =>
  69         Maybe (s MainState -> IO (Maybe MainState)) ->
  70         Maybe (c MainState -> IO (Maybe MainState)) -> IO ()
  71 main' msdlUI mcursesUI = do
  72     (mlock,opts,mpath) <- setup
  73     initMState <- case mlock of
  74             Nothing -> initMetaState
  75             Just lock -> return $ newEditState lock Nothing mpath
  76     void $ runMaybeT $ msum [ do
  77             finalState <- msum
  78                 [ do
  79                     guard $ ForceCurses `notElem` opts
  80                     sdlUI <- liftMaybe $ msdlUI
  81                     MaybeT $ sdlUI $ interactUI `execStateT` initMState
  82                 , do
  83                     cursesUI <- liftMaybe $ mcursesUI
  84                     MaybeT $ cursesUI $ interactUI `execStateT` initMState
  85                 ]
  86             when (isNothing mlock) $ lift $ writeMetaState finalState
  87             lift $ exitSuccess
  88         , lift exitFailure ]