diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index fb8b7babf..0964f51b1 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -41,36 +41,38 @@ import Hledger.UI.ErrorScreen accountsScreen :: Screen accountsScreen = AccountsScreen{ - asState = (list "accounts" V.empty 1, "") + asState = AccountsScreenState{asItems=list "accounts" V.empty 1 + ,asSelectedAccount="" + } ,sInitFn = initAccountsScreen ,sDrawFn = drawAccountsScreen ,sHandleFn = handleAccountsScreen } -asSetSelectedAccount a scr@AccountsScreen{asState=(l,_)} = scr{asState=(l,a)} +asSetSelectedAccount a scr@AccountsScreen{asState=st} = scr{asState=st{asSelectedAccount=a}} asSetSelectedAccount _ scr = scr initAccountsScreen :: Day -> Bool -> AppState -> AppState initAccountsScreen d reset st@AppState{ aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}, ajournal=j, - aScreen=s@AccountsScreen{asState=(oldl,selacct)} + aScreen=s@AccountsScreen{asState=asState@AccountsScreenState{..}} } = - st{aopts=uopts', aScreen=s{asState=(newl',selacct)}} + st{aopts=uopts', aScreen=s{asState=asState{asItems=newitems'}}} where - newl = list (Name "accounts") (V.fromList displayitems) 1 + newitems = list (Name "accounts") (V.fromList displayitems) 1 -- keep the selection near the last selected account -- (may need to move to the next leaf account when entering flat mode) - newl' = listMoveTo selidx newl + newitems' = listMoveTo selidx newitems where - selidx = case (reset, listSelectedElement oldl) of + selidx = case (reset, listSelectedElement asItems) of (True, _) -> 0 (_, Nothing) -> 0 - (_, Just (_,(_,a,_,_))) -> fromMaybe (fromMaybe 0 mprefixmatch) mexactmatch + (_, Just (_,AccountsScreenItem{asItemAccountName=a})) -> fromMaybe (fromMaybe 0 mprefixmatch) mexactmatch where - mexactmatch = findIndex ((a ==) . second4) displayitems - mprefixmatch = findIndex ((a `isAccountNamePrefixOf`) . second4) displayitems + mexactmatch = findIndex ((a ==) . asItemAccountName) displayitems + mprefixmatch = findIndex ((a `isAccountNamePrefixOf`) . asItemAccountName) displayitems uopts' = uopts{cliopts_=copts{reportopts_=ropts'}} ropts' = ropts { -- XXX balanceReport doesn't respect this yet @@ -90,11 +92,11 @@ initAccountsScreen d reset st@AppState{ -- pre-render the list items displayitem ((fullacct, shortacct, indent), bal) = - (indent - ,fullacct - ,if flat_ ropts' then fullacct else shortacct - ,map showAmountWithoutPrice amts -- like showMixedAmountOneLineWithoutPrice - ) + AccountsScreenItem{asItemIndentLevel = indent + ,asItemAccountName = fullacct + ,asItemDisplayAccountName = if flat_ ropts' then fullacct else shortacct + ,asItemRenderedAmounts = map showAmountWithoutPrice amts -- like showMixedAmountOneLineWithoutPrice + } where Mixed amts = normaliseMixedAmountSquashPricesForDisplay $ stripPrices bal stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice} @@ -106,7 +108,7 @@ initAccountsScreen _ _ _ = error "init function called with wrong screen type, s drawAccountsScreen :: AppState -> [Widget] drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} ,ajournal=j - ,aScreen=AccountsScreen{asState=(l,_)} + ,aScreen=AccountsScreen{asState=AccountsScreenState{..}} ,aMinibuffer=mbuf} = [ui] where @@ -139,10 +141,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 l^.listSelectedL of + cur = str (case asItems ^. listSelectedL of Nothing -> "-" Just i -> show (i + 1)) - total = str $ show $ V.length $ l^.listElementsL + total = str $ show $ V.length $ asItems ^. listElementsL bottomlabel = borderKeysStr [ -- ("up/down/pgup/pgdown/home/end", "move") @@ -171,16 +173,16 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} -- ltrace "availwidth" $ c^.availWidthL - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) - displayitems = listElements l + displayitems = listElements asItems maxacctwidthseen = -- ltrace "maxacctwidthseen" $ V.maximum $ - V.map (\(indent,_,displayacct,_) -> indent*2 + textWidth displayacct) $ + V.map (\AccountsScreenItem{..} -> asItemIndentLevel*2 + textWidth asItemDisplayAccountName) $ -- V.filter (\(indent,_,_,_) -> (indent-1) <= fromMaybe 99999 mdepth) $ displayitems maxbalwidthseen = -- ltrace "maxbalwidthseen" $ - V.maximum $ V.map (\(_,_,_,amts) -> sum (map strWidth amts) + 2 * (length amts-1)) displayitems + V.maximum $ V.map (\AccountsScreenItem{..} -> sum (map strWidth asItemRenderedAmounts) + 2 * (length asItemRenderedAmounts - 1)) displayitems maxbalwidth = -- ltrace "maxbalwidth" $ max 0 (availwidth - 2 - 4) -- leave 2 whitespace plus least 4 for accts @@ -199,20 +201,20 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} colwidths = (acctwidth, balwidth) - render $ defaultLayout toplabel bottomarea $ renderList l (drawAccountsItem colwidths) + render $ defaultLayout toplabel bottomarea $ renderList asItems (drawAccountsItem colwidths) drawAccountsScreen _ = error "draw function called with wrong screen type, should not happen" -drawAccountsItem :: (Int,Int) -> Bool -> (Int, AccountName, AccountName, [String]) -> Widget -drawAccountsItem (acctwidth, balwidth) selected (indent, _fullacct, displayacct, balamts) = +drawAccountsItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget +drawAccountsItem (acctwidth, balwidth) selected AccountsScreenItem{..} = Widget Greedy Fixed $ do -- c <- getContext -- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt render $ - addamts balamts $ - str (T.unpack $ fitText (Just acctwidth) (Just acctwidth) True True $ T.replicate (2*indent) " " <> displayacct) <+> + addamts asItemRenderedAmounts $ + str (T.unpack $ fitText (Just acctwidth) (Just acctwidth) True True $ T.replicate (2*asItemIndentLevel) " " <> asItemDisplayAccountName) <+> str " " <+> - str (balspace balamts) + str (balspace asItemRenderedAmounts) where balspace as = replicate n ' ' where n = max 0 (balwidth - (sum (map strWidth as) + 2 * (length as - 1))) @@ -232,7 +234,7 @@ drawAccountsItem (acctwidth, balwidth) selected (indent, _fullacct, displayacct, handleAccountsScreen :: AppState -> Vty.Event -> EventM (Next AppState) handleAccountsScreen st@AppState{ - aScreen=scr@AccountsScreen{asState=(l,selacct)} + aScreen=scr@AccountsScreen{asState=asState@AccountsScreenState{..}} ,aopts=UIOpts{cliopts_=copts} ,ajournal=j ,aMinibuffer=mbuf @@ -245,10 +247,10 @@ handleAccountsScreen st@AppState{ -- before we go anywhere, remember the currently selected account. -- (This is preserved across screen changes, unlike List's selection state) let - selacct' = case listSelectedElement l of - Just (_, (_, fullacct, _, _)) -> fullacct - Nothing -> selacct - st' = st{aScreen=scr{asState=(l,selacct')}} + selacct = case listSelectedElement asItems of + Just (_, AccountsScreenItem{..}) -> asItemAccountName + Nothing -> asSelectedAccount + st' = st{aScreen=scr{asState=asState{asSelectedAccount=selacct}}} case mbuf of Nothing -> @@ -281,15 +283,15 @@ handleAccountsScreen st@AppState{ Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st' Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do let - scr = rsSetCurrentAccount selacct' registerScreen + scr = rsSetCurrentAccount selacct registerScreen st'' = screenEnter d scr st' scrollTopRegister continue st'' -- fall through to the list's event handler (handles up/down) ev -> do - l' <- handleEvent ev l - continue $ st'{aScreen=scr{asState=(l',selacct')}} + newitems <- handleEvent ev asItems + continue $ st'{aScreen=scr{asState=asState{asItems=newitems,asSelectedAccount=selacct}}} -- continue =<< handleEventLensed st' someLens ev Just ed -> diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs index f7995c2f1..783446fe6 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/hledger-ui/Hledger/UI/ErrorScreen.hs @@ -1,6 +1,6 @@ -- The error screen, showing a current error condition (such as a parse error after reloading the journal) -{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings, FlexibleContexts, RecordWildCards #-} module Hledger.UI.ErrorScreen (errorScreen @@ -30,7 +30,7 @@ import Hledger.UI.UIUtils errorScreen :: Screen errorScreen = ErrorScreen{ - esState = "" + esState = ErrorScreenState{esError=""} ,sInitFn = initErrorScreen ,sDrawFn = drawErrorScreen ,sHandleFn = handleErrorScreen @@ -42,7 +42,7 @@ initErrorScreen _ _ _ = error "init function called with wrong screen type, shou drawErrorScreen :: AppState -> [Widget] drawErrorScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}}, - aScreen=ErrorScreen{esState=err}} = [ui] + aScreen=ErrorScreen{esState=ErrorScreenState{..}}} = [ui] where toplabel = withAttr ("border" <> "bold") (str "Oops. Please fix this problem then press g to reload") -- <+> str " transactions" @@ -75,7 +75,7 @@ drawErrorScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reporto -- totalwidth = c^.availWidthL -- - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) - render $ defaultLayout toplabel bottomlabel $ withAttr "error" $ str err + render $ defaultLayout toplabel bottomlabel $ withAttr "error" $ str $ esError drawErrorScreen _ = error "draw function called with wrong screen type, should not happen" @@ -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=err}} -- show latest parse error + Left err -> continue st{aScreen=s{esState=ErrorScreenState{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 @@ -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=err} st + Left err -> screenEnter d errorScreen{esState=ErrorScreenState{esError=err}} st diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index db98f83ed..14c032ab1 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -1,6 +1,6 @@ -- The account register screen, showing transactions in an account, like hledger-web's register. -{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings, FlexibleContexts, RecordWildCards #-} module Hledger.UI.RegisterScreen (registerScreen @@ -37,18 +37,20 @@ import Hledger.UI.ErrorScreen registerScreen :: Screen registerScreen = RegisterScreen{ - rsState = (list "register" V.empty 1, "") + rsState = RegisterScreenState{rsItems=list "register" V.empty 1 + ,rsSelectedAccount="" + } ,sInitFn = initRegisterScreen ,sDrawFn = drawRegisterScreen ,sHandleFn = handleRegisterScreen } -rsSetCurrentAccount a scr@RegisterScreen{rsState=(l,_)} = scr{rsState=(l,a)} +rsSetCurrentAccount a scr@RegisterScreen{..} = scr{rsState=rsState{rsSelectedAccount=a}} rsSetCurrentAccount _ scr = scr initRegisterScreen :: Day -> Bool -> AppState -> AppState -initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{rsState=(oldl,acct)}} = - st{aScreen=s{rsState=(newl',acct)}} +initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{rsState=rsState@RegisterScreenState{..}}} = + st{aScreen=s{rsState=rsState{rsItems=newitems'}}} where -- gather arguments and queries ropts = (reportopts_ $ cliopts_ opts) @@ -57,7 +59,7 @@ initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@Registe balancetype_=HistoricalBalance } -- XXX temp - thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs + thisacctq = Acct $ accountNameToAccountRegex rsSelectedAccount -- includes subs q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts (_label,items) = accountTransactionsReport ropts j q thisacctq @@ -65,43 +67,44 @@ initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@Registe reverse -- most recent last items - -- pre-render all items; these will be the List elements. This helps calculate column widths. + -- generate pre-rendered list items. This helps calculate column widths. displayitems = map displayitem items' where displayitem (t, _, _issplit, otheracctsstr, change, bal) = - (showDate $ tdate t - ,T.unpack $ tdescription t - ,case splitOn ", " otheracctsstr of - [s] -> s - ss -> intercalate ", " ss - -- _ -> "" -- should do this if accounts field width < 30 - ,showMixedAmountOneLineWithoutPrice change - ,showMixedAmountOneLineWithoutPrice bal - ,t - ) + RegisterScreenItem{rsItemDate = showDate $ tdate t + ,rsItemDescription = T.unpack $ tdescription t + ,rsItemOtherAccounts = case splitOn ", " otheracctsstr of + [s] -> s + ss -> intercalate ", " ss + -- _ -> "" -- should do this if accounts field width < 30 + ,rsItemChangeAmount = showMixedAmountOneLineWithoutPrice change + ,rsItemBalanceAmount = showMixedAmountOneLineWithoutPrice bal + ,rsItemTransaction = t + } -- build the List - newl = list (Name "register") (V.fromList displayitems) 1 + newitems = list (Name "register") (V.fromList displayitems) 1 -- keep the selection on the previously selected transaction if possible, -- (eg after toggling nonzero mode), otherwise select the last element. - newl' = listMoveTo newselidx newl + newitems' = listMoveTo newselidx newitems where - newselidx = case (reset, listSelectedElement oldl) of - (True, _) -> 0 - (_, Nothing) -> endidx - (_, Just (_,(_,_,_,_,_,Transaction{tindex=ti}))) -> fromMaybe endidx $ findIndex ((==ti) . tindex . sixth6) displayitems + newselidx = case (reset, listSelectedElement rsItems) 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" drawRegisterScreen :: AppState -> [Widget] drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} - ,aScreen=RegisterScreen{rsState=(l,acct)} + ,aScreen=RegisterScreen{rsState=RegisterScreenState{..}} ,aMinibuffer=mbuf} = [ui] where - toplabel = withAttr ("border" <> "bold") (str $ T.unpack acct) + toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsSelectedAccount) <+> togglefilters <+> str " transactions" <+> borderQueryStr (query_ ropts) @@ -121,11 +124,11 @@ drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} ] of [] -> str "" fs -> withAttr (borderAttr <> "query") (str $ " " ++ intercalate ", " fs) - cur = str $ case l^.listSelectedL of + cur = str $ case rsItems ^. listSelectedL of Nothing -> "-" Just i -> show (i + 1) total = str $ show $ length displayitems - displayitems = V.toList $ l^.listElementsL + displayitems = V.toList $ rsItems ^. listElementsL -- query = query_ $ reportopts_ $ cliopts_ opts @@ -148,8 +151,8 @@ drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} whitespacewidth = 10 -- inter-column whitespace, fixed width minnonamtcolswidth = datewidth + 2 + 2 -- date column plus at least 2 for desc and accts maxamtswidth = max 0 (totalwidth - minnonamtcolswidth - whitespacewidth) - maxchangewidthseen = maximum' $ map (strWidth . fourth6) displayitems - maxbalwidthseen = maximum' $ map (strWidth . fifth6) displayitems + maxchangewidthseen = maximum' $ map (strWidth . rsItemChangeAmount) displayitems + maxbalwidthseen = maximum' $ map (strWidth . rsItemBalanceAmount) displayitems changewidthproportion = fromIntegral maxchangewidthseen / fromIntegral (maxchangewidthseen + maxbalwidthseen) maxchangewidth = round $ changewidthproportion * fromIntegral maxamtswidth maxbalwidth = maxamtswidth - maxchangewidth @@ -193,34 +196,34 @@ drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} Nothing -> bottomlabel Just ed -> minibuffer ed - render $ defaultLayout toplabel bottomarea $ renderList l (drawRegisterItem colwidths) + render $ defaultLayout toplabel bottomarea $ renderList rsItems (drawRegisterItem colwidths) drawRegisterScreen _ = error "draw function called with wrong screen type, should not happen" -drawRegisterItem :: (Int,Int,Int,Int,Int) -> Bool -> (String,String,String,String,String,Transaction) -> Widget -drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected (date,desc,accts,change,bal,_) = +drawRegisterItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget +drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} = Widget Greedy Fixed $ do render $ - str (fitString (Just datewidth) (Just datewidth) True True date) <+> + str (fitString (Just datewidth) (Just datewidth) True True rsItemDate) <+> str " " <+> - str (fitString (Just descwidth) (Just descwidth) True True desc) <+> + str (fitString (Just descwidth) (Just descwidth) True True rsItemDescription) <+> str " " <+> - str (fitString (Just acctswidth) (Just acctswidth) True True accts) <+> + str (fitString (Just acctswidth) (Just acctswidth) True True rsItemOtherAccounts) <+> str " " <+> - withAttr changeattr (str (fitString (Just changewidth) (Just changewidth) True False change)) <+> + withAttr changeattr (str (fitString (Just changewidth) (Just changewidth) True False rsItemChangeAmount)) <+> str " " <+> - withAttr balattr (str (fitString (Just balwidth) (Just balwidth) True False bal)) + withAttr balattr (str (fitString (Just balwidth) (Just balwidth) True False rsItemBalanceAmount)) where - changeattr | '-' `elem` change = sel $ "list" <> "amount" <> "decrease" - | otherwise = sel $ "list" <> "amount" <> "increase" - balattr | '-' `elem` bal = sel $ "list" <> "balance" <> "negative" - | otherwise = sel $ "list" <> "balance" <> "positive" + changeattr | '-' `elem` rsItemChangeAmount = sel $ "list" <> "amount" <> "decrease" + | otherwise = sel $ "list" <> "amount" <> "increase" + balattr | '-' `elem` rsItemBalanceAmount = sel $ "list" <> "balance" <> "negative" + | otherwise = sel $ "list" <> "balance" <> "positive" sel | selected = (<> "selected") | otherwise = id handleRegisterScreen :: AppState -> Vty.Event -> EventM (Next AppState) handleRegisterScreen st@AppState{ - aScreen=s@RegisterScreen{rsState=(l,acct)} + aScreen=s@RegisterScreen{rsState=rsState@RegisterScreenState{..}} ,aopts=UIOpts{cliopts_=copts} ,ajournal=j ,aMinibuffer=mbuf @@ -242,20 +245,22 @@ handleRegisterScreen st@AppState{ Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do - case listSelectedElement l of - Just (_, (_, _, _, _, _, t)) -> + case listSelectedElement rsItems of + Just (_, RegisterScreenItem{rsItemTransaction=t}) -> let - ts = map sixth6 $ V.toList $ listElements l + ts = map rsItemTransaction $ V.toList $ listElements rsItems numberedts = zip [1..] ts i = fromIntegral $ maybe 0 (+1) $ elemIndex t ts -- XXX in - continue $ screenEnter d transactionScreen{tsState=((i,t),numberedts,acct)} st + continue $ screenEnter d transactionScreen{tsState=TransactionScreenState{tsTransaction=(i,t) + ,tsTransactions=numberedts + ,tsSelectedAccount=rsSelectedAccount}} st Nothing -> continue st -- fall through to the list's event handler (handles [pg]up/down) ev -> do - l' <- handleEvent ev l - continue st{aScreen=s{rsState=(l',acct)}} + newitems <- handleEvent ev rsItems + continue st{aScreen=s{rsState=rsState{rsItems=newitems}}} -- continue =<< handleEventLensed st someLens ev Just ed -> diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 0c7827111..94060bdc1 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -1,6 +1,6 @@ -- The transaction screen, showing a single transaction's general journal entry. -{-# LANGUAGE OverloadedStrings, TupleSections #-} -- , FlexibleContexts +{-# LANGUAGE OverloadedStrings, TupleSections, RecordWildCards #-} -- , FlexibleContexts module Hledger.UI.TransactionScreen (transactionScreen @@ -37,7 +37,9 @@ import Hledger.UI.ErrorScreen transactionScreen :: Screen transactionScreen = TransactionScreen{ - tsState = ((1,nulltransaction),[(1,nulltransaction)],"") + tsState = TransactionScreenState{tsTransaction=(1,nulltransaction) + ,tsTransactions=[(1,nulltransaction)] + ,tsSelectedAccount=""} ,sInitFn = initTransactionScreen ,sDrawFn = drawTransactionScreen ,sHandleFn = handleTransactionScreen @@ -45,15 +47,17 @@ transactionScreen = TransactionScreen{ initTransactionScreen :: Day -> Bool -> AppState -> AppState initTransactionScreen _d _reset st@AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}} - ,ajournal=_j - ,aScreen=s@TransactionScreen{tsState=((n,t),nts,a)}} = - st{aScreen=s{tsState=((n,t),nts,a)}} - + ,ajournal=_j + ,aScreen=TransactionScreen{..}} = st initTransactionScreen _ _ _ = error "init function called with wrong screen type, should not happen" drawTransactionScreen :: AppState -> [Widget] drawTransactionScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} - ,aScreen=TransactionScreen{tsState=((i,t),nts,acct)}} = [ui] + ,aScreen=TransactionScreen{ + tsState=TransactionScreenState{tsTransaction=(i,t) + ,tsTransactions=nts + ,tsSelectedAccount=acct}}} = + [ui] where -- datedesc = show (tdate t) ++ " " ++ tdescription t toplabel = @@ -95,11 +99,14 @@ drawTransactionScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} drawTransactionScreen _ = 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=((i,t),nts,acct)} - ,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} - ,ajournal=j - } e = do +handleTransactionScreen + st@AppState{aScreen=s@TransactionScreen{tsState=tsState@TransactionScreenState{tsTransaction=(i,t) + ,tsTransactions=nts + ,tsSelectedAccount=acct}} + ,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} + ,ajournal=j + } + e = do d <- liftIO getCurrentDay let (iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts @@ -131,18 +138,20 @@ handleTransactionScreen st@AppState{ Nothing | null numberedts -> (0,nulltransaction) | i > fst (last numberedts) -> last numberedts | otherwise -> head numberedts - st' = st{aScreen=s{tsState=((i',t'),numberedts,acct)}} + st' = st{aScreen=s{tsState=TransactionScreenState{tsTransaction=(i',t') + ,tsTransactions=numberedts + ,tsSelectedAccount=acct}}} continue $ regenerateScreens j' d st' - Left err -> continue $ screenEnter d errorScreen{esState=err} st + Left err -> continue $ screenEnter d errorScreen{esState=ErrorScreenState{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=((iprev,tprev),nts,acct)}} - Vty.EvKey (Vty.KDown) [] -> continue $ regenerateScreens j d st{aScreen=s{tsState=((inext,tnext),nts,acct)}} + 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.KLeft) [] -> continue st'' where @@ -153,7 +162,7 @@ handleTransactionScreen st@AppState{ handleTransactionScreen _ _ = error "event handler called with wrong screen type, should not happen" -rsSetSelectedTransaction i scr@RegisterScreen{rsState=(l,a)} = scr{rsState=(l',a)} - where l' = listMoveTo (i-1) l +rsSetSelectedTransaction i scr@RegisterScreen{rsState=rsState@RegisterScreenState{..}} = scr{rsState=rsState{rsItems=l'}} + where l' = listMoveTo (i-1) rsItems rsSetSelectedTransaction _ scr = scr diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index cbdfb7b03..708126ce5 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -62,51 +62,75 @@ data AppState = AppState { -- partial functions, so take care. data Screen = AccountsScreen { - asState :: (List -- list widget holding: - (Int -- indent level - ,AccountName -- full account name - ,AccountName -- full or short account name to display - ,[String] -- rendered amounts - ) - ,AccountName -- full name of the currently selected account (or "") - ) - ,sInitFn :: Day -> Bool -> AppState -> AppState -- ^ function to generate/update the screen's state, - -- takes the current date and whether to reset the selection. - ,sDrawFn :: AppState -> [Widget] -- ^ brick renderer to use for this screen - ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) -- ^ brick event handler to use for this screen + 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 -> V.Event -> EventM (Next AppState) -- ^ brick event handler for this screen } | RegisterScreen { - rsState :: (List -- list widget holding: - (String -- date - ,String -- description - ,String -- other accts - ,String -- change amt - ,String -- balance amt - ,Transaction -- the full transaction - ) - ,AccountName -- full name of the acct we are showing a register for - ) + rsState :: RegisterScreenState ,sInitFn :: Day -> Bool -> AppState -> AppState ,sDrawFn :: AppState -> [Widget] ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) } | TransactionScreen { - tsState :: ((Integer, Transaction) -- the (numbered) transaction we are currently viewing - ,[(Integer, Transaction)] -- the list of numbered transactions we can step through - ,AccountName -- the account whose register we entered this screen from - ) + tsState :: TransactionScreenState ,sInitFn :: Day -> Bool -> AppState -> AppState ,sDrawFn :: AppState -> [Widget] ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) - } + } | ErrorScreen { - esState :: String -- error message to display + esState :: ErrorScreenState ,sInitFn :: Day -> Bool -> AppState -> AppState ,sDrawFn :: AppState -> [Widget] ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) } deriving (Show) +-- | 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 + ,asItemAccountName :: AccountName -- ^ full account name + ,asItemDisplayAccountName :: AccountName -- ^ full or short account name to display + ,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 + ,rsItemDescription :: String -- ^ description + ,rsItemOtherAccounts :: String -- ^ other accounts + ,rsItemChangeAmount :: String -- ^ the change to the current account from this transaction + ,rsItemBalanceAmount :: String -- ^ the balance or running total after this transaction + ,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) + instance Show (List a) where show _ = "" instance Show Editor where show _ = "" diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index 1652c949c..837d4bfe2 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -133,10 +133,10 @@ regenerateScreens j d st@AppState{aScreen=s,aPrevScreens=ss} = -- 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 - st0 = st{ajournal=j, aScreen=first, aPrevScreens=[]} - st1 = (sInitFn first) d False st0 - st2 = foldl' (\st s -> (sInitFn s) d False $ pushScreen s st) st1 rest + 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 in st2