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

ui: convert screen states to records

Browse Source 
This is highly verbose, but potentially clearer, allows better haddock docs, and hopefully will improve after lensification.
This commit is contained in:
Simon Michael 2016-06-08 12:15:58 -07:00
parent 5259605e82
commit 5c343a5848
6 changed files with 179 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -41,36 +41,38 @@ import Hledger.UI.ErrorScreen
accountsScreen :: Screen accountsScreen :: Screen
accountsScreen = AccountsScreen{ accountsScreen = AccountsScreen{
asState = (list "accounts" V.empty 1, "") asState = AccountsScreenState{asItems=list "accounts" V.empty 1
,asSelectedAccount=""
}
,sInitFn = initAccountsScreen ,sInitFn = initAccountsScreen
,sDrawFn = drawAccountsScreen ,sDrawFn = drawAccountsScreen
,sHandleFn = handleAccountsScreen ,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 asSetSelectedAccount _ scr = scr
initAccountsScreen :: Day -> Bool -> AppState -> AppState initAccountsScreen :: Day -> Bool -> AppState -> AppState
initAccountsScreen d reset st@AppState{ initAccountsScreen d reset st@AppState{
aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}, aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}},
ajournal=j, 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 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 -- keep the selection near the last selected account
-- (may need to move to the next leaf account when entering flat mode) -- (may need to move to the next leaf account when entering flat mode)
newl' = listMoveTo selidx newl newitems' = listMoveTo selidx newitems
where where
selidx = case (reset, listSelectedElement oldl) of selidx = case (reset, listSelectedElement asItems) of
(True, _) -> 0 (True, _) -> 0
(_, Nothing) -> 0 (_, Nothing) -> 0
(_, Just (_,(_,a,_,_))) -> fromMaybe (fromMaybe 0 mprefixmatch) mexactmatch (_, Just (_,AccountsScreenItem{asItemAccountName=a})) -> fromMaybe (fromMaybe 0 mprefixmatch) mexactmatch
where where
mexactmatch = findIndex ((a ==) . second4) displayitems mexactmatch = findIndex ((a ==) . asItemAccountName) displayitems
mprefixmatch = findIndex ((a `isAccountNamePrefixOf`) . second4) displayitems mprefixmatch = findIndex ((a `isAccountNamePrefixOf`) . asItemAccountName) displayitems
uopts' = uopts{cliopts_=copts{reportopts_=ropts'}} uopts' = uopts{cliopts_=copts{reportopts_=ropts'}}
ropts' = ropts { ropts' = ropts {
-- XXX balanceReport doesn't respect this yet -- XXX balanceReport doesn't respect this yet
@ -90,11 +92,11 @@ initAccountsScreen d reset st@AppState{
-- pre-render the list items -- pre-render the list items
displayitem ((fullacct, shortacct, indent), bal) = displayitem ((fullacct, shortacct, indent), bal) =
(indent AccountsScreenItem{asItemIndentLevel = indent
,fullacct ,asItemAccountName = fullacct
,if flat_ ropts' then fullacct else shortacct ,asItemDisplayAccountName = if flat_ ropts' then fullacct else shortacct
,map showAmountWithoutPrice amts -- like showMixedAmountOneLineWithoutPrice ,asItemRenderedAmounts = map showAmountWithoutPrice amts -- like showMixedAmountOneLineWithoutPrice
) }
where where
Mixed amts = normaliseMixedAmountSquashPricesForDisplay $ stripPrices bal Mixed amts = normaliseMixedAmountSquashPricesForDisplay $ stripPrices bal
stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice} 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 -> [Widget]
drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
,ajournal=j ,ajournal=j
,aScreen=AccountsScreen{asState=(l,_)} ,aScreen=AccountsScreen{asState=AccountsScreenState{..}}
,aMinibuffer=mbuf} = ,aMinibuffer=mbuf} =
[ui] [ui]
where where
@ -139,10 +141,10 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns" fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns"
nonzero | empty_ ropts = str "" nonzero | empty_ ropts = str ""
| otherwise = withAttr (borderAttr <> "query") (str " nonzero") | otherwise = withAttr (borderAttr <> "query") (str " nonzero")
cur = str (case l^.listSelectedL of cur = str (case asItems ^. listSelectedL of
Nothing -> "-" Nothing -> "-"
Just i -> show (i + 1)) Just i -> show (i + 1))
total = str $ show $ V.length $ l^.listElementsL total = str $ show $ V.length $ asItems ^. listElementsL
bottomlabel = borderKeysStr [ bottomlabel = borderKeysStr [
-- ("up/down/pgup/pgdown/home/end", "move") -- ("up/down/pgup/pgdown/home/end", "move")
@ -171,16 +173,16 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
-- ltrace "availwidth" $ -- ltrace "availwidth" $
c^.availWidthL c^.availWidthL
- 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
displayitems = listElements l displayitems = listElements asItems
maxacctwidthseen = maxacctwidthseen =
-- ltrace "maxacctwidthseen" $ -- ltrace "maxacctwidthseen" $
V.maximum $ 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) $ -- V.filter (\(indent,_,_,_) -> (indent-1) <= fromMaybe 99999 mdepth) $
displayitems displayitems
maxbalwidthseen = maxbalwidthseen =
-- ltrace "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 = maxbalwidth =
-- ltrace "maxbalwidth" $ -- ltrace "maxbalwidth" $
max 0 (availwidth - 2 - 4) -- leave 2 whitespace plus least 4 for accts 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) 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" drawAccountsScreen _ = error "draw function called with wrong screen type, should not happen"
drawAccountsItem :: (Int,Int) -> Bool -> (Int, AccountName, AccountName, [String]) -> Widget drawAccountsItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget
drawAccountsItem (acctwidth, balwidth) selected (indent, _fullacct, displayacct, balamts) = drawAccountsItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
Widget Greedy Fixed $ do Widget Greedy Fixed $ do
-- c <- getContext -- c <- getContext
-- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt -- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt
render $ render $
addamts balamts $ addamts asItemRenderedAmounts $
str (T.unpack $ fitText (Just acctwidth) (Just acctwidth) True True $ T.replicate (2*indent) " " <> displayacct) <+> str (T.unpack $ fitText (Just acctwidth) (Just acctwidth) True True $ T.replicate (2*asItemIndentLevel) " " <> asItemDisplayAccountName) <+>
str " " <+> str " " <+>
str (balspace balamts) str (balspace asItemRenderedAmounts)
where where
balspace as = replicate n ' ' balspace as = replicate n ' '
where n = max 0 (balwidth - (sum (map strWidth as) + 2 * (length as - 1))) 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 :: AppState -> Vty.Event -> EventM (Next AppState)
handleAccountsScreen st@AppState{ handleAccountsScreen st@AppState{
aScreen=scr@AccountsScreen{asState=(l,selacct)} aScreen=scr@AccountsScreen{asState=asState@AccountsScreenState{..}}
,aopts=UIOpts{cliopts_=copts} ,aopts=UIOpts{cliopts_=copts}
,ajournal=j ,ajournal=j
,aMinibuffer=mbuf ,aMinibuffer=mbuf
@ -245,10 +247,10 @@ handleAccountsScreen st@AppState{
-- before we go anywhere, remember the currently selected account. -- before we go anywhere, remember the currently selected account.
-- (This is preserved across screen changes, unlike List's selection state) -- (This is preserved across screen changes, unlike List's selection state)
let let
selacct' = case listSelectedElement l of selacct = case listSelectedElement asItems of
Just (_, (_, fullacct, _, _)) -> fullacct Just (_, AccountsScreenItem{..}) -> asItemAccountName
Nothing -> selacct Nothing -> asSelectedAccount
st' = st{aScreen=scr{asState=(l,selacct')}} st' = st{aScreen=scr{asState=asState{asSelectedAccount=selacct}}}
case mbuf of case mbuf of
Nothing -> Nothing ->
@ -281,15 +283,15 @@ handleAccountsScreen st@AppState{
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st' Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st'
Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do
let let
scr = rsSetCurrentAccount selacct' registerScreen scr = rsSetCurrentAccount selacct registerScreen
st'' = screenEnter d scr st' st'' = screenEnter d scr st'
scrollTopRegister scrollTopRegister
continue st'' continue st''
-- fall through to the list's event handler (handles up/down) -- fall through to the list's event handler (handles up/down)
ev -> do ev -> do
l' <- handleEvent ev l newitems <- handleEvent ev asItems
continue $ st'{aScreen=scr{asState=(l',selacct')}} continue $ st'{aScreen=scr{asState=asState{asItems=newitems,asSelectedAccount=selacct}}}
-- continue =<< handleEventLensed st' someLens ev -- continue =<< handleEventLensed st' someLens ev
Just ed -> Just ed ->

12
hledger-ui/Hledger/UI/ErrorScreen.hs
View File

@ -1,6 +1,6 @@
-- The error screen, showing a current error condition (such as a parse error after reloading the journal) -- 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 module Hledger.UI.ErrorScreen
(errorScreen (errorScreen
@ -30,7 +30,7 @@ import Hledger.UI.UIUtils
errorScreen :: Screen errorScreen :: Screen
errorScreen = ErrorScreen{ errorScreen = ErrorScreen{
esState = "" esState = ErrorScreenState{esError=""}
,sInitFn = initErrorScreen ,sInitFn = initErrorScreen
,sDrawFn = drawErrorScreen ,sDrawFn = drawErrorScreen
,sHandleFn = handleErrorScreen ,sHandleFn = handleErrorScreen
@ -42,7 +42,7 @@ initErrorScreen _ _ _ = error "init function called with wrong screen type, shou
drawErrorScreen :: AppState -> [Widget] drawErrorScreen :: AppState -> [Widget]
drawErrorScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}}, drawErrorScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
aScreen=ErrorScreen{esState=err}} = [ui] aScreen=ErrorScreen{esState=ErrorScreenState{..}}} = [ui]
where where
toplabel = withAttr ("border" <> "bold") (str "Oops. Please fix this problem then press g to reload") toplabel = withAttr ("border" <> "bold") (str "Oops. Please fix this problem then press g to reload")
-- <+> str " transactions" -- <+> str " transactions"
@ -75,7 +75,7 @@ drawErrorScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reporto
-- totalwidth = c^.availWidthL -- totalwidth = c^.availWidthL
-- - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) -- - 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" 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 Vty.EvKey (Vty.KChar 'g') [] -> do
(ej, _) <- liftIO $ journalReloadIfChanged copts d j (ej, _) <- liftIO $ journalReloadIfChanged copts d j
case ej of 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 Right j' -> continue $ regenerateScreens j' d $ popScreen st -- return to previous screen, and reload it
-- Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st -- Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
@ -133,5 +133,5 @@ stReloadJournalIfChanged copts d j st = do
(ej, _) <- journalReloadIfChanged copts d j (ej, _) <- journalReloadIfChanged copts d j
return $ case ej of return $ case ej of
Right j' -> regenerateScreens j' d st Right j' -> regenerateScreens j' d st
Left err -> screenEnter d errorScreen{esState=err} st Left err -> screenEnter d errorScreen{esState=ErrorScreenState{esError=err}} st

101
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -1,6 +1,6 @@
-- The account register screen, showing transactions in an account, like hledger-web's register. -- 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 module Hledger.UI.RegisterScreen
(registerScreen (registerScreen
@ -37,18 +37,20 @@ import Hledger.UI.ErrorScreen
registerScreen :: Screen registerScreen :: Screen
registerScreen = RegisterScreen{ registerScreen = RegisterScreen{
rsState = (list "register" V.empty 1, "") rsState = RegisterScreenState{rsItems=list "register" V.empty 1
,rsSelectedAccount=""
}
,sInitFn = initRegisterScreen ,sInitFn = initRegisterScreen
,sDrawFn = drawRegisterScreen ,sDrawFn = drawRegisterScreen
,sHandleFn = handleRegisterScreen ,sHandleFn = handleRegisterScreen
} }
rsSetCurrentAccount a scr@RegisterScreen{rsState=(l,_)} = scr{rsState=(l,a)} rsSetCurrentAccount a scr@RegisterScreen{..} = scr{rsState=rsState{rsSelectedAccount=a}}
rsSetCurrentAccount _ scr = scr rsSetCurrentAccount _ scr = scr
initRegisterScreen :: Day -> Bool -> AppState -> AppState initRegisterScreen :: Day -> Bool -> AppState -> AppState
initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{rsState=(oldl,acct)}} = initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{rsState=rsState@RegisterScreenState{..}}} =
st{aScreen=s{rsState=(newl',acct)}} st{aScreen=s{rsState=rsState{rsItems=newitems'}}}
where where
-- gather arguments and queries -- gather arguments and queries
ropts = (reportopts_ $ cliopts_ opts) ropts = (reportopts_ $ cliopts_ opts)
@ -57,7 +59,7 @@ initRegisterScreen d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@Registe
balancetype_=HistoricalBalance balancetype_=HistoricalBalance
} }
-- XXX temp -- XXX temp
thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs thisacctq = Acct $ accountNameToAccountRegex rsSelectedAccount -- includes subs
q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts
(_label,items) = accountTransactionsReport ropts j q thisacctq (_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 reverse -- most recent last
items 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' displayitems = map displayitem items'
where where
displayitem (t, _, _issplit, otheracctsstr, change, bal) = displayitem (t, _, _issplit, otheracctsstr, change, bal) =
(showDate $ tdate t RegisterScreenItem{rsItemDate = showDate $ tdate t
,T.unpack $ tdescription t ,rsItemDescription = T.unpack $ tdescription t
,case splitOn ", " otheracctsstr of ,rsItemOtherAccounts = case splitOn ", " otheracctsstr of
[s] -> s [s] -> s
ss -> intercalate ", " ss ss -> intercalate ", " ss
-- _ -> "<split>" -- should do this if accounts field width < 30 -- _ -> "<split>" -- should do this if accounts field width < 30
,showMixedAmountOneLineWithoutPrice change ,rsItemChangeAmount = showMixedAmountOneLineWithoutPrice change
,showMixedAmountOneLineWithoutPrice bal ,rsItemBalanceAmount = showMixedAmountOneLineWithoutPrice bal
,t ,rsItemTransaction = t
) }
-- build the List -- 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, -- keep the selection on the previously selected transaction if possible,
-- (eg after toggling nonzero mode), otherwise select the last element. -- (eg after toggling nonzero mode), otherwise select the last element.
newl' = listMoveTo newselidx newl newitems' = listMoveTo newselidx newitems
where where
newselidx = case (reset, listSelectedElement oldl) of newselidx = case (reset, listSelectedElement rsItems) of
(True, _) -> 0 (True, _) -> 0
(_, Nothing) -> endidx (_, Nothing) -> endidx
(_, Just (_,(_,_,_,_,_,Transaction{tindex=ti}))) -> fromMaybe endidx $ findIndex ((==ti) . tindex . sixth6) displayitems (_, Just (_,RegisterScreenItem{rsItemTransaction=Transaction{tindex=ti}}))
-> fromMaybe endidx $ findIndex ((==ti) . tindex . rsItemTransaction) displayitems
endidx = length displayitems endidx = length displayitems
initRegisterScreen _ _ _ = error "init function called with wrong screen type, should not happen" initRegisterScreen _ _ _ = error "init function called with wrong screen type, should not happen"
drawRegisterScreen :: AppState -> [Widget] drawRegisterScreen :: AppState -> [Widget]
drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
,aScreen=RegisterScreen{rsState=(l,acct)} ,aScreen=RegisterScreen{rsState=RegisterScreenState{..}}
,aMinibuffer=mbuf} ,aMinibuffer=mbuf}
= [ui] = [ui]
where where
toplabel = withAttr ("border" <> "bold") (str $ T.unpack acct) toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsSelectedAccount)
<+> togglefilters <+> togglefilters
<+> str " transactions" <+> str " transactions"
<+> borderQueryStr (query_ ropts) <+> borderQueryStr (query_ ropts)
@ -121,11 +124,11 @@ drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
] of ] of
[] -> str "" [] -> str ""
fs -> withAttr (borderAttr <> "query") (str $ " " ++ intercalate ", " fs) fs -> withAttr (borderAttr <> "query") (str $ " " ++ intercalate ", " fs)
cur = str $ case l^.listSelectedL of cur = str $ case rsItems ^. listSelectedL of
Nothing -> "-" Nothing -> "-"
Just i -> show (i + 1) Just i -> show (i + 1)
total = str $ show $ length displayitems total = str $ show $ length displayitems
displayitems = V.toList $ l^.listElementsL displayitems = V.toList $ rsItems ^. listElementsL
-- query = query_ $ reportopts_ $ cliopts_ opts -- query = query_ $ reportopts_ $ cliopts_ opts
@ -148,8 +151,8 @@ drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
whitespacewidth = 10 -- inter-column whitespace, fixed width whitespacewidth = 10 -- inter-column whitespace, fixed width
minnonamtcolswidth = datewidth + 2 + 2 -- date column plus at least 2 for desc and accts minnonamtcolswidth = datewidth + 2 + 2 -- date column plus at least 2 for desc and accts
maxamtswidth = max 0 (totalwidth - minnonamtcolswidth - whitespacewidth) maxamtswidth = max 0 (totalwidth - minnonamtcolswidth - whitespacewidth)
maxchangewidthseen = maximum' $ map (strWidth . fourth6) displayitems maxchangewidthseen = maximum' $ map (strWidth . rsItemChangeAmount) displayitems
maxbalwidthseen = maximum' $ map (strWidth . fifth6) displayitems maxbalwidthseen = maximum' $ map (strWidth . rsItemBalanceAmount) displayitems
changewidthproportion = fromIntegral maxchangewidthseen / fromIntegral (maxchangewidthseen + maxbalwidthseen) changewidthproportion = fromIntegral maxchangewidthseen / fromIntegral (maxchangewidthseen + maxbalwidthseen)
maxchangewidth = round $ changewidthproportion * fromIntegral maxamtswidth maxchangewidth = round $ changewidthproportion * fromIntegral maxamtswidth
maxbalwidth = maxamtswidth - maxchangewidth maxbalwidth = maxamtswidth - maxchangewidth
@ -193,34 +196,34 @@ drawRegisterScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
Nothing -> bottomlabel Nothing -> bottomlabel
Just ed -> minibuffer ed 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" 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 :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget
drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected (date,desc,accts,change,bal,_) = drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} =
Widget Greedy Fixed $ do Widget Greedy Fixed $ do
render $ render $
str (fitString (Just datewidth) (Just datewidth) True True date) <+> str (fitString (Just datewidth) (Just datewidth) True True rsItemDate) <+>
str " " <+> str " " <+>
str (fitString (Just descwidth) (Just descwidth) True True desc) <+> str (fitString (Just descwidth) (Just descwidth) True True rsItemDescription) <+>
str " " <+> str " " <+>
str (fitString (Just acctswidth) (Just acctswidth) True True accts) <+> str (fitString (Just acctswidth) (Just acctswidth) True True rsItemOtherAccounts) <+>
str " " <+> str " " <+>
withAttr changeattr (str (fitString (Just changewidth) (Just changewidth) True False change)) <+> withAttr changeattr (str (fitString (Just changewidth) (Just changewidth) True False rsItemChangeAmount)) <+>
str " " <+> str " " <+>
withAttr balattr (str (fitString (Just balwidth) (Just balwidth) True False bal)) withAttr balattr (str (fitString (Just balwidth) (Just balwidth) True False rsItemBalanceAmount))
where where
changeattr | '-' `elem` change = sel $ "list" <> "amount" <> "decrease" changeattr | '-' `elem` rsItemChangeAmount = sel $ "list" <> "amount" <> "decrease"
| otherwise = sel $ "list" <> "amount" <> "increase" | otherwise = sel $ "list" <> "amount" <> "increase"
balattr | '-' `elem` bal = sel $ "list" <> "balance" <> "negative" balattr | '-' `elem` rsItemBalanceAmount = sel $ "list" <> "balance" <> "negative"
| otherwise = sel $ "list" <> "balance" <> "positive" | otherwise = sel $ "list" <> "balance" <> "positive"
sel | selected = (<> "selected") sel | selected = (<> "selected")
| otherwise = id | otherwise = id
handleRegisterScreen :: AppState -> Vty.Event -> EventM (Next AppState) handleRegisterScreen :: AppState -> Vty.Event -> EventM (Next AppState)
handleRegisterScreen st@AppState{ handleRegisterScreen st@AppState{
aScreen=s@RegisterScreen{rsState=(l,acct)} aScreen=s@RegisterScreen{rsState=rsState@RegisterScreenState{..}}
,aopts=UIOpts{cliopts_=copts} ,aopts=UIOpts{cliopts_=copts}
,ajournal=j ,ajournal=j
,aMinibuffer=mbuf ,aMinibuffer=mbuf
@ -242,20 +245,22 @@ handleRegisterScreen st@AppState{
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do
case listSelectedElement l of case listSelectedElement rsItems of
Just (_, (_, _, _, _, _, t)) -> Just (_, RegisterScreenItem{rsItemTransaction=t}) ->
let let
ts = map sixth6 $ V.toList $ listElements l ts = map rsItemTransaction $ V.toList $ listElements rsItems
numberedts = zip [1..] ts numberedts = zip [1..] ts
i = fromIntegral $ maybe 0 (+1) $ elemIndex t ts -- XXX i = fromIntegral $ maybe 0 (+1) $ elemIndex t ts -- XXX
in 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 Nothing -> continue st
-- fall through to the list's event handler (handles [pg]up/down) -- fall through to the list's event handler (handles [pg]up/down)
ev -> do ev -> do
l' <- handleEvent ev l newitems <- handleEvent ev rsItems
continue st{aScreen=s{rsState=(l',acct)}} continue st{aScreen=s{rsState=rsState{rsItems=newitems}}}
-- continue =<< handleEventLensed st someLens ev -- continue =<< handleEventLensed st someLens ev
Just ed -> Just ed ->

45
hledger-ui/Hledger/UI/TransactionScreen.hs
View File

@ -1,6 +1,6 @@
-- The transaction screen, showing a single transaction's general journal entry. -- The transaction screen, showing a single transaction's general journal entry.
{-# LANGUAGE OverloadedStrings, TupleSections #-} -- , FlexibleContexts {-# LANGUAGE OverloadedStrings, TupleSections, RecordWildCards #-} -- , FlexibleContexts
module Hledger.UI.TransactionScreen module Hledger.UI.TransactionScreen
(transactionScreen (transactionScreen
@ -37,7 +37,9 @@ import Hledger.UI.ErrorScreen
transactionScreen :: Screen transactionScreen :: Screen
transactionScreen = TransactionScreen{ transactionScreen = TransactionScreen{
tsState = ((1,nulltransaction),[(1,nulltransaction)],"") tsState = TransactionScreenState{tsTransaction=(1,nulltransaction)
,tsTransactions=[(1,nulltransaction)]
,tsSelectedAccount=""}
,sInitFn = initTransactionScreen ,sInitFn = initTransactionScreen
,sDrawFn = drawTransactionScreen ,sDrawFn = drawTransactionScreen
,sHandleFn = handleTransactionScreen ,sHandleFn = handleTransactionScreen
@ -45,15 +47,17 @@ transactionScreen = TransactionScreen{
initTransactionScreen :: Day -> Bool -> AppState -> AppState initTransactionScreen :: Day -> Bool -> AppState -> AppState
initTransactionScreen _d _reset st@AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}} initTransactionScreen _d _reset st@AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}}
,ajournal=_j ,ajournal=_j
,aScreen=s@TransactionScreen{tsState=((n,t),nts,a)}} = ,aScreen=TransactionScreen{..}} = st
st{aScreen=s{tsState=((n,t),nts,a)}}
initTransactionScreen _ _ _ = error "init function called with wrong screen type, should not happen" initTransactionScreen _ _ _ = error "init function called with wrong screen type, should not happen"
drawTransactionScreen :: AppState -> [Widget] drawTransactionScreen :: AppState -> [Widget]
drawTransactionScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} 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 where
-- datedesc = show (tdate t) ++ " " ++ tdescription t -- datedesc = show (tdate t) ++ " " ++ tdescription t
toplabel = 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" drawTransactionScreen _ = error "draw function called with wrong screen type, should not happen"
handleTransactionScreen :: AppState -> Vty.Event -> EventM (Next AppState) handleTransactionScreen :: AppState -> Vty.Event -> EventM (Next AppState)
handleTransactionScreen st@AppState{ handleTransactionScreen
aScreen=s@TransactionScreen{tsState=((i,t),nts,acct)} st@AppState{aScreen=s@TransactionScreen{tsState=tsState@TransactionScreenState{tsTransaction=(i,t)
,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} ,tsTransactions=nts
,ajournal=j ,tsSelectedAccount=acct}}
} e = do ,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
,ajournal=j
}
e = do
d <- liftIO getCurrentDay d <- liftIO getCurrentDay
let let
(iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts (iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts
@ -131,18 +138,20 @@ handleTransactionScreen st@AppState{
Nothing | null numberedts -> (0,nulltransaction) Nothing | null numberedts -> (0,nulltransaction)
| i > fst (last numberedts) -> last numberedts | i > fst (last numberedts) -> last numberedts
| otherwise -> head 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' 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 -- 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 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty st
-- Vty.EvKey (Vty.KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared 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.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.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=((inext,tnext),nts,acct)}} Vty.EvKey (Vty.KDown) [] -> continue $ regenerateScreens j d st{aScreen=s{tsState=tsState{tsTransaction=(inext,tnext)}}}
Vty.EvKey (Vty.KLeft) [] -> continue st'' Vty.EvKey (Vty.KLeft) [] -> continue st''
where where
@ -153,7 +162,7 @@ handleTransactionScreen st@AppState{
handleTransactionScreen _ _ = error "event handler called with wrong screen type, should not happen" handleTransactionScreen _ _ = error "event handler called with wrong screen type, should not happen"
rsSetSelectedTransaction i scr@RegisterScreen{rsState=(l,a)} = scr{rsState=(l',a)} rsSetSelectedTransaction i scr@RegisterScreen{rsState=rsState@RegisterScreenState{..}} = scr{rsState=rsState{rsItems=l'}}
where l' = listMoveTo (i-1) l where l' = listMoveTo (i-1) rsItems
rsSetSelectedTransaction _ scr = scr rsSetSelectedTransaction _ scr = scr

80
hledger-ui/Hledger/UI/UITypes.hs
View File

@ -62,51 +62,75 @@ data AppState = AppState {
-- partial functions, so take care. -- partial functions, so take care.
data Screen = data Screen =
AccountsScreen { AccountsScreen {
asState :: (List -- list widget holding: asState :: AccountsScreenState
(Int -- indent level ,sInitFn :: Day -> Bool -> AppState -> AppState -- ^ function to generate the screen's state on entry or change
,AccountName -- full account name ,sDrawFn :: AppState -> [Widget] -- ^ brick renderer for this screen
,AccountName -- full or short account name to display ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) -- ^ brick event handler for this screen
,[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
} }
| RegisterScreen { | RegisterScreen {
rsState :: (List -- list widget holding: rsState :: RegisterScreenState
(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
)
,sInitFn :: Day -> Bool -> AppState -> AppState ,sInitFn :: Day -> Bool -> AppState -> AppState
,sDrawFn :: AppState -> [Widget] ,sDrawFn :: AppState -> [Widget]
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
} }
| TransactionScreen { | TransactionScreen {
tsState :: ((Integer, Transaction) -- the (numbered) transaction we are currently viewing tsState :: TransactionScreenState
,[(Integer, Transaction)] -- the list of numbered transactions we can step through
,AccountName -- the account whose register we entered this screen from
)
,sInitFn :: Day -> Bool -> AppState -> AppState ,sInitFn :: Day -> Bool -> AppState -> AppState
,sDrawFn :: AppState -> [Widget] ,sDrawFn :: AppState -> [Widget]
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
} }
| ErrorScreen { | ErrorScreen {
esState :: String -- error message to display esState :: ErrorScreenState
,sInitFn :: Day -> Bool -> AppState -> AppState ,sInitFn :: Day -> Bool -> AppState -> AppState
,sDrawFn :: AppState -> [Widget] ,sDrawFn :: AppState -> [Widget]
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
} }
deriving (Show) 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 _ = "<List>" instance Show (List a) where show _ = "<List>"
instance Show Editor where show _ = "<Editor>" instance Show Editor where show _ = "<Editor>"

8
hledger-ui/Hledger/UI/UIUtils.hs
View File

@ -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 -- remove all the screens from the appstate and then add them back
-- one at a time, regenerating as we go. -- one at a time, regenerating as we go.
let let
first:rest = reverse $ s:ss first:rest = reverse $ s:ss :: [Screen]
st0 = st{ajournal=j, aScreen=first, aPrevScreens=[]} st0 = st{ajournal=j, aScreen=first, aPrevScreens=[]} :: AppState
st1 = (sInitFn first) d False st0 st1 = (sInitFn first) d False st0 :: AppState
st2 = foldl' (\st s -> (sInitFn s) d False $ pushScreen s st) st1 rest st2 = foldl' (\st s -> (sInitFn s) d False $ pushScreen s st) st1 rest :: AppState
in in
st2 st2