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
  34     = DataDir FilePath
  35     | LockSize Int
  36     | ForceCurses
  37     | Help
  38     | Version
  39     deriving (Eq, Ord, Show)
  40
  41 options =
  42     [ Option ['d'] ["datadir"] (ReqArg DataDir "PATH") "user data and conf directory (default: ~/.intricacy)"
  43     , Option ['c'] ["curses"] (NoArg ForceCurses) "force curses UI"
  44     , Option ['s'] ["locksize"] (ReqArg (LockSize . read) "SIZE") "locksize"
  45     , Option ['h'] ["help"] (NoArg Help) "show usage information"
  46     , Option ['v'] ["version"] (NoArg Version) "show version information"
  47     ]
  48
  49 usage :: String
  50 usage = usageInfo header options
  51     where header = "Usage: intricacy [OPTION...] [file]"
  52
  53 parseArgs :: [String] -> IO ([Opt],[String])
  54 parseArgs argv =
  55     case getOpt Permute options argv of
  56         (o,n,[])   -> return (o,n)
  57         (_,_,errs) -> ioError (userError (concat errs ++ usage))
  58
  59 setup :: IO (Maybe (Lock, Maybe Solution), [Opt], Maybe String)
  60 setup = do
  61     argv <- getArgs
  62     (opts,args) <- parseArgs argv
  63     when (Help `elem` opts) $ putStr usage >> exitSuccess
  64     when (Version `elem` opts) $ putStrLn version >> exitSuccess
  65     let size = fromMaybe 8 $ listToMaybe [ size | LockSize size <- opts ]
  66     mapM_ (setEnv "INTRICACY_PATH") [ dir | DataDir dir <- opts ]
  67
  68     curDir <- getCurrentDirectory
  69     (fromJust <$>) $ runMaybeT $ msum
  70         [ do
  71             path <- liftMaybe ((curDir </>) <$> listToMaybe args)
  72             msum [ do
  73                     (lock, msoln) <- MaybeT (readLock path)
  74                     return (Just (reframe lock, msoln), opts, Just path)
  75                 , return (Just (baseLock size, Nothing), opts, Just path) ]
  76         , return (Nothing, opts, Nothing) ]
  77
  78 main' :: (UIMonad s, UIMonad c) =>
  79         Maybe (s MainState -> IO (Maybe MainState)) ->
  80         Maybe (c MainState -> IO (Maybe MainState)) -> IO ()
  81 main' msdlUI mcursesUI = do
  82     (mlock,opts,mpath) <- setup
  83     initMState <- case mlock of
  84             Just (lock, msoln) -> return $ newEditState lock msoln mpath
  85             Nothing            -> initMetaState
  86     void $ runMaybeT $ msum [ do
  87             finalState <- msum
  88                 [ do
  89                     guard $ ForceCurses `notElem` opts
  90                     sdlUI <- liftMaybe msdlUI
  91                     MaybeT $ sdlUI $ interactUI `execStateT` initMState
  92                 , do
  93                     cursesUI <- liftMaybe mcursesUI
  94                     MaybeT $ cursesUI $ interactUI `execStateT` initMState
  95                 ]
  96             lift $ writeMetaState finalState
  97             lift exitSuccess
  98         , lift exitFailure ]