slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib,ui: Make sure ReportSpec is updated when updating ReportOpts.

Browse Source
This commit is contained in:
Stephen Morgan 2020-11-09 13:01:24 +11:00 committed by Simon Michael
parent 3caf82c003
commit 74ce7be556
2 changed files with 53 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -18,6 +18,7 @@ module Hledger.Reports.ReportOptions (
rawOptsToReportOpts, rawOptsToReportOpts,
defreportspec, defreportspec,
reportOptsToSpec, reportOptsToSpec,
updateReportSpecFromOpts,
rawOptsToReportSpec, rawOptsToReportSpec,
flat_, flat_,
tree_, tree_,
@ -244,6 +245,10 @@ reportOptsToSpec day ropts = do
, rsQueryOpts = queryopts , 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. -- | Generate a ReportSpec from RawOpts and the current date.
rawOptsToReportSpec :: RawOpts -> IO ReportSpec rawOptsToReportSpec :: RawOpts -> IO ReportSpec
rawOptsToReportSpec rawopts = do rawOptsToReportSpec rawopts = do

93
hledger-ui/Hledger/UI/UIState.hs
View File

@ -53,14 +53,16 @@ uiShowStatus copts ss =
showstatus Unmarked = "unmarked" showstatus Unmarked = "unmarked"
reportSpecToggleStatusSomehow :: Status -> CliOpts -> ReportSpec -> ReportSpec 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 where
ropts = case maybeposintopt "status-toggles" $ rawopts_ copts of update = case maybeposintopt "status-toggles" $ rawopts_ copts of
Just 2 -> reportOptsToggleStatus2 s ropts Just 2 -> reportOptsToggleStatus2 s
Just 3 -> reportOptsToggleStatus3 s ropts Just 3 -> reportOptsToggleStatus3 s
-- Just 4 -> reportOptsToggleStatus4 s ropts -- Just 4 -> reportOptsToggleStatus4 s
-- Just 5 -> reportOptsToggleStatus5 s ropts -- Just 5 -> reportOptsToggleStatus5 s
_ -> reportOptsToggleStatus1 s ropts _ -> reportOptsToggleStatus1 s
-- 1 UPC toggles only X/all -- 1 UPC toggles only X/all
reportOptsToggleStatus1 s ropts@ReportOpts{statuses_=ss} 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. -- | Toggle between showing all and showing only real (non-virtual) items.
toggleReal :: UIState -> UIState toggleReal :: UIState -> UIState
toggleReal ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} = toggleReal ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} =
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=toggleReal ropts}}}} ui{aopts=uopts{cliopts_=copts{reportspec_=update rspec}}}
where 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. -- | Toggle the ignoring of balance assertions.
toggleIgnoreBalanceAssertions :: UIState -> UIState toggleIgnoreBalanceAssertions :: UIState -> UIState
@ -198,52 +201,53 @@ toggleIgnoreBalanceAssertions ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOp
-- | Step through larger report periods, up to all. -- | Step through larger report periods, up to all.
growReportPeriod :: Day -> UIState -> UIState growReportPeriod :: Day -> UIState -> UIState
growReportPeriod _d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} = growReportPeriod _d = updateReportPeriod periodGrow
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodGrow $ period_ ropts}}}}}
-- | Step through smaller report periods, down to a day. -- | Step through smaller report periods, down to a day.
shrinkReportPeriod :: Day -> UIState -> UIState shrinkReportPeriod :: Day -> UIState -> UIState
shrinkReportPeriod d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} = shrinkReportPeriod d = updateReportPeriod (periodShrink d)
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodShrink d $ period_ ropts}}}}}
-- | Step the report start/end dates to the next period of same duration, -- | Step the report start/end dates to the next period of same duration,
-- remaining inside the given enclosing span. -- remaining inside the given enclosing span.
nextReportPeriod :: DateSpan -> UIState -> UIState nextReportPeriod :: DateSpan -> UIState -> UIState
nextReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{period_=p}}}}} = nextReportPeriod enclosingspan = updateReportPeriod (periodNextIn enclosingspan)
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodNextIn enclosingspan p}}}}}
-- | Step the report start/end dates to the next period of same duration, -- | Step the report start/end dates to the next period of same duration,
-- remaining inside the given enclosing span. -- remaining inside the given enclosing span.
previousReportPeriod :: DateSpan -> UIState -> UIState previousReportPeriod :: DateSpan -> UIState -> UIState
previousReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{period_=p}}}}} = previousReportPeriod enclosingspan = updateReportPeriod (periodPreviousIn enclosingspan)
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodPreviousIn enclosingspan p}}}}}
-- | If a standard report period is set, step it forward/backward if needed so that -- | If a standard report period is set, step it forward/backward if needed so that
-- it encloses the given date. -- it encloses the given date.
moveReportPeriodToDate :: Day -> UIState -> UIState moveReportPeriodToDate :: Day -> UIState -> UIState
moveReportPeriodToDate d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{period_=p}}}}} = moveReportPeriodToDate d = updateReportPeriod (periodMoveTo d)
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodMoveTo d p}}}}}
-- | Get the report period. -- | Get the report period.
reportPeriod :: UIState -> Period reportPeriod :: UIState -> Period
reportPeriod UIState{aopts=UIOpts{cliopts_=CliOpts{reportspec_=ReportSpec{rsOpts=ReportOpts{period_=p}}}}} = reportPeriod = period_ . rsOpts . reportspec_ . cliopts_ . aopts
p
-- | Set the report period. -- | Set the report period.
setReportPeriod :: Period -> UIState -> UIState setReportPeriod :: Period -> UIState -> UIState
setReportPeriod p ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} = setReportPeriod p = updateReportPeriod (const p)
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=p}}}}}
-- | Clear any report period limits. -- | Clear any report period limits.
resetReportPeriod :: UIState -> UIState resetReportPeriod :: UIState -> UIState
resetReportPeriod = setReportPeriod PeriodAll 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. -- | Apply a new filter query.
setFilter :: String -> UIState -> UIState setFilter :: String -> UIState -> UIState
setFilter s ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} = setFilter s ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} =
ui{aopts=uopts{cliopts_=copts{reportspec_=newrspec}}} ui{aopts=uopts{cliopts_=copts{reportspec_=update rspec}}}
where 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 querystring = words'' prefixes $ T.pack s
-- | Reset some filters & toggles. -- | Reset some filters & toggles.
@ -266,8 +270,7 @@ resetOpts :: UIState -> UIState
resetOpts ui@UIState{astartupopts} = ui{aopts=astartupopts} resetOpts ui@UIState{astartupopts} = ui{aopts=astartupopts}
resetDepth :: UIState -> UIState resetDepth :: UIState -> UIState
resetDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} = resetDepth = updateReportDepth (const Nothing)
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=Nothing}}}}}
-- | Get the maximum account depth in the current journal. -- | Get the maximum account depth in the current journal.
maxDepth :: UIState -> Int 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, -- | Decrement the current depth limit towards 0. If there was no depth limit,
-- set it to one less than the maximum account depth. -- set it to one less than the maximum account depth.
decDepth :: UIState -> UIState decDepth :: UIState -> UIState
decDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}}}}} decDepth ui = updateReportDepth dec ui
= ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=dec depth_}}}}}
where where
dec (Just d) = Just $ max 0 (d-1) dec (Just d) = Just $ max 0 (d-1)
dec Nothing = Just $ maxDepth ui - 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 -- | Increment the current depth limit. If this makes it equal to the
-- the maximum account depth, remove the depth limit. -- the maximum account depth, remove the depth limit.
incDepth :: UIState -> UIState incDepth :: UIState -> UIState
incDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}}}}} incDepth = updateReportDepth (fmap succ)
= 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
-- | Set the current depth limit to the specified depth, or remove the depth limit. -- | 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 -- 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 -- maximum account depth. If the specified depth is negative, reset the depth limit
-- to whatever was specified at uiartup. -- to whatever was specified at uiartup.
setDepth :: Maybe Int -> UIState -> UIState setDepth :: Maybe Int -> UIState -> UIState
setDepth mdepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} setDepth mdepth = updateReportDepth (const mdepth)
= 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
getDepth :: UIState -> Maybe Int 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. -- | Open the minibuffer, setting its content to the current query with the cursor at the end.
showMinibuffer :: UIState -> UIState showMinibuffer :: UIState -> UIState