diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 12953f1b0..00371d9e0 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -5,12 +5,11 @@ module Hledger.UI.AccountsScreen (accountsScreen - ,initAccountsScreen + ,asInit ,asSetSelectedAccount ) where -import Lens.Micro ((^.)) -- import Control.Monad import Control.Monad.IO.Class (liftIO) -- import Data.Default @@ -28,7 +27,7 @@ import Brick.Widgets.List import Brick.Widgets.Edit import Brick.Widgets.Border (borderAttr) -- import Brick.Widgets.Center -import Lens.Micro ((.~), (&)) +import Lens.Micro import Hledger import Hledger.Cli hiding (progname,prognameandversion,green) @@ -42,24 +41,20 @@ import Hledger.UI.ErrorScreen accountsScreen :: Screen accountsScreen = AccountsScreen{ - _asState = AccountsScreenState{_asItems=list "accounts" V.empty 1 - ,_asSelectedAccount="" - } - ,sInitFn = initAccountsScreen - ,sDrawFn = drawAccountsScreen - ,sHandleFn = handleAccountsScreen + sInit = asInit + ,sDraw = asDraw + ,sHandle = asHandle + ,_asList = list "accounts" V.empty 1 + ,_asSelectedAccount = "" } -asSetSelectedAccount a s@AccountsScreen{} = s & asState . asSelectedAccount .~ a -asSetSelectedAccount _ s = s - -initAccountsScreen :: Day -> Bool -> AppState -> AppState -initAccountsScreen d reset st@AppState{ +asInit :: Day -> Bool -> AppState -> AppState +asInit d reset st@AppState{ aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}, ajournal=j, aScreen=s@AccountsScreen{} } = - st{aopts=uopts', aScreen=s & asState . asItems .~ newitems'} + st{aopts=uopts', aScreen=s & asList .~ newitems'} where newitems = list (Name "accounts") (V.fromList displayitems) 1 @@ -67,7 +62,7 @@ initAccountsScreen d reset st@AppState{ -- (may need to move to the next leaf account when entering flat mode) newitems' = listMoveTo selidx newitems where - selidx = case (reset, listSelectedElement $ s ^. asState . asItems) of + selidx = case (reset, listSelectedElement $ s ^. asList) of (True, _) -> 0 (_, Nothing) -> 0 (_, Just (_,AccountsScreenItem{asItemAccountName=a})) -> fromMaybe (fromMaybe 0 mprefixmatch) mexactmatch @@ -104,10 +99,10 @@ initAccountsScreen d reset st@AppState{ displayitems = map displayitem items -initAccountsScreen _ _ _ = error "init function called with wrong screen type, should not happen" +asInit _ _ _ = error "init function called with wrong screen type, should not happen" -drawAccountsScreen :: AppState -> [Widget] -drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} +asDraw :: AppState -> [Widget] +asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} ,ajournal=j ,aScreen=s@AccountsScreen{} ,aMinibuffer=mbuf} = @@ -142,10 +137,10 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns" nonzero | empty_ ropts = str "" | otherwise = withAttr (borderAttr <> "query") (str " nonzero") - cur = str (case s ^. asState . asItems ^. listSelectedL of -- XXX second ^. required here but not below.. + cur = str (case s ^. asList ^. listSelectedL of -- XXX second ^. required here but not below.. Nothing -> "-" Just i -> show (i + 1)) - total = str $ show $ V.length $ s ^. asState . asItems . listElementsL + total = str $ show $ V.length $ s ^. asList . listElementsL bottomlabel = borderKeysStr [ -- ("up/down/pgup/pgdown/home/end", "move") @@ -174,7 +169,7 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} -- ltrace "availwidth" $ c^.availWidthL - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) - displayitems = s ^. asState . asItems . listElementsL + displayitems = s ^. asList . listElementsL maxacctwidthseen = -- ltrace "maxacctwidthseen" $ V.maximum $ @@ -202,12 +197,12 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} colwidths = (acctwidth, balwidth) - render $ defaultLayout toplabel bottomarea $ renderList (s ^. asState . asItems) (drawAccountsItem colwidths) + render $ defaultLayout toplabel bottomarea $ renderList (s ^. asList) (asDrawItem colwidths) -drawAccountsScreen _ = error "draw function called with wrong screen type, should not happen" +asDraw _ = error "draw function called with wrong screen type, should not happen" -drawAccountsItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget -drawAccountsItem (acctwidth, balwidth) selected AccountsScreenItem{..} = +asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget +asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} = Widget Greedy Fixed $ do -- c <- getContext -- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt @@ -233,8 +228,8 @@ drawAccountsItem (acctwidth, balwidth) selected AccountsScreenItem{..} = sel | selected = (<> "selected") | otherwise = id -handleAccountsScreen :: AppState -> Vty.Event -> EventM (Next AppState) -handleAccountsScreen st@AppState{ +asHandle :: AppState -> Vty.Event -> EventM (Next AppState) +asHandle st'@AppState{ aScreen=scr@AccountsScreen{..} ,aopts=UIOpts{cliopts_=copts} ,ajournal=j @@ -245,55 +240,52 @@ handleAccountsScreen st@AppState{ -- let h = c^.availHeightL -- moveSel n l = listMoveBy n l - -- before we go anywhere, remember the currently selected account. - -- (This is preserved across screen changes, unlike List's selection state) + -- save the currently selected account, in case we leave this screen and lose the selection let - selacct = case listSelectedElement $ scr ^. asState . asItems of + selacct = case listSelectedElement $ scr ^. asList of Just (_, AccountsScreenItem{..}) -> asItemAccountName - Nothing -> scr ^. asState . asSelectedAccount - st' = st{aScreen=scr & asState . asSelectedAccount .~ selacct} + Nothing -> scr ^. asSelectedAccount + st = st'{aScreen=scr & asSelectedAccount .~ selacct} case mbuf of Nothing -> case ev of - Vty.EvKey (Vty.KChar 'q') [] -> halt st' + Vty.EvKey (Vty.KChar 'q') [] -> halt st -- Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl] -> do - Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st' - Vty.EvKey (Vty.KChar 'g') [] -> liftIO (stReloadJournalIfChanged copts d j st') >>= continue - Vty.EvKey (Vty.KChar '-') [] -> continue $ regenerateScreens j d $ decDepth st' - Vty.EvKey (Vty.KChar '+') [] -> continue $ regenerateScreens j d $ incDepth st' - Vty.EvKey (Vty.KChar '=') [] -> continue $ regenerateScreens j d $ incDepth st' - Vty.EvKey (Vty.KChar '1') [] -> continue $ regenerateScreens j d $ setDepth 1 st' - Vty.EvKey (Vty.KChar '2') [] -> continue $ regenerateScreens j d $ setDepth 2 st' - Vty.EvKey (Vty.KChar '3') [] -> continue $ regenerateScreens j d $ setDepth 3 st' - Vty.EvKey (Vty.KChar '4') [] -> continue $ regenerateScreens j d $ setDepth 4 st' - Vty.EvKey (Vty.KChar '5') [] -> continue $ regenerateScreens j d $ setDepth 5 st' - Vty.EvKey (Vty.KChar '6') [] -> continue $ regenerateScreens j d $ setDepth 6 st' - Vty.EvKey (Vty.KChar '7') [] -> continue $ regenerateScreens j d $ setDepth 7 st' - Vty.EvKey (Vty.KChar '8') [] -> continue $ regenerateScreens j d $ setDepth 8 st' - Vty.EvKey (Vty.KChar '9') [] -> continue $ regenerateScreens j d $ setDepth 9 st' - Vty.EvKey (Vty.KChar '0') [] -> continue $ regenerateScreens j d $ setDepth 0 st' - Vty.EvKey (Vty.KChar 'F') [] -> continue $ regenerateScreens j d $ stToggleFlat st' - Vty.EvKey (Vty.KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st') - Vty.EvKey (Vty.KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleCleared st') - Vty.EvKey (Vty.KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleUncleared st') - Vty.EvKey (Vty.KChar 'R') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleReal st') - Vty.EvKey k [] | k `elem` [Vty.KChar '/'] -> continue $ regenerateScreens j d $ stShowMinibuffer st' - Vty.EvKey k [] | k `elem` [Vty.KBS, Vty.KDel] -> (continue $ regenerateScreens j d $ stResetFilter st') - Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st' - Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do - let - scr = rsSetCurrentAccount selacct registerScreen - st'' = screenEnter d scr st' - scrollTopRegister - continue st'' + Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st + Vty.EvKey (Vty.KChar 'g') [] -> liftIO (stReloadJournalIfChanged copts d j st) >>= continue + Vty.EvKey (Vty.KChar '-') [] -> continue $ regenerateScreens j d $ decDepth st + Vty.EvKey (Vty.KChar '+') [] -> continue $ regenerateScreens j d $ incDepth st + Vty.EvKey (Vty.KChar '=') [] -> continue $ regenerateScreens j d $ incDepth st + Vty.EvKey (Vty.KChar '1') [] -> continue $ regenerateScreens j d $ setDepth 1 st + Vty.EvKey (Vty.KChar '2') [] -> continue $ regenerateScreens j d $ setDepth 2 st + Vty.EvKey (Vty.KChar '3') [] -> continue $ regenerateScreens j d $ setDepth 3 st + Vty.EvKey (Vty.KChar '4') [] -> continue $ regenerateScreens j d $ setDepth 4 st + Vty.EvKey (Vty.KChar '5') [] -> continue $ regenerateScreens j d $ setDepth 5 st + Vty.EvKey (Vty.KChar '6') [] -> continue $ regenerateScreens j d $ setDepth 6 st + Vty.EvKey (Vty.KChar '7') [] -> continue $ regenerateScreens j d $ setDepth 7 st + Vty.EvKey (Vty.KChar '8') [] -> continue $ regenerateScreens j d $ setDepth 8 st + Vty.EvKey (Vty.KChar '9') [] -> continue $ regenerateScreens j d $ setDepth 9 st + Vty.EvKey (Vty.KChar '0') [] -> continue $ regenerateScreens j d $ setDepth 0 st + Vty.EvKey (Vty.KChar 'F') [] -> continue $ regenerateScreens j d $ stToggleFlat st + Vty.EvKey (Vty.KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st) + Vty.EvKey (Vty.KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleCleared st) + Vty.EvKey (Vty.KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleUncleared st) + Vty.EvKey (Vty.KChar 'R') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleReal st) + Vty.EvKey k [] | k `elem` [Vty.KChar '/'] -> continue $ regenerateScreens j d $ stShowMinibuffer st + Vty.EvKey k [] | k `elem` [Vty.KBS, Vty.KDel] -> (continue $ regenerateScreens j d $ stResetFilter st) + Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st + Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> scrollTopRegister >> continue (screenEnter d scr st) + where + scr = rsSetAccount selacct registerScreen -- fall through to the list's event handler (handles up/down) ev -> do - newitems <- handleEvent ev (scr ^. asState . asItems) - continue $ st'{aScreen=scr & asState . asItems .~ newitems - & asState . asSelectedAccount .~ selacct} + newitems <- handleEvent ev (scr ^. asList) + continue $ st'{aScreen=scr & asList .~ newitems + & asSelectedAccount .~ selacct + } -- continue =<< handleEventLensed st' someLens ev Just ed -> @@ -313,42 +305,8 @@ handleAccountsScreen st@AppState{ scrollTop = vScrollToBeginning $ viewportScroll "accounts" scrollTopRegister = vScrollToBeginning $ viewportScroll "register" -handleAccountsScreen _ _ = error "event handler called with wrong screen type, should not happen" +asHandle _ _ = error "event handler called with wrong screen type, should not happen" --- | Get the maximum account depth in the current journal. -maxDepth :: AppState -> Int -maxDepth AppState{ajournal=j} = maximum $ map accountNameLevel $ journalAccountNames j - --- | Decrement the current depth limit towards 0. If there was no depth limit, --- set it to one less than the maximum account depth. -decDepth :: AppState -> AppState -decDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}} - = st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=dec depth_}}}} - where - dec (Just d) = Just $ max 0 (d-1) - dec Nothing = Just $ maxDepth st - 1 - --- | Increment the current depth limit. If this makes it equal to the --- the maximum account depth, remove the depth limit. -incDepth :: AppState -> AppState -incDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}} - = st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=inc depth_}}}} - where - inc (Just d) | d < (maxDepth st - 1) = Just $ d+1 - inc _ = Nothing - --- | Set the current depth limit to the specified depth, which should --- be a positive number. If it is zero, or equal to or greater than the --- current maximum account depth, the depth limit will be removed. --- (Slight inconsistency here: zero is currently a valid display depth --- which can be reached using the - key. But we need a key to remove --- the depth limit, and 0 is it.) -setDepth :: Int -> AppState -> AppState -setDepth depth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} - = st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=mdepth'}}}} - where - mdepth' | depth < 0 = depth_ ropts - | depth == 0 = Nothing - | depth >= maxDepth st = Nothing - | otherwise = Just depth +asSetSelectedAccount a s@AccountsScreen{} = s & asSelectedAccount .~ a +asSetSelectedAccount _ s = s diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs index 783446fe6..0d154fa23 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/hledger-ui/Hledger/UI/ErrorScreen.hs @@ -30,19 +30,19 @@ import Hledger.UI.UIUtils errorScreen :: Screen errorScreen = ErrorScreen{ - esState = ErrorScreenState{esError=""} - ,sInitFn = initErrorScreen - ,sDrawFn = drawErrorScreen - ,sHandleFn = handleErrorScreen + sInit = esInit + ,sDraw = esDraw + ,sHandle = esHandle + ,esError = "" } -initErrorScreen :: Day -> Bool -> AppState -> AppState -initErrorScreen _ _ st@AppState{aScreen=ErrorScreen{}} = st -initErrorScreen _ _ _ = error "init function called with wrong screen type, should not happen" +esInit :: Day -> Bool -> AppState -> AppState +esInit _ _ st@AppState{aScreen=ErrorScreen{}} = st +esInit _ _ _ = error "init function called with wrong screen type, should not happen" -drawErrorScreen :: AppState -> [Widget] -drawErrorScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}}, - aScreen=ErrorScreen{esState=ErrorScreenState{..}}} = [ui] +esDraw :: AppState -> [Widget] +esDraw AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}}, + aScreen=ErrorScreen{..}} = [ui] where toplabel = withAttr ("border" <> "bold") (str "Oops. Please fix this problem then press g to reload") -- <+> str " transactions" @@ -77,7 +77,7 @@ drawErrorScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reporto render $ defaultLayout toplabel bottomlabel $ withAttr "error" $ str $ esError -drawErrorScreen _ = error "draw function called with wrong screen type, should not happen" +esDraw _ = error "draw function called with wrong screen type, should not happen" -- drawErrorItem :: (Int,Int,Int,Int,Int) -> Bool -> (String,String,String,String,String) -> Widget -- drawErrorItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected (date,desc,accts,change,bal) = @@ -100,9 +100,9 @@ drawErrorScreen _ = error "draw function called with wrong screen type, should n -- sel | selected = (<> "selected") -- | otherwise = id -handleErrorScreen :: AppState -> Vty.Event -> EventM (Next AppState) -handleErrorScreen st@AppState{ - aScreen=s@ErrorScreen{esState=_err} +esHandle :: AppState -> Vty.Event -> EventM (Next AppState) +esHandle st@AppState{ + aScreen=s@ErrorScreen{} ,aopts=UIOpts{cliopts_=copts} ,ajournal=j } e = do @@ -114,7 +114,7 @@ handleErrorScreen st@AppState{ Vty.EvKey (Vty.KChar 'g') [] -> do (ej, _) <- liftIO $ journalReloadIfChanged copts d j case ej of - Left err -> continue st{aScreen=s{esState=ErrorScreenState{esError=err}}} -- show latest parse error + Left err -> continue st{aScreen=s{esError=err}} -- show latest parse error Right j' -> continue $ regenerateScreens j' d $ popScreen st -- return to previous screen, and reload it -- Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st @@ -124,7 +124,7 @@ handleErrorScreen st@AppState{ -- is' <- handleEvent ev is -- continue st{aScreen=s{rsState=is'}} -- continue =<< handleEventLensed st someLens e -handleErrorScreen _ _ = error "event handler called with wrong screen type, should not happen" +esHandle _ _ = error "event handler called with wrong screen type, should not happen" -- If journal file(s) have changed, reload the journal and regenerate all screens. -- This is here so it can reference the error screen. @@ -133,5 +133,5 @@ stReloadJournalIfChanged copts d j st = do (ej, _) <- journalReloadIfChanged copts d j return $ case ej of Right j' -> regenerateScreens j' d st - Left err -> screenEnter d errorScreen{esState=ErrorScreenState{esError=err}} st + Left err -> screenEnter d errorScreen{esError=err} st diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index c6239f404..695daba6e 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -101,7 +101,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do -- 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 -> (rsSetCurrentAccount acct registerScreen, [ascr']) + Just apat -> (rsSetAccount acct registerScreen, [ascr']) where acct = headDef (error' $ "--register "++apat++" did not match any account") @@ -109,7 +109,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do -- Initialising the accounts screen is awkward, requiring -- another temporary AppState value.. ascr' = aScreen $ - initAccountsScreen d True $ + asInit d True $ AppState{ aopts=uopts' ,ajournal=j @@ -118,7 +118,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do ,aMinibuffer=Nothing } - st = (sInitFn scr) d True + st = (sInit scr) d True AppState{ aopts=uopts' ,ajournal=j @@ -133,8 +133,8 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} 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 -> sHandle (aScreen st) st ev + , appDraw = \st -> sDraw (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" diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 14c032ab1..e51bef5d2 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -4,7 +4,7 @@ module Hledger.UI.RegisterScreen (registerScreen - ,rsSetCurrentAccount + ,rsSetAccount ) where @@ -37,20 +37,19 @@ import Hledger.UI.ErrorScreen registerScreen :: Screen registerScreen = RegisterScreen{ - rsState = RegisterScreenState{rsItems=list "register" V.empty 1 - ,rsSelectedAccount="" - } - ,sInitFn = initRegisterScreen - ,sDrawFn = drawRegisterScreen - ,sHandleFn = handleRegisterScreen + sInit = rsInit + ,sDraw = rsDraw + ,sHandle = rsHandle + ,rsList = list "register" V.empty 1 + ,rsAccount = "" } -rsSetCurrentAccount a scr@RegisterScreen{..} = scr{rsState=rsState{rsSelectedAccount=a}} -rsSetCurrentAccount _ scr = scr +rsSetAccount a scr@RegisterScreen{} = scr{rsAccount=a} +rsSetAccount _ scr = scr -initRegisterScreen :: Day -> Bool -> AppState -> AppState -initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{rsState=rsState@RegisterScreenState{..}}} = - st{aScreen=s{rsState=rsState{rsItems=newitems'}}} +rsInit :: Day -> Bool -> AppState -> AppState +rsInit d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{..}} = + st{aScreen=s{rsList=newitems'}} where -- gather arguments and queries ropts = (reportopts_ $ cliopts_ opts) @@ -59,7 +58,7 @@ initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@Registe balancetype_=HistoricalBalance } -- XXX temp - thisacctq = Acct $ accountNameToAccountRegex rsSelectedAccount -- includes subs + thisacctq = Acct $ accountNameToAccountRegex rsAccount -- includes subs q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts (_label,items) = accountTransactionsReport ropts j q thisacctq @@ -89,22 +88,22 @@ initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@Registe -- (eg after toggling nonzero mode), otherwise select the last element. newitems' = listMoveTo newselidx newitems where - newselidx = case (reset, listSelectedElement rsItems) of + newselidx = case (reset, listSelectedElement rsList) of (True, _) -> 0 (_, Nothing) -> endidx (_, Just (_,RegisterScreenItem{rsItemTransaction=Transaction{tindex=ti}})) -> fromMaybe endidx $ findIndex ((==ti) . tindex . rsItemTransaction) displayitems endidx = length displayitems -initRegisterScreen _ _ _ = error "init function called with wrong screen type, should not happen" +rsInit _ _ _ = error "init function called with wrong screen type, should not happen" -drawRegisterScreen :: AppState -> [Widget] -drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} - ,aScreen=RegisterScreen{rsState=RegisterScreenState{..}} +rsDraw :: AppState -> [Widget] +rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} + ,aScreen=RegisterScreen{..} ,aMinibuffer=mbuf} = [ui] where - toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsSelectedAccount) + toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsAccount) <+> togglefilters <+> str " transactions" <+> borderQueryStr (query_ ropts) @@ -124,11 +123,11 @@ drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} ] of [] -> str "" fs -> withAttr (borderAttr <> "query") (str $ " " ++ intercalate ", " fs) - cur = str $ case rsItems ^. listSelectedL of + cur = str $ case rsList ^. listSelectedL of Nothing -> "-" Just i -> show (i + 1) total = str $ show $ length displayitems - displayitems = V.toList $ rsItems ^. listElementsL + displayitems = V.toList $ rsList ^. listElementsL -- query = query_ $ reportopts_ $ cliopts_ opts @@ -196,12 +195,12 @@ drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} Nothing -> bottomlabel Just ed -> minibuffer ed - render $ defaultLayout toplabel bottomarea $ renderList rsItems (drawRegisterItem colwidths) + render $ defaultLayout toplabel bottomarea $ renderList rsList (rsDrawItem colwidths) -drawRegisterScreen _ = error "draw function called with wrong screen type, should not happen" +rsDraw _ = error "draw function called with wrong screen type, should not happen" -drawRegisterItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget -drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} = +rsDrawItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget +rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} = Widget Greedy Fixed $ do render $ str (fitString (Just datewidth) (Just datewidth) True True rsItemDate) <+> @@ -221,9 +220,9 @@ drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected sel | selected = (<> "selected") | otherwise = id -handleRegisterScreen :: AppState -> Vty.Event -> EventM (Next AppState) -handleRegisterScreen st@AppState{ - aScreen=s@RegisterScreen{rsState=rsState@RegisterScreenState{..}} +rsHandle :: AppState -> Vty.Event -> EventM (Next AppState) +rsHandle st@AppState{ + aScreen=s@RegisterScreen{..} ,aopts=UIOpts{cliopts_=copts} ,ajournal=j ,aMinibuffer=mbuf @@ -245,22 +244,22 @@ handleRegisterScreen st@AppState{ Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do - case listSelectedElement rsItems of + case listSelectedElement rsList of Just (_, RegisterScreenItem{rsItemTransaction=t}) -> let - ts = map rsItemTransaction $ V.toList $ listElements rsItems + ts = map rsItemTransaction $ V.toList $ listElements rsList numberedts = zip [1..] ts i = fromIntegral $ maybe 0 (+1) $ elemIndex t ts -- XXX in - continue $ screenEnter d transactionScreen{tsState=TransactionScreenState{tsTransaction=(i,t) - ,tsTransactions=numberedts - ,tsSelectedAccount=rsSelectedAccount}} st + continue $ screenEnter d transactionScreen{tsTransaction=(i,t) + ,tsTransactions=numberedts + ,tsAccount=rsAccount} st Nothing -> continue st -- fall through to the list's event handler (handles [pg]up/down) ev -> do - newitems <- handleEvent ev rsItems - continue st{aScreen=s{rsState=rsState{rsItems=newitems}}} + newitems <- handleEvent ev rsList + continue st{aScreen=s{rsList=newitems}} -- continue =<< handleEventLensed st someLens ev Just ed -> @@ -275,4 +274,5 @@ handleRegisterScreen st@AppState{ -- Encourage a more stable scroll position when toggling list items (cf AccountsScreen.hs) scrollTop = vScrollToBeginning $ viewportScroll "register" -handleRegisterScreen _ _ = error "event handler called with wrong screen type, should not happen" +rsHandle _ _ = error "event handler called with wrong screen type, should not happen" + diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 94060bdc1..30140a280 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -4,6 +4,7 @@ module Hledger.UI.TransactionScreen (transactionScreen + ,rsSelect ) where @@ -37,26 +38,26 @@ import Hledger.UI.ErrorScreen transactionScreen :: Screen transactionScreen = TransactionScreen{ - tsState = TransactionScreenState{tsTransaction=(1,nulltransaction) - ,tsTransactions=[(1,nulltransaction)] - ,tsSelectedAccount=""} - ,sInitFn = initTransactionScreen - ,sDrawFn = drawTransactionScreen - ,sHandleFn = handleTransactionScreen + sInit = tsInit + ,sDraw = tsDraw + ,sHandle = tsHandle + ,tsTransaction = (1,nulltransaction) + ,tsTransactions = [(1,nulltransaction)] + ,tsAccount = "" } -initTransactionScreen :: Day -> Bool -> AppState -> AppState -initTransactionScreen _d _reset st@AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}} +tsInit :: Day -> Bool -> AppState -> AppState +tsInit _d _reset st@AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}} ,ajournal=_j ,aScreen=TransactionScreen{..}} = st -initTransactionScreen _ _ _ = error "init function called with wrong screen type, should not happen" +tsInit _ _ _ = error "init function called with wrong screen type, should not happen" -drawTransactionScreen :: AppState -> [Widget] -drawTransactionScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} +tsDraw :: AppState -> [Widget] +tsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} ,aScreen=TransactionScreen{ - tsState=TransactionScreenState{tsTransaction=(i,t) - ,tsTransactions=nts - ,tsSelectedAccount=acct}}} = + tsTransaction=(i,t) + ,tsTransactions=nts + ,tsAccount=acct}} = [ui] where -- datedesc = show (tdate t) ++ " " ++ tdescription t @@ -96,13 +97,13 @@ drawTransactionScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real t -drawTransactionScreen _ = error "draw function called with wrong screen type, should not happen" +tsDraw _ = error "draw function called with wrong screen type, should not happen" -handleTransactionScreen :: AppState -> Vty.Event -> EventM (Next AppState) -handleTransactionScreen - st@AppState{aScreen=s@TransactionScreen{tsState=tsState@TransactionScreenState{tsTransaction=(i,t) - ,tsTransactions=nts - ,tsSelectedAccount=acct}} +tsHandle :: AppState -> Vty.Event -> EventM (Next AppState) +tsHandle + st@AppState{aScreen=s@TransactionScreen{tsTransaction=(i,t) + ,tsTransactions=nts + ,tsAccount=acct} ,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} ,ajournal=j } @@ -121,7 +122,7 @@ handleTransactionScreen case ej of Right j' -> do -- got to redo the register screen's transactions report, to get the latest transactions list for this screen - -- XXX duplicates initRegisterScreen + -- XXX duplicates rsInit let ropts' = ropts {depth_=Nothing ,balancetype_=HistoricalBalance @@ -138,31 +139,31 @@ handleTransactionScreen Nothing | null numberedts -> (0,nulltransaction) | i > fst (last numberedts) -> last numberedts | otherwise -> head numberedts - st' = st{aScreen=s{tsState=TransactionScreenState{tsTransaction=(i',t') - ,tsTransactions=numberedts - ,tsSelectedAccount=acct}}} + st' = st{aScreen=s{tsTransaction=(i',t') + ,tsTransactions=numberedts + ,tsAccount=acct}} continue $ regenerateScreens j' d st' - Left err -> continue $ screenEnter d errorScreen{esState=ErrorScreenState{esError=err}} st + Left err -> continue $ screenEnter d errorScreen{esError=err} st -- if allowing toggling here, we should refresh the txn list from the parent register screen -- Vty.EvKey (Vty.KChar 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty st -- Vty.EvKey (Vty.KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared st -- Vty.EvKey (Vty.KChar 'R') [] -> continue $ regenerateScreens j d $ stToggleReal st - Vty.EvKey (Vty.KUp) [] -> continue $ regenerateScreens j d st{aScreen=s{tsState=tsState{tsTransaction=(iprev,tprev)}}} - Vty.EvKey (Vty.KDown) [] -> continue $ regenerateScreens j d st{aScreen=s{tsState=tsState{tsTransaction=(inext,tnext)}}} + Vty.EvKey (Vty.KUp) [] -> continue $ regenerateScreens j d st{aScreen=s{tsTransaction=(iprev,tprev)}} + Vty.EvKey (Vty.KDown) [] -> continue $ regenerateScreens j d st{aScreen=s{tsTransaction=(inext,tnext)}} Vty.EvKey (Vty.KLeft) [] -> continue st'' where st'@AppState{aScreen=scr} = popScreen st - st'' = st'{aScreen=rsSetSelectedTransaction (fromIntegral i) scr} + st'' = st'{aScreen=rsSelect (fromIntegral i) scr} _ev -> continue st -handleTransactionScreen _ _ = error "event handler called with wrong screen type, should not happen" - -rsSetSelectedTransaction i scr@RegisterScreen{rsState=rsState@RegisterScreenState{..}} = scr{rsState=rsState{rsItems=l'}} - where l' = listMoveTo (i-1) rsItems -rsSetSelectedTransaction _ scr = scr +tsHandle _ _ = error "event handler called with wrong screen type, should not happen" +-- | Select the nth item on the register screen. +rsSelect i scr@RegisterScreen{..} = scr{rsList=l'} + where l' = listMoveTo (i-1) rsList +rsSelect _ scr = scr diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 953af2f60..658d1a2ac 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -1,9 +1,11 @@ {- | Overview: -hledger-ui's AppState holds the active screen and any previously visited screens. -Screens have their own render state, render function, event handler, -and app state update function (which can update the whole AppState). -A brick App delegates event-handling and rendering to our AppState's active screen. +hledger-ui's AppState holds the currently active screen and any previously visited +screens (and their states). +The brick App delegates all event-handling and rendering +to the AppState's active screen. +Screens have their own screen state, render function, event handler, and app state +update function, so they have full control. @ Brick.defaultMain brickapp st @@ -14,15 +16,15 @@ Brick.defaultMain brickapp st , appStartEvent = return , appAttrMap = const theme , appChooseCursor = showFirstCursor - , appHandleEvent = \st ev -> sHandleFn (aScreen st) st ev - , appDraw = \st -> sDrawFn (aScreen st) st + , appHandleEvent = \st ev -> sHandle (aScreen st) st ev + , appDraw = \st -> sDraw (aScreen st) st } st :: AppState - st = (sInitFn scr) d + st = (sInit s) d AppState{ aopts=uopts' ,ajournal=j - ,aScreen=scr + ,aScreen=s ,aPrevScreens=prevscrs ,aMinibuffer=Nothing } @@ -30,9 +32,9 @@ Brick.defaultMain brickapp st -} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Hledger.UI.UITypes where @@ -51,63 +53,57 @@ import Text.Show.Functions () import Hledger import Hledger.UI.UIOptions +instance Show (List a) where show _ = "" +instance Show Editor where show _ = "" + -- | hledger-ui's application state. This holds one or more stateful screens. data AppState = AppState { aopts :: UIOpts -- ^ the command-line options and query arguments currently in effect ,ajournal :: Journal -- ^ the journal being viewed ,aScreen :: Screen -- ^ the currently active screen ,aPrevScreens :: [Screen] -- ^ previously visited screens, most recent first - ,aMinibuffer :: Maybe Editor -- ^ a compact editor used for data entry, when active + ,aMinibuffer :: Maybe Editor -- ^ a compact editor, when active, used for data entry on all screens } deriving (Show) --- | Types of screen available within hledger-ui. Each has its own --- specific state type, and generic initialisation, event handling --- and rendering functions. --- --- Screen types are pattern-matched by their constructor and their --- state field, which must have a unique name. This type causes --- partial functions, so take care. +-- | hledger-ui screen types & instances. +-- Each screen type has generically named initialisation, draw, and event handling functions, +-- and zero or more uniquely named screen state fields, which hold the data for a particular +-- instance of this screen. The latter create partial functions, so take care. data Screen = AccountsScreen { - _asState :: AccountsScreenState - ,sInitFn :: Day -> Bool -> AppState -> AppState -- ^ function to generate the screen's state on entry or change - ,sDrawFn :: AppState -> [Widget] -- ^ brick renderer for this screen - ,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState) -- ^ brick event handler for this screen + sInit :: Day -> Bool -> AppState -> AppState -- ^ function to update the screen's state + ,sDraw :: AppState -> [Widget] -- ^ brick renderer for this screen + ,sHandle :: AppState -> Vty.Event -> EventM (Next AppState) -- ^ brick event handler for this screen + -- state fields. These ones have lenses: + ,_asList :: List AccountsScreenItem -- ^ list widget showing account names & balances + ,_asSelectedAccount :: AccountName -- ^ a backup of the account name from the list widget's selected item (or "") } | RegisterScreen { - rsState :: RegisterScreenState - ,sInitFn :: Day -> Bool -> AppState -> AppState - ,sDrawFn :: AppState -> [Widget] - ,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState) + sInit :: Day -> Bool -> AppState -> AppState + ,sDraw :: AppState -> [Widget] + ,sHandle :: AppState -> Vty.Event -> EventM (Next AppState) + -- + ,rsList :: List RegisterScreenItem -- ^ list widget showing transactions affecting this account + ,rsAccount :: AccountName -- ^ the account this register is for } | TransactionScreen { - tsState :: TransactionScreenState - ,sInitFn :: Day -> Bool -> AppState -> AppState - ,sDrawFn :: AppState -> [Widget] - ,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState) + sInit :: Day -> Bool -> AppState -> AppState + ,sDraw :: AppState -> [Widget] + ,sHandle :: AppState -> Vty.Event -> EventM (Next AppState) + -- + ,tsTransaction :: NumberedTransaction -- ^ the transaction we are currently viewing, and its position in the list + ,tsTransactions :: [NumberedTransaction] -- ^ list of transactions we can step through + ,tsAccount :: AccountName -- ^ the account whose register we entered this screen from } | ErrorScreen { - esState :: ErrorScreenState - ,sInitFn :: Day -> Bool -> AppState -> AppState - ,sDrawFn :: AppState -> [Widget] - ,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState) + sInit :: Day -> Bool -> AppState -> AppState + ,sDraw :: AppState -> [Widget] + ,sHandle :: AppState -> Vty.Event -> EventM (Next AppState) + -- + ,esError :: String -- ^ error message to show } deriving (Show) -instance Show (List a) where show _ = "" -instance Show Editor where show _ = "" - -instance Monoid (List a) - where - mempty = list "" V.empty 1 - mappend a b = a & listElementsL .~ (a^.listElementsL <> b^.listElementsL) - --- | Render state for this type of screen. -data AccountsScreenState = AccountsScreenState { - _asItems :: List AccountsScreenItem -- ^ list of account names & balances - ,_asSelectedAccount :: AccountName -- ^ full name of the currently selected account (or "") - } deriving (Show) - -- | An item in the accounts screen's list of accounts and balances. data AccountsScreenItem = AccountsScreenItem { asItemIndentLevel :: Int -- ^ indent level @@ -116,12 +112,6 @@ data AccountsScreenItem = AccountsScreenItem { ,asItemRenderedAmounts :: [String] -- ^ rendered amounts } --- | Render state for this type of screen. -data RegisterScreenState = RegisterScreenState { - rsItems :: List RegisterScreenItem -- ^ list of transactions affecting this account - ,rsSelectedAccount :: AccountName -- ^ full name of the account we are showing a register for - } deriving (Show) - -- | An item in the register screen's list of transactions in the current account. data RegisterScreenItem = RegisterScreenItem { rsItemDate :: String -- ^ date @@ -132,26 +122,15 @@ data RegisterScreenItem = RegisterScreenItem { ,rsItemTransaction :: Transaction -- ^ the full transaction } --- | Render state for this type of screen. -data TransactionScreenState = TransactionScreenState { - tsTransaction :: NumberedTransaction -- ^ the transaction we are currently viewing, and its position in the list - ,tsTransactions :: [NumberedTransaction] -- ^ the list of transactions we can step through - ,tsSelectedAccount :: AccountName -- ^ the account whose register we entered this screen from - } deriving (Show) - type NumberedTransaction = (Integer, Transaction) --- | Render state for this type of screen. -data ErrorScreenState = ErrorScreenState { - esError :: String -- ^ error message to show - } deriving (Show) +-- needed for lenses +instance Monoid (List a) + where + mempty = list "" V.empty 1 + mappend l1 l2 = l1 & listElementsL .~ (l1^.listElementsL <> l2^.listElementsL) --- makeLenses ''AccountsScreenState concat <$> mapM makeLenses [ - ''AccountsScreenState --- ,''RegisterScreenState --- ,''TransactionScreenState --- ,''ErrorScreenState - ,''Screen + ''Screen ] diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index 837d4bfe2..18e5f7aa6 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -1,33 +1,36 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} -module Hledger.UI.UIUtils ( - pushScreen - ,popScreen - ,resetScreens - ,screenEnter - ,regenerateScreens - ,getViewportSize - -- ,margin - ,withBorderAttr - ,topBottomBorderWithLabel - ,topBottomBorderWithLabels - ,defaultLayout - ,borderQueryStr - ,borderDepthStr - ,borderKeysStr - ,minibuffer - -- - ,stToggleCleared - ,stTogglePending - ,stToggleUncleared - ,stToggleEmpty - ,stToggleFlat - ,stToggleReal - ,stFilter - ,stResetFilter - ,stShowMinibuffer - ,stHideMinibuffer - ) where +module Hledger.UI.UIUtils +-- ( +-- pushScreen +-- ,popScreen +-- ,resetScreens +-- ,screenEnter +-- ,regenerateScreens +-- ,getViewportSize +-- -- ,margin +-- ,withBorderAttr +-- ,topBottomBorderWithLabel +-- ,topBottomBorderWithLabels +-- ,defaultLayout +-- ,borderQueryStr +-- ,borderDepthStr +-- ,borderKeysStr +-- ,minibuffer +-- -- +-- ,stToggleCleared +-- ,stTogglePending +-- ,stToggleUncleared +-- ,stToggleEmpty +-- ,stToggleFlat +-- ,stToggleReal +-- ,stFilter +-- ,stResetFilter +-- ,stShowMinibuffer +-- ,stHideMinibuffer +-- ) + where import Lens.Micro ((^.)) -- import Control.Monad @@ -44,13 +47,10 @@ import Brick.Widgets.Border import Brick.Widgets.Border.Style import Graphics.Vty as Vty -import Hledger.UI.UITypes -import Hledger.Data.Types (Journal) -import Hledger.UI.UIOptions +import Hledger import Hledger.Cli.CliOptions -import Hledger.Reports.ReportOptions -import Hledger.Utils (applyN) --- import Hledger.Utils.Debug +import Hledger.UI.UITypes +import Hledger.UI.UIOptions -- | Toggle between showing only cleared items or all items. stToggleCleared :: AppState -> AppState @@ -116,6 +116,43 @@ stResetDepth :: AppState -> AppState stResetDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=Nothing}}}} +-- | Get the maximum account depth in the current journal. +maxDepth :: AppState -> Int +maxDepth AppState{ajournal=j} = maximum $ map accountNameLevel $ journalAccountNames j + +-- | Decrement the current depth limit towards 0. If there was no depth limit, +-- set it to one less than the maximum account depth. +decDepth :: AppState -> AppState +decDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}} + = st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=dec depth_}}}} + where + dec (Just d) = Just $ max 0 (d-1) + dec Nothing = Just $ maxDepth st - 1 + +-- | Increment the current depth limit. If this makes it equal to the +-- the maximum account depth, remove the depth limit. +incDepth :: AppState -> AppState +incDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}} + = st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=inc depth_}}}} + where + inc (Just d) | d < (maxDepth st - 1) = Just $ d+1 + inc _ = Nothing + +-- | Set the current depth limit to the specified depth, which should +-- be a positive number. If it is zero, or equal to or greater than the +-- current maximum account depth, the depth limit will be removed. +-- (Slight inconsistency here: zero is currently a valid display depth +-- which can be reached using the - key. But we need a key to remove +-- the depth limit, and 0 is it.) +setDepth :: Int -> AppState -> AppState +setDepth depth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} + = st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=mdepth'}}}} + where + mdepth' | depth < 0 = depth_ ropts + | depth == 0 = Nothing + | depth >= maxDepth st = Nothing + | otherwise = Just depth + -- | Enable the minibuffer, setting its content to the current query with the cursor at the end. stShowMinibuffer st = st{aMinibuffer=Just e} where @@ -129,14 +166,14 @@ stHideMinibuffer st = st{aMinibuffer=Nothing} regenerateScreens :: Journal -> Day -> AppState -> AppState regenerateScreens j d st@AppState{aScreen=s,aPrevScreens=ss} = -- XXX clumsy due to entanglement of AppState and Screen. - -- sInitFn operates only on an appstate's current screen, so + -- sInit operates only on an appstate's current screen, so -- remove all the screens from the appstate and then add them back -- one at a time, regenerating as we go. let first:rest = reverse $ s:ss :: [Screen] st0 = st{ajournal=j, aScreen=first, aPrevScreens=[]} :: AppState - st1 = (sInitFn first) d False st0 :: AppState - st2 = foldl' (\st s -> (sInitFn s) d False $ pushScreen s st) st1 rest :: AppState + st1 = (sInit first) d False st0 :: AppState + st2 = foldl' (\st s -> (sInit s) d False $ pushScreen s st) st1 rest :: AppState in st2 @@ -151,7 +188,7 @@ popScreen st = st resetScreens :: Day -> AppState -> AppState resetScreens d st@AppState{aScreen=s,aPrevScreens=ss} = - (sInitFn topscreen) d True $ stResetDepth $ stResetFilter $ stHideMinibuffer st{aScreen=topscreen, aPrevScreens=[]} + (sInit topscreen) d True $ stResetDepth $ stResetFilter $ stHideMinibuffer st{aScreen=topscreen, aPrevScreens=[]} where topscreen = case ss of _:_ -> last ss [] -> s @@ -162,7 +199,7 @@ resetScreens d st@AppState{aScreen=s,aPrevScreens=ss} = -- | Enter a new screen, saving the old screen & state in the -- navigation history and initialising the new screen's state. screenEnter :: Day -> Screen -> AppState -> AppState -screenEnter d scr st = (sInitFn scr) d True $ +screenEnter d scr st = (sInit scr) d True $ pushScreen scr st @@ -230,7 +267,7 @@ _topBottomBorderWithLabel2 label = \wrapped -> -- thickness, using the current background colour or the specified -- colour. -- XXX May disrupt border style of inner widgets. --- XXX Should reduce the available size visible to inner widget, but doesn't seem to (cf drawRegisterScreen2). +-- XXX Should reduce the available size visible to inner widget, but doesn't seem to (cf rsDraw2). margin :: Int -> Int -> Maybe Color -> Widget -> Widget margin h v mcolour = \w -> Widget Greedy Greedy $ do