ref: ui: lens: Use lenses in UIState, saving a lot of boilerplate.
This commit is contained in:
Stephen Morgan
Simon Michael
parent
f471258a48
commit
7f7f1a2cdf
@ -14,26 +14,23 @@ import Data.Semigroup (Max(..))
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Zipper (gotoEOL)
|
||||
import Data.Time.Calendar (Day)
|
||||
import Lens.Micro ((^.), over, set)
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.UI.UITypes
|
||||
import Hledger.UI.UIOptions
|
||||
|
||||
-- | Toggle between showing only unmarked items or all items.
|
||||
toggleUnmarked :: UIState -> UIState
|
||||
toggleUnmarked ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=reportSpecToggleStatus Unmarked copts rspec}}}
|
||||
toggleUnmarked = over statuses (toggleStatus1 Unmarked)
|
||||
|
||||
-- | Toggle between showing only pending items or all items.
|
||||
togglePending :: UIState -> UIState
|
||||
togglePending ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=reportSpecToggleStatus Pending copts rspec}}}
|
||||
togglePending = over statuses (toggleStatus1 Pending)
|
||||
|
||||
-- | Toggle between showing only cleared items or all items.
|
||||
toggleCleared :: UIState -> UIState
|
||||
toggleCleared ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=reportSpecToggleStatus Cleared copts rspec}}}
|
||||
toggleCleared = over statuses (toggleStatus1 Cleared)
|
||||
|
||||
-- TODO testing different status toggle styles
|
||||
|
||||
@ -53,17 +50,11 @@ uiShowStatus copts ss =
|
||||
showstatus Pending = "pending"
|
||||
showstatus Unmarked = "unmarked"
|
||||
|
||||
reportSpecToggleStatus :: Status -> CliOpts -> ReportSpec -> ReportSpec
|
||||
reportSpecToggleStatus s _copts =
|
||||
either (error "reportSpecToggleStatus: changing status should not have caused this error") id -- PARTIAL:
|
||||
. updateReportSpecWith (reportOptsToggleStatus1 s)
|
||||
|
||||
-- various toggle behaviours:
|
||||
|
||||
-- 1 UPC toggles only X/all
|
||||
reportOptsToggleStatus1 s ropts@ReportOpts{statuses_=ss}
|
||||
| ss == [s] = ropts{statuses_=[]}
|
||||
| otherwise = ropts{statuses_=[s]}
|
||||
toggleStatus1 :: Status -> [Status] -> [Status]
|
||||
toggleStatus1 s ss = if ss == [s] then [] else [s]
|
||||
|
||||
-- 2 UPC cycles X/not-X/all
|
||||
-- repeatedly pressing X cycles:
|
||||
@ -73,25 +64,25 @@ reportOptsToggleStatus1 s ropts@ReportOpts{statuses_=ss}
|
||||
-- pressing Y after first or second step starts new cycle:
|
||||
-- [u] P [p]
|
||||
-- [pc] P [p]
|
||||
-- reportOptsToggleStatus2 s ropts@ReportOpts{statuses_=ss}
|
||||
-- | ss == [s] = ropts{statuses_=complement [s]}
|
||||
-- | ss == complement [s] = ropts{statuses_=[]}
|
||||
-- | otherwise = ropts{statuses_=[s]} -- XXX assume only three values
|
||||
-- toggleStatus2 s ss
|
||||
-- | ss == [s] = complement [s]
|
||||
-- | ss == complement [s] = []
|
||||
-- | otherwise = [s] -- XXX assume only three values
|
||||
|
||||
-- 3 UPC toggles each X
|
||||
-- reportOptsToggleStatus3 s ropts@ReportOpts{statuses_=ss}
|
||||
-- | s `elem` ss = ropts{statuses_=filter (/= s) ss}
|
||||
-- | otherwise = ropts{statuses_=simplifyStatuses (s:ss)}
|
||||
-- toggleStatus3 s ss
|
||||
-- | s `elem` ss = filter (/= s) ss
|
||||
-- | otherwise = simplifyStatuses (s:ss)
|
||||
|
||||
-- 4 upc sets X, UPC sets not-X
|
||||
--reportOptsToggleStatus4 s ropts@ReportOpts{statuses_=ss}
|
||||
-- | s `elem` ss = ropts{statuses_=filter (/= s) ss}
|
||||
-- | otherwise = ropts{statuses_=simplifyStatuses (s:ss)}
|
||||
-- toggleStatus4 s ss
|
||||
-- | s `elem` ss = filter (/= s) ss
|
||||
-- | otherwise = simplifyStatuses (s:ss)
|
||||
|
||||
-- 5 upc toggles X, UPC toggles not-X
|
||||
--reportOptsToggleStatus5 s ropts@ReportOpts{statuses_=ss}
|
||||
-- | s `elem` ss = ropts{statuses_=filter (/= s) ss}
|
||||
-- | otherwise = ropts{statuses_=simplifyStatuses (s:ss)}
|
||||
-- toggleStatus5 s ss
|
||||
-- | s `elem` ss = filter (/= s) ss
|
||||
-- | otherwise = simplifyStatuses (s:ss)
|
||||
|
||||
-- | Given a list of unique enum values, list the other possible values of that enum.
|
||||
complement :: (Bounded a, Enum a, Eq a) => [a] -> [a]
|
||||
@ -101,56 +92,44 @@ complement = ([minBound..maxBound] \\)
|
||||
|
||||
-- | Toggle between showing all and showing only nonempty (more precisely, nonzero) items.
|
||||
toggleEmpty :: UIState -> UIState
|
||||
toggleEmpty ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{_rsReportOpts=toggleEmpty ropts}}}}
|
||||
where
|
||||
toggleEmpty ropts = ropts{empty_=not $ empty_ ropts}
|
||||
toggleEmpty = over empty__ not
|
||||
|
||||
-- | Toggle between showing the primary amounts or costs.
|
||||
toggleCost :: UIState -> UIState
|
||||
toggleCost ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{_rsReportOpts=ropts{cost_ = toggle $ cost_ ropts}}}}}
|
||||
toggleCost = over cost toggleCostMode
|
||||
where
|
||||
toggle Cost = NoCost
|
||||
toggle NoCost = Cost
|
||||
toggleCostMode Cost = NoCost
|
||||
toggleCostMode NoCost = Cost
|
||||
|
||||
-- | Toggle between showing primary amounts or default valuation.
|
||||
toggleValue :: UIState -> UIState
|
||||
toggleValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{_rsReportOpts=ropts{
|
||||
value_ = valuationToggleValue $ value_ ropts}}}}}
|
||||
|
||||
toggleValue = over value valuationToggleValue
|
||||
where
|
||||
-- | Basic toggling of -V, for hledger-ui.
|
||||
valuationToggleValue :: Maybe ValuationType -> Maybe ValuationType
|
||||
valuationToggleValue (Just (AtEnd _)) = Nothing
|
||||
valuationToggleValue _ = Just $ AtEnd Nothing
|
||||
|
||||
-- | Set hierarchic account tree mode.
|
||||
setTree :: UIState -> UIState
|
||||
setTree ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{_rsReportOpts=ropts{accountlistmode_=ALTree}}}}}
|
||||
setTree = set accountlistmode ALTree
|
||||
|
||||
-- | Set flat account list mode.
|
||||
setList :: UIState -> UIState
|
||||
setList ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{_rsReportOpts=ropts{accountlistmode_=ALFlat}}}}}
|
||||
setList = set accountlistmode ALFlat
|
||||
|
||||
-- | Toggle between flat and tree mode. If current mode is unspecified/default, assume it's flat.
|
||||
toggleTree :: UIState -> UIState
|
||||
toggleTree ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{_rsReportOpts=toggleTreeMode ropts}}}}
|
||||
toggleTree = over accountlistmode toggleTreeMode
|
||||
where
|
||||
toggleTreeMode ropts
|
||||
| accountlistmode_ ropts == ALTree = ropts{accountlistmode_=ALFlat}
|
||||
| otherwise = ropts{accountlistmode_=ALTree}
|
||||
toggleTreeMode ALTree = ALFlat
|
||||
toggleTreeMode ALFlat = ALTree
|
||||
|
||||
-- | Toggle between historical balances and period balances.
|
||||
toggleHistorical :: UIState -> UIState
|
||||
toggleHistorical ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{_rsReportOpts=ropts{balanceaccum_=b}}}}}
|
||||
toggleHistorical = over balanceaccum toggleBalanceAccum
|
||||
where
|
||||
b | balanceaccum_ ropts == Historical = PerPeriod
|
||||
| otherwise = Historical
|
||||
toggleBalanceAccum Historical = PerPeriod
|
||||
toggleBalanceAccum _ = Historical
|
||||
|
||||
-- | Toggle hledger-ui's "forecast/future mode". When this mode is enabled,
|
||||
-- hledger-shows regular transactions which have future dates, and
|
||||
@ -158,46 +137,33 @@ toggleHistorical ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec
|
||||
-- (which are usually but not necessarily future-dated).
|
||||
-- In normal mode, both of these are hidden.
|
||||
toggleForecast :: Day -> UIState -> UIState
|
||||
toggleForecast _d ui@UIState{aopts=UIOpts{cliopts_=copts}} =
|
||||
uiSetForecast ui $
|
||||
case forecast_ $ inputopts_ copts of
|
||||
toggleForecast _d ui = set forecast newForecast ui
|
||||
where
|
||||
newForecast = case ui^.forecast of
|
||||
Just _ -> Nothing
|
||||
Nothing -> forecast_ . inputopts_ $ enableForecastPreservingPeriod ui copts
|
||||
Nothing -> enableForecastPreservingPeriod ui (ui^.cliOpts) ^. forecast
|
||||
|
||||
-- | Ensure this CliOpts enables forecasted transactions.
|
||||
-- If a forecast period was specified in the old CliOpts,
|
||||
-- or in the provided UIState's startup options,
|
||||
-- it is preserved.
|
||||
enableForecastPreservingPeriod :: UIState -> CliOpts -> CliOpts
|
||||
enableForecastPreservingPeriod ui copts@CliOpts{inputopts_=iopts} =
|
||||
copts{inputopts_=iopts{forecast_=mforecast}}
|
||||
enableForecastPreservingPeriod ui copts = set forecast mforecast copts
|
||||
where
|
||||
mforecast = asum [mprovidedforecastperiod, mstartupforecastperiod, mdefaultforecastperiod]
|
||||
where
|
||||
mprovidedforecastperiod = forecast_ $ inputopts_ copts
|
||||
mstartupforecastperiod = forecast_ $ inputopts_ $ cliopts_ $ astartupopts ui
|
||||
mprovidedforecastperiod = copts ^. forecast
|
||||
mstartupforecastperiod = astartupopts ui ^. forecast
|
||||
mdefaultforecastperiod = Just nulldatespan
|
||||
|
||||
-- | Helper: set forecast mode (with the given forecast period) on or off in the UI state.
|
||||
uiSetForecast :: UIState -> Maybe DateSpan -> UIState
|
||||
uiSetForecast
|
||||
ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts}}}
|
||||
mforecast =
|
||||
-- we assume forecast mode has no effect on ReportSpec's derived fields
|
||||
ui{aopts=uopts{cliopts_=copts{inputopts_=iopts{forecast_=mforecast}}}}
|
||||
|
||||
-- | 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}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=update rspec}}}
|
||||
where
|
||||
update = either (error "toggleReal: updating Real should not result in an error") id -- PARTIAL:
|
||||
. updateReportSpecWith (\ropts -> ropts{real_=not $ real_ ropts})
|
||||
toggleReal = fromRight err . overEither real not -- PARTIAL:
|
||||
where err = error "toggleReal: updating Real should not result in an error"
|
||||
|
||||
-- | Toggle the ignoring of balance assertions.
|
||||
toggleIgnoreBalanceAssertions :: UIState -> UIState
|
||||
toggleIgnoreBalanceAssertions ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts@InputOpts{balancingopts_=bopts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{inputopts_=iopts{balancingopts_=bopts{ignore_assertions_=not $ ignore_assertions_ bopts}}}}}
|
||||
toggleIgnoreBalanceAssertions = over ignore_assertions not
|
||||
|
||||
-- | Step through larger report periods, up to all.
|
||||
growReportPeriod :: Day -> UIState -> UIState
|
||||
@ -222,47 +188,34 @@ previousReportPeriod enclosingspan = updateReportPeriod (periodPreviousIn enclos
|
||||
moveReportPeriodToDate :: Day -> UIState -> UIState
|
||||
moveReportPeriodToDate d = updateReportPeriod (periodMoveTo d)
|
||||
|
||||
-- | Clear any report period limits.
|
||||
resetReportPeriod :: UIState -> UIState
|
||||
resetReportPeriod = setReportPeriod PeriodAll
|
||||
|
||||
-- | Get the report period.
|
||||
reportPeriod :: UIState -> Period
|
||||
reportPeriod = period_ . _rsReportOpts . reportspec_ . cliopts_ . aopts
|
||||
reportPeriod = (^.period)
|
||||
|
||||
-- | Set the report period.
|
||||
setReportPeriod :: Period -> UIState -> UIState
|
||||
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:
|
||||
. updateReportSpecWith (\ropts -> ropts{period_=updatePeriod $ period_ ropts})
|
||||
updateReportPeriod updatePeriod = fromRight err . overEither period updatePeriod -- PARTIAL:
|
||||
where err = error "updateReportPeriod: updating period should not result in an error"
|
||||
|
||||
-- | Apply a new filter query.
|
||||
setFilter :: String -> UIState -> UIState
|
||||
setFilter s ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=update rspec}}}
|
||||
setFilter s = over reportSpec update
|
||||
where
|
||||
update = fromRight rspec . updateReportSpecWith (\ropts -> ropts{querystring_=querystring}) -- XXX silently ignores an error
|
||||
querystring = words'' prefixes $ T.pack s
|
||||
update rspec = fromRight rspec $ setEither querystring (words'' prefixes $ T.pack s) rspec -- XXX silently ignores an error
|
||||
|
||||
-- | Reset some filters & toggles.
|
||||
resetFilter :: UIState -> UIState
|
||||
resetFilter ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{
|
||||
_rsQuery=Any
|
||||
,_rsQueryOpts=[]
|
||||
,_rsReportOpts=ropts{
|
||||
empty_=True
|
||||
,statuses_=[]
|
||||
,real_=False
|
||||
,querystring_=[]
|
||||
--,period_=PeriodAll
|
||||
}}}}}
|
||||
resetFilter = set querystringNoUpdate [] . set realNoUpdate False . set statusesNoUpdate []
|
||||
. set empty__ True -- set period PeriodAll
|
||||
. set rsQuery Any . set rsQueryOpts []
|
||||
|
||||
-- | Reset all options state to exactly what it was at startup
|
||||
-- (preserving any command-line options/arguments).
|
||||
@ -297,15 +250,14 @@ setDepth :: Maybe Int -> UIState -> UIState
|
||||
setDepth mdepth = updateReportDepth (const mdepth)
|
||||
|
||||
getDepth :: UIState -> Maybe Int
|
||||
getDepth = depth_ . _rsReportOpts . reportspec_ . cliopts_ . aopts
|
||||
getDepth = (^.depth)
|
||||
|
||||
-- | 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}}}
|
||||
updateReportDepth updateDepth ui = over reportSpec update ui
|
||||
where
|
||||
update = either (error "updateReportDepth: updating depth should not result in an error") id -- PARTIAL:
|
||||
update = fromRight (error "updateReportDepth: updating depth should not result in an error") -- PARTIAL:
|
||||
. updateReportSpecWith (\ropts -> ropts{depth_=updateDepth (depth_ ropts) >>= clipDepth ropts})
|
||||
clipDepth ropts d | d < 0 = depth_ ropts
|
||||
| d >= maxDepth ui = Nothing
|
||||
@ -316,8 +268,7 @@ showMinibuffer :: UIState -> UIState
|
||||
showMinibuffer ui = setMode (Minibuffer e) ui
|
||||
where
|
||||
e = applyEdit gotoEOL $ editor MinibufferEditor (Just 1) oldq
|
||||
oldq = T.unpack . T.unwords . map textQuoteIfNeeded
|
||||
. querystring_ . _rsReportOpts . reportspec_ . cliopts_ $ aopts ui
|
||||
oldq = T.unpack . T.unwords . map textQuoteIfNeeded $ ui^.querystring
|
||||
|
||||
-- | Close the minibuffer, discarding any edit in progress.
|
||||
closeMinibuffer :: UIState -> UIState
|
||||
@ -366,4 +317,3 @@ screenEnter :: Day -> Screen -> UIState -> UIState
|
||||
screenEnter d scr ui = (sInit scr) d True $
|
||||
pushScreen scr
|
||||
ui
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user