ref: ui: Pull register and theme options into UIOpts.

hledger-ui/Hledger/UI/Main.hs

@@ -121,12 +121,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportspec_=rsp
         filteredQuery q = simplifyQuery $ And [queryFromFlags ropts, filtered q]
           where filtered = filterQuery (\x -> not $ queryIsDepth x || queryIsDate x)
 
-    -- XXX move this stuff into Options, UIOpts
-    theme = maybe defaultTheme (fromMaybe defaultTheme . getTheme) $
-            maybestringopt "theme" $ rawopts_ copts
-    mregister = maybestringopt "register" $ rawopts_ copts
-
-    (scr, prevscrs) = case mregister of
+    (scr, prevscrs) = case uoRegister uopts' of
       Nothing   -> (accountsScreen, [])
       -- with --register, start on the register screen, and also put
       -- the accounts screen on the prev screens stack so you can exit
@@ -165,7 +160,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportspec_=rsp
     brickapp :: App UIState AppEvent Name
     brickapp = App {
         appStartEvent   = return
-      , appAttrMap      = const theme
+      , appAttrMap      = const $ fromMaybe defaultTheme $ getTheme =<< uoTheme uopts'
       , appChooseCursor = showFirstCursor
       , appHandleEvent  = \ui ev -> sHandle (aScreen ui) ui ev
       , appDraw         = \ui    -> sDraw   (aScreen ui) ui

hledger-ui/Hledger/UI/UIOptions.hs

@@ -8,12 +8,13 @@ where
 
 import Data.Default (def)
 import Data.List (intercalate)
+import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
 import Lens.Micro (set)
 import System.Environment (getArgs)
 
 import Hledger.Cli hiding (packageversion, progname, prognameandversion)
-import Hledger.UI.Theme (themeNames)
+import Hledger.UI.Theme (themes, themeNames)
 
 -- cf Hledger.Cli.Version
 
@@ -64,34 +65,35 @@ uimode =  (mode "hledger-ui" (setopt "command" "ui" def)
            }
 
 -- hledger-ui options, used in hledger-ui and above
-data UIOpts = UIOpts {
-     watch_       :: Bool
-    ,cliopts_     :: CliOpts
- } deriving (Show)
+data UIOpts = UIOpts
+  { watch_     :: Bool
+  , uoTheme    :: Maybe String
+  , uoRegister :: Maybe String
+  , cliopts_   :: CliOpts
+  } deriving (Show)
 
 defuiopts = UIOpts
-  { watch_   = False
-  , cliopts_ = def
+  { watch_     = False
+  , uoTheme    = Nothing
+  , uoRegister = Nothing
+  , cliopts_   = defcliopts
   }
 
--- instance Default CliOpts where def = defcliopts
-
+-- | Process a RawOpts into a UIOpts.
+-- This will return a usage error if provided an invalid theme.
 rawOptsToUIOpts :: RawOpts -> IO UIOpts
-rawOptsToUIOpts rawopts = checkUIOpts <$> do
-  -- show historical balance by default (unlike hledger)
-  let accum = fromMaybe Historical $ balanceAccumulationOverride rawopts
-  cliopts <- set balanceaccum accum <$> rawOptsToCliOpts rawopts
-  return defuiopts {
-              watch_       = boolopt "watch" rawopts
-             ,cliopts_     = cliopts
-             }
-
-checkUIOpts :: UIOpts -> UIOpts
-checkUIOpts opts =
-  either usageError (const opts) $ do
-    case maybestringopt "theme" $ rawopts_ $ cliopts_ opts of
-      Just t | t `notElem` themeNames -> Left $ "invalid theme name: "++t
-      _                               -> Right ()
+rawOptsToUIOpts rawopts = do
+    cliopts <- set balanceaccum accum <$> rawOptsToCliOpts rawopts
+    return defuiopts {
+                watch_     = boolopt "watch" rawopts
+               ,uoTheme    = checkTheme <$> maybestringopt "theme" rawopts
+               ,uoRegister = maybestringopt "register" rawopts
+               ,cliopts_   = cliopts
+               }
+  where
+    -- show historical balance by default (unlike hledger)
+    accum = fromMaybe Historical $ balanceAccumulationOverride rawopts
+    checkTheme t = if t `M.member` themes then t else usageError $ "invalid theme name: " ++ t
 
 -- XXX some refactoring seems due
 getHledgerUIOpts :: IO UIOpts