From 74ce7be556288a5bac027949e900828f9d39c689 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Mon, 9 Nov 2020 13:01:24 +1100 Subject: [PATCH] lib,ui: Make sure ReportSpec is updated when updating ReportOpts. --- hledger-lib/Hledger/Reports/ReportOptions.hs | 5 ++ hledger-ui/Hledger/UI/UIState.hs | 93 ++++++++++---------- 2 files changed, 53 insertions(+), 45 deletions(-) diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 9f12cab82..dd0e52de3 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -18,6 +18,7 @@ module Hledger.Reports.ReportOptions ( rawOptsToReportOpts, defreportspec, reportOptsToSpec, + updateReportSpecFromOpts, rawOptsToReportSpec, flat_, tree_, @@ -244,6 +245,10 @@ reportOptsToSpec day ropts = do , rsQueryOpts = queryopts } +-- | Regenerate a ReportSpec after updating ReportOpts. +updateReportSpecFromOpts :: (ReportOpts -> ReportOpts) -> ReportSpec -> Either String ReportSpec +updateReportSpecFromOpts f rspec = reportOptsToSpec (rsToday rspec) . f $ rsOpts rspec + -- | Generate a ReportSpec from RawOpts and the current date. rawOptsToReportSpec :: RawOpts -> IO ReportSpec rawOptsToReportSpec rawopts = do diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index 2baa712f1..1cb95bbdb 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -53,14 +53,16 @@ uiShowStatus copts ss = showstatus Unmarked = "unmarked" reportSpecToggleStatusSomehow :: Status -> CliOpts -> ReportSpec -> ReportSpec -reportSpecToggleStatusSomehow s copts rspec = rspec{rsOpts=ropts} +reportSpecToggleStatusSomehow s copts = + either (error "reportSpecToggleStatusSomehow: updating Status should not result in an error") id -- PARTIAL: + . updateReportSpecFromOpts update where - ropts = case maybeposintopt "status-toggles" $ rawopts_ copts of - Just 2 -> reportOptsToggleStatus2 s ropts - Just 3 -> reportOptsToggleStatus3 s ropts --- Just 4 -> reportOptsToggleStatus4 s ropts --- Just 5 -> reportOptsToggleStatus5 s ropts - _ -> reportOptsToggleStatus1 s ropts + update = case maybeposintopt "status-toggles" $ rawopts_ copts of + Just 2 -> reportOptsToggleStatus2 s + Just 3 -> reportOptsToggleStatus3 s +-- Just 4 -> reportOptsToggleStatus4 s +-- Just 5 -> reportOptsToggleStatus5 s + _ -> reportOptsToggleStatus1 s -- 1 UPC toggles only X/all reportOptsToggleStatus1 s ropts@ReportOpts{statuses_=ss} @@ -186,10 +188,11 @@ toggleForecast d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec -- | Toggle between showing all and showing only real (non-virtual) items. toggleReal :: UIState -> UIState -toggleReal ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} = - ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=toggleReal ropts}}}} +toggleReal ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} = + ui{aopts=uopts{cliopts_=copts{reportspec_=update rspec}}} where - toggleReal ropts = ropts{real_=not $ real_ ropts} + update = either (error "toggleReal: updating Real should not result in an error") id -- PARTIAL: + . updateReportSpecFromOpts (\ropts -> ropts{real_=not $ real_ ropts}) -- | Toggle the ignoring of balance assertions. toggleIgnoreBalanceAssertions :: UIState -> UIState @@ -198,52 +201,53 @@ toggleIgnoreBalanceAssertions ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOp -- | Step through larger report periods, up to all. growReportPeriod :: Day -> UIState -> UIState -growReportPeriod _d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} = - ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodGrow $ period_ ropts}}}}} +growReportPeriod _d = updateReportPeriod periodGrow -- | Step through smaller report periods, down to a day. shrinkReportPeriod :: Day -> UIState -> UIState -shrinkReportPeriod d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} = - ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodShrink d $ period_ ropts}}}}} +shrinkReportPeriod d = updateReportPeriod (periodShrink d) -- | Step the report start/end dates to the next period of same duration, -- remaining inside the given enclosing span. nextReportPeriod :: DateSpan -> UIState -> UIState -nextReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{period_=p}}}}} = - ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodNextIn enclosingspan p}}}}} +nextReportPeriod enclosingspan = updateReportPeriod (periodNextIn enclosingspan) -- | Step the report start/end dates to the next period of same duration, -- remaining inside the given enclosing span. previousReportPeriod :: DateSpan -> UIState -> UIState -previousReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{period_=p}}}}} = - ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodPreviousIn enclosingspan p}}}}} +previousReportPeriod enclosingspan = updateReportPeriod (periodPreviousIn enclosingspan) -- | If a standard report period is set, step it forward/backward if needed so that -- it encloses the given date. moveReportPeriodToDate :: Day -> UIState -> UIState -moveReportPeriodToDate d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{period_=p}}}}} = - ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodMoveTo d p}}}}} +moveReportPeriodToDate d = updateReportPeriod (periodMoveTo d) -- | Get the report period. reportPeriod :: UIState -> Period -reportPeriod UIState{aopts=UIOpts{cliopts_=CliOpts{reportspec_=ReportSpec{rsOpts=ReportOpts{period_=p}}}}} = - p +reportPeriod = period_ . rsOpts . reportspec_ . cliopts_ . aopts -- | Set the report period. setReportPeriod :: Period -> UIState -> UIState -setReportPeriod p ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} = - ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=p}}}}} +setReportPeriod p = updateReportPeriod (const p) -- | Clear any report period limits. resetReportPeriod :: UIState -> UIState resetReportPeriod = setReportPeriod PeriodAll +-- | Update report period by a applying a function. +updateReportPeriod :: (Period -> Period) -> UIState -> UIState +updateReportPeriod updatePeriod ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} = + ui{aopts=uopts{cliopts_=copts{reportspec_=update rspec}}} + where + update = either (error "updateReportPeriod: updating period should not result in an error") id -- PARTIAL: + . updateReportSpecFromOpts (\ropts -> ropts{period_=updatePeriod $ period_ ropts}) + -- | Apply a new filter query. setFilter :: String -> UIState -> UIState -setFilter s ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} = - ui{aopts=uopts{cliopts_=copts{reportspec_=newrspec}}} +setFilter s ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} = + ui{aopts=uopts{cliopts_=copts{reportspec_=update rspec}}} where - newrspec = either (const rspec) id $ reportOptsToSpec (rsToday rspec) ropts{querystring_=querystring} + update = either (const rspec) id . updateReportSpecFromOpts (\ropts -> ropts{querystring_=querystring}) querystring = words'' prefixes $ T.pack s -- | Reset some filters & toggles. @@ -266,8 +270,7 @@ resetOpts :: UIState -> UIState resetOpts ui@UIState{astartupopts} = ui{aopts=astartupopts} resetDepth :: UIState -> UIState -resetDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} = - ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=Nothing}}}}} +resetDepth = updateReportDepth (const Nothing) -- | Get the maximum account depth in the current journal. maxDepth :: UIState -> Int @@ -276,8 +279,7 @@ maxDepth UIState{ajournal=j} = maximum $ map accountNameLevel $ journalAccountNa -- | Decrement the current depth limit towards 0. If there was no depth limit, -- set it to one less than the maximum account depth. decDepth :: UIState -> UIState -decDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}}}}} - = ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=dec depth_}}}}} +decDepth ui = updateReportDepth dec ui where dec (Just d) = Just $ max 0 (d-1) dec Nothing = Just $ maxDepth ui - 1 @@ -285,28 +287,29 @@ decDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ -- | Increment the current depth limit. If this makes it equal to the -- the maximum account depth, remove the depth limit. incDepth :: UIState -> UIState -incDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}}}}} - = ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=inc depth_}}}}} - where - inc (Just d) | d < (maxDepth ui - 1) = Just $ d+1 - inc _ = Nothing +incDepth = updateReportDepth (fmap succ) -- | Set the current depth limit to the specified depth, or remove the depth limit. -- Also remove the depth limit if the specified depth is greater than the current -- maximum account depth. If the specified depth is negative, reset the depth limit -- to whatever was specified at uiartup. setDepth :: Maybe Int -> UIState -> UIState -setDepth mdepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} - = ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=mdepth'}}}}} - where - mdepth' = case mdepth of - Nothing -> Nothing - Just d | d < 0 -> depth_ ropts - | d >= maxDepth ui -> Nothing - | otherwise -> mdepth +setDepth mdepth = updateReportDepth (const mdepth) getDepth :: UIState -> Maybe Int -getDepth UIState{aopts=UIOpts{cliopts_=CliOpts{reportspec_=rspec}}} = depth_ $ rsOpts rspec +getDepth = depth_ . rsOpts . reportspec_ . cliopts_ . aopts + +-- | Update report depth by a applying a function. If asked to set a depth less +-- than zero, it will leave it unchanged. +updateReportDepth :: (Maybe Int -> Maybe Int) -> UIState -> UIState +updateReportDepth updateDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} = + ui{aopts=uopts{cliopts_=copts{reportspec_=update rspec}}} + where + update = either (error "updateReportDepth: updating depth should not result in an error") id -- PARTIAL: + . updateReportSpecFromOpts (\ropts -> ropts{depth_=updateDepth (depth_ ropts) >>= clipDepth ropts}) + clipDepth ropts d | d < 0 = depth_ ropts + | d >= maxDepth ui = Nothing + | otherwise = Just d -- | Open the minibuffer, setting its content to the current query with the cursor at the end. showMinibuffer :: UIState -> UIState