Parse command line args

app/Main.hs

@@ -2,35 +2,93 @@
 
 module Main where
 
+import           Control.Applicative
+import           Control.Monad
+import           System.Exit
+
+import qualified Brick.Themes        as B
+import qualified Options.Applicative as O
+
+import qualified TaskMachine.UI      as TM
+
+data Options = Options
+  { oExportDefaultTheme :: [String]
+  , oThemePaths         :: [FilePath]
+  } deriving (Show)
+
+argParser :: O.Parser Options
+argParser = pure Options
+  <*> many exportDefaultTheme
+  <*> many themePaths
+  where
+    exportDefaultTheme = O.strOption $ mconcat
+      [ O.short 'T'
+      , O.long "export-default-theme"
+      , O.help "Export the application's default theme to a file.\
+               \ This can be used as a starting point for a custom theme."
+      , O.metavar "THEMEFILE"
+      ]
+    themePaths = O.strOption $ mconcat
+      [ O.short 't'
+      , O.long "theme"
+      , O.help "Specify one or more theme files to load.\
+               \ This flag can be set zero or more times."
+      , O.metavar "THEME"
+      ]
+
+argParserInfo :: O.ParserInfo Options
+argParserInfo = O.info (O.helper <*> argParser) mempty
+
+-- Log an action (prefixes "-> ")
+action :: String -> IO ()
+action = putStrLn . ("-> " ++)
+
+-- Could probably implement using EitherT, but too lazy :)
+loadThemes :: B.Theme -> [FilePath] -> IO (Either String B.Theme)
+loadThemes theme [] = return $ Right theme
+loadThemes theme (path:paths) = do
+  action $ "Loading theme " ++ show path ++ "."
+  eModifiedTheme <- B.loadCustomizations path theme
+  case eModifiedTheme of
+    Left e  -> return $ Left e
+    Right t -> loadThemes t paths
+
+main :: IO ()
+main = do
+  options <- O.execParser argParserInfo
+
+  -- Good ol' debug print
+  if False then putStrLn "- The Options -" >> (putStrLn $ show options) else return ()
+
+  -- Exporting default theme
+  forM_ (oExportDefaultTheme options) $ \path -> do
+    action $ "Exporting default theme to " ++ show path ++ "."
+    B.saveTheme path TM.defaultTheme
+
+  -- Loading themes and running the program
+  eTheme <- loadThemes TM.defaultTheme $ oThemePaths options
+  case eTheme of
+    Left errMsg -> die errMsg
+    Right theme -> error "Implement actual program logic" theme
+
 --import qualified Database.SQLite.Simple as DB
 --import qualified TaskMachine.Database as TMD
 --main = DB.withConnection "test.db" TMD.initializeNewDB
 
-import           Control.Monad
+--data ResourceName = Asdf
-import           Data.Monoid
+--  deriving (Eq, Ord)
-
+--
-import qualified Brick          as B
+--myApp :: B.App () () ResourceName
-import qualified Brick.Themes   as B
+--myApp = B.App
-
+--  { B.appDraw         = \_ -> [myTestWidget]
-import qualified TaskMachine.UI as TM
+--  , B.appHandleEvent  = B.resizeOrQuit
-
+--  , B.appStartEvent   = \s -> return s
-data ResourceName = Asdf
+--  , B.appChooseCursor = B.neverShowCursor
-  deriving (Eq, Ord)
+--  , B.appAttrMap      = const $ B.themeToAttrMap TM.defaultTheme
-
+--  }
-myApp :: B.App () () ResourceName
+--  where
-myApp = B.App
+--    myTestWidget = normal B.<=> urgent B.<=> veryUrgent B.<=> overdue
-  { B.appDraw         = \_ -> [myTestWidget]
+--    normal     = B.withAttr ("taskList"                 <> "normal") (B.str "     normal ") B.<+> B.withAttr ("taskList"                 <> "highlight") (B.str "style")
-  , B.appHandleEvent  = B.resizeOrQuit
+--    urgent     = B.withAttr ("taskList" <> "urgent"     <> "normal") (B.str "     urgent ") B.<+> B.withAttr ("taskList" <> "urgent"     <> "highlight") (B.str "style")
-  , B.appStartEvent   = \s -> return s
+--    veryUrgent = B.withAttr ("taskList" <> "veryUrgent" <> "normal") (B.str "very urgent ") B.<+> B.withAttr ("taskList" <> "veryUrgent" <> "highlight") (B.str "style")
-  , B.appChooseCursor = B.neverShowCursor
+--    overdue    = B.withAttr ("taskList" <> "overdue"    <> "normal") (B.str "    overdue ") B.<+> B.withAttr ("taskList" <> "overdue"    <> "highlight") (B.str "style")
-  , B.appAttrMap      = const $ B.themeToAttrMap TM.defaultTheme
-  }
-  where
-    myTestWidget = normal B.<=> urgent B.<=> veryUrgent B.<=> overdue
-    normal     = B.withAttr ("taskList"                 <> "normal") (B.str "     normal ") B.<+> B.withAttr ("taskList"                 <> "highlight") (B.str "style")
-    urgent     = B.withAttr ("taskList" <> "urgent"     <> "normal") (B.str "     urgent ") B.<+> B.withAttr ("taskList" <> "urgent"     <> "highlight") (B.str "style")
-    veryUrgent = B.withAttr ("taskList" <> "veryUrgent" <> "normal") (B.str "very urgent ") B.<+> B.withAttr ("taskList" <> "veryUrgent" <> "highlight") (B.str "style")
-    overdue    = B.withAttr ("taskList" <> "overdue"    <> "normal") (B.str "    overdue ") B.<+> B.withAttr ("taskList" <> "overdue"    <> "highlight") (B.str "style")
-
-main :: IO ()
-main = void $ B.defaultMain myApp ()

package.yaml

@@ -24,6 +24,7 @@ dependencies:
 - sqlite-simple
 - brick
 - vty
+- optparse-applicative
   #- containers
   #- unordered-containers
   #- text