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           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 ]