diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index d59dd516a..6a54d6cd0 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/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 diff --git a/hledger-ui/Hledger/UI/UIOptions.hs b/hledger-ui/Hledger/UI/UIOptions.hs index e480bf130..8399a7048 100644 --- a/hledger-ui/Hledger/UI/UIOptions.hs +++ b/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