ui: convert screen states to records
This is highly verbose, but potentially clearer, allows better haddock docs, and hopefully will improve after lensification.
This commit is contained in:
Simon Michael
parent
5259605e82
commit
5c343a5848
@ -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 ->
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
-- _ -> "<split>" -- 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
|
||||
-- _ -> "<split>" -- 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 ->
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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 _ = "<List>"
|
||||
instance Show Editor where show _ = "<Editor>"
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user