diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 59c5aae3a..7a34ac186 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -45,7 +45,7 @@ initAccountsScreen mselacct d st@AppState{ ajournal=j, aScreen=s@AccountsScreen{} } = - st{aopts=opts', aScreen=s{asState=l'}} + st{aopts=uopts', aScreen=s{asState=l'}} where l = list (Name "accounts") (V.fromList displayitems) 1 @@ -59,29 +59,14 @@ initAccountsScreen mselacct d st@AppState{ mi = findIndex (\((acct,_,_),_) -> acct==a') items a' = maybe a (flip clipAccountName a) $ depth_ ropts - -- XXX messing around with depth, which is different from other queries - -- In hledger, - -- - reportopts{depth_} indicates --depth options - -- - reportopts{query_} is the query arguments as a string - -- - the report query is based on both of these. - -- For hledger-ui, currently, we move depth: arguments out of reportopts{query_} - -- and into reportopts{depth_}, so that depth and other kinds of filter query - -- can be displayed independently. - opts' = uopts{cliopts_=copts{reportopts_=ropts'}} + uopts' = uopts{cliopts_=copts{reportopts_=ropts'}} + ropts' = ropts { + -- XXX balanceReport doesn't respect this yet + balancetype_=HistoricalBalance + } + q = queryFromOpts d ropts - ropts' = ropts - { - -- ensure depth_ also reflects depth: args - depth_=depthfromoptsandargs, - -- remove depth: args from query_ - query_=unwords $ -- as in ReportOptions, with same limitations - [v | (k,v) <- rawopts_ copts, k=="args", not $ "depth" `isPrefixOf` v], - -- XXX balanceReport doesn't respect this yet - balancetype_=HistoricalBalance - } - where - depthfromoptsandargs = case queryDepth q of 99999 -> Nothing - d -> Just d + -- maybe convert balances to market value convert | value_ ropts' = balanceReportValue j valuedate | otherwise = id diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 1b3866984..2a2f8357f 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -15,7 +15,7 @@ import Control.Monad -- import Control.Monad.IO.Class (liftIO) -- import Data.Default -- import Data.Monoid -- --- import Data.List +import Data.List import Data.Maybe -- import Data.Time.Calendar import Safe @@ -56,28 +56,67 @@ withJournalDoUICommand uopts@UIOpts{cliopts_=copts} cmd = do either error' (cmd uopts . journalApplyAliases (aliasesFromOpts copts)) ej runBrickUi :: UIOpts -> Journal -> IO () -runBrickUi opts j = do +runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do d <- getCurrentDay let + + -- depth: is a bit different from other queries. In hledger cli, + -- - reportopts{depth_} indicates --depth options + -- - reportopts{query_} is the query arguments as a string + -- - the report query is based on both of these. + -- For hledger-ui, for now, move depth: arguments out of reportopts{query_} + -- and into reportopts{depth_}, so that depth and other kinds of filter query + -- can be displayed independently. + uopts' = uopts{ + cliopts_=copts{ + reportopts_= ropts{ + -- ensure depth_ also reflects depth: args + depth_=depthfromoptsandargs, + -- remove depth: args from query_ + query_=unwords $ -- as in ReportOptions, with same limitations + [v | (k,v) <- rawopts_ copts, k=="args", not $ "depth" `isPrefixOf` v] + } + } + } + where + q = queryFromOpts d ropts + depthfromoptsandargs = case queryDepth q of 99999 -> Nothing + d -> Just d + -- XXX move this stuff into Options, UIOpts theme = maybe defaultTheme (fromMaybe defaultTheme . getTheme) $ - maybestringopt "theme" $ rawopts_ $ cliopts_ opts - mshowacct = maybestringopt "register" $ rawopts_ $ cliopts_ opts - scr = case mshowacct of - Nothing -> AS.screen - Just apat -> RS.screen{rsAcct=acct} + maybestringopt "theme" $ rawopts_ copts + mregister = maybestringopt "register" $ rawopts_ copts + + (scr, prevscrs) = case mregister of + Nothing -> (AS.screen, []) + -- with --register, start on the register screen, and also put + -- the accounts screen on the prev screens stack so you can exit + -- to that as usual. + Just apat -> (RS.screen{rsAcct=acct}, [ascr']) where acct = headDef (error' $ "--register "++apat++" did not match any account") $ filter (regexMatches apat) $ journalAccountNames j + -- Initialising the accounts screen is awkward, requiring + -- another temporary AppState value.. + ascr = AS.screen + ascr' = aScreen $ + (sInitFn ascr) d + AppState{ + aopts=uopts' + ,ajournal=j + ,aScreen=ascr + ,aPrevScreens=[] + } st = (sInitFn scr) d AppState{ - aopts=opts + aopts=uopts' ,ajournal=j ,aScreen=scr - ,aPrevScreens=[] + ,aPrevScreens=prevscrs } app :: App (AppState) V.Event @@ -86,8 +125,13 @@ runBrickUi opts j = do , appStartEvent = return , appAttrMap = const theme , appChooseCursor = showFirstCursor - , appHandleEvent = \st ev -> (sHandleFn $ aScreen st) st ev - , appDraw = \st -> (sDrawFn $ aScreen st) st + , appHandleEvent = \st ev -> sHandleFn (aScreen st) st ev + , appDraw = \st -> sDrawFn (aScreen st) st + -- XXX bizarro. removing the st arg and parameter above, + -- which according to GHCI does not change the type, + -- causes "Exception: draw function called with wrong screen type" + -- on entering a register. Likewise, removing the st ev args and parameters + -- causes an exception on exiting a register. } void $ defaultMain app st