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

dev: ui: as, bs: reuse update, draw code

Browse Source
This commit is contained in:
Simon Michael 2022-09-08 13:42:29 -10:00
parent a3ea054028
commit a3c0716133
8 changed files with 68 additions and 218 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,6 +8,7 @@ module Hledger.UI.AccountsScreen
(asNew
,asUpdate
,asDraw
,asDrawHelper
,asHandle
,asSetSelectedAccount
)
@ -31,7 +32,7 @@ import System.FilePath (takeFileName)
import Text.DocLayout (realLength)
import Hledger
import Hledger.Cli hiding (mode, progname, prognameandversion)
import Hledger.Cli hiding (Mode, mode, progname, prognameandversion)
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIState
@ -43,16 +44,26 @@ import Hledger.UI.RegisterScreen (rsCenterSelection)
asDraw :: UIState -> [Widget Name]
asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
,ajournal=j
,aScreen=AS sst
,aMode=mode
} = dlogUiTrace "asDraw 1" $
case mode of
Help -> [helpDialog copts, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent]
asDraw ui = dlogUiTrace "asDraw 1" $ asDrawHelper ui ropts' scrname showbalchgkey
where
ropts' = _rsReportOpts $ reportspec_ $ uoCliOpts $ aopts ui
scrname = "account " ++ if ishistorical then "balances" else "changes"
where ishistorical = balanceaccum_ ropts' == Historical
showbalchgkey = True
-- | Draw an accounts-screen-like screen.
-- The provided ReportOpts are used instead of the ones in the UIState.
-- The other arguments are the screen display name and whether to show a key
-- for toggling between end balance and balance change mode.
asDrawHelper :: UIState -> ReportOpts -> String -> Bool -> [Widget Name]
asDrawHelper UIState{aopts=uopts, ajournal=j, aScreen=AS sst, aMode=mode} ropts scrname showbalchgkey =
dlogUiTrace "asDraw 1" $
case mode of
Help -> [helpDialog, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent]
where
UIOpts{uoCliOpts=copts} = uopts
maincontent = Widget Greedy Greedy $ do
c <- getContext
let
@ -83,13 +94,12 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
render $ defaultLayout toplabel bottomlabel $ renderList (asDrawItem colwidths) True (sst ^. assList)
where
ropts = _rsReportOpts rspec
ishistorical = balanceaccum_ ropts == Historical
toplabel =
withAttr (attrName "border" <> attrName "filename") files
<+> toggles
<+> str (" account " ++ if ishistorical then "balances" else "changes")
<+> str (" " ++ scrname)
<+> borderPeriodStr (if ishistorical then "at end of" else "in") (period_ ropts)
<+> borderQueryStr (T.unpack . T.unwords . map textQuoteIfNeeded $ querystring_ ropts)
<+> borderDepthStr mdepth
@ -128,7 +138,7 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
-- ,("t", str "tree")
-- ,("l", str "list")
,("-+", str "depth")
,("H", renderToggle (not ishistorical) "end-bals" "changes")
,(if showbalchgkey then "H" else "", renderToggle (not ishistorical) "end-bals" "changes")
,("F", renderToggle1 (isJust . forecast_ $ inputopts_ copts) "forecast")
--,("/", "filter")
--,("DEL", "unfilter")
@ -137,8 +147,7 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
-- ,("g", "reload")
,("q", str "quit")
]
asDraw _ = dlogUiTrace "asDraw 2" $ errorWrongScreenType "draw function" -- PARTIAL:
asDrawHelper _ _ _ _ = dlogUiTrace "asDrawHelper" $ errorWrongScreenType "draw function" -- PARTIAL:
asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name
asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =

124
hledger-ui/Hledger/UI/BalancesheetScreen.hs
View File

@ -18,8 +18,6 @@ import Brick.Widgets.List
import Brick.Widgets.Edit
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.List hiding (reverse)
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Calendar (Day)
import qualified Data.Vector as V
@ -27,8 +25,6 @@ import Data.Vector ((!?))
import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft, BScrollDown, BScrollUp))
import Lens.Micro.Platform
import System.Console.ANSI
import System.FilePath (takeFileName)
import Text.DocLayout (realLength)
import Hledger
import Hledger.Cli hiding (mode, progname, prognameandversion)
@ -39,126 +35,16 @@ import Hledger.UI.UIUtils
import Hledger.UI.UIScreens
import Hledger.UI.Editor
import Hledger.UI.ErrorScreen (uiReloadJournal, uiCheckBalanceAssertions, uiReloadJournalIfChanged)
import Hledger.UI.AccountsScreen (asDrawHelper)
import Hledger.UI.RegisterScreen (rsCenterSelection)
bsDraw :: UIState -> [Widget Name]
bsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
,ajournal=j
,aScreen=BS sst
,aMode=mode
} = dlogUiTrace "bsDraw 1" $
case mode of
Help -> [helpDialog copts, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent]
bsDraw ui = dlogUiTrace "bsDraw" $ asDrawHelper ui ropts' scrname showbalchgkey
where
maincontent = Widget Greedy Greedy $ do
c <- getContext
let
availwidth =
-- ltrace "availwidth" $
c^.availWidthL
- 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
displayitems = sst ^. assList . listElementsL
acctwidths = V.map (\AccountsScreenItem{..} -> asItemIndentLevel + realLength asItemDisplayAccountName) displayitems
balwidths = V.map (maybe 0 (wbWidth . showMixedAmountB oneLine) . asItemMixedAmount) displayitems
preferredacctwidth = V.maximum acctwidths
totalacctwidthseen = V.sum acctwidths
preferredbalwidth = V.maximum balwidths
totalbalwidthseen = V.sum balwidths
totalwidthseen = totalacctwidthseen + totalbalwidthseen
shortfall = preferredacctwidth + preferredbalwidth + 2 - availwidth
acctwidthproportion = fromIntegral totalacctwidthseen / fromIntegral totalwidthseen
adjustedacctwidth = min preferredacctwidth . max 15 . round $ acctwidthproportion * fromIntegral (availwidth - 2) -- leave 2 whitespace for padding
adjustedbalwidth = availwidth - 2 - adjustedacctwidth
-- XXX how to minimise the balance column's jumping around as you change the depth limit ?
colwidths | shortfall <= 0 = (preferredacctwidth, preferredbalwidth)
| otherwise = (adjustedacctwidth, adjustedbalwidth)
render $ defaultLayout toplabel bottomlabel $ renderList (bsDrawItem colwidths) True (sst ^. assList)
where
ropts = (_rsReportOpts rspec){balanceaccum_=Historical}
ishistorical = balanceaccum_ ropts == Historical
toplabel =
withAttr (attrName "border" <> attrName "filename") files
<+> toggles
<+> str (" balance sheet")
<+> borderPeriodStr (if ishistorical then "at end of" else "in") (period_ ropts)
<+> borderQueryStr (T.unpack . T.unwords . map textQuoteIfNeeded $ querystring_ ropts)
<+> borderDepthStr mdepth
<+> str (" ("++curidx++"/"++totidx++")")
<+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts
then withAttr (attrName "border" <> attrName "query") (str " ignoring balance assertions")
else str "")
where
files = case journalFilePaths j of
[] -> str ""
f:_ -> str $ takeFileName f
-- [f,_:[]] -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str " (& 1 included file)"
-- f:fs -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str (" (& " ++ show (length fs) ++ " included files)")
toggles = withAttr (attrName "border" <> attrName "query") $ str $ unwords $ concat [
[""]
,if empty_ ropts then [] else ["nonzero"]
,uiShowStatus copts $ statuses_ ropts
,if real_ ropts then ["real"] else []
]
mdepth = depth_ ropts
curidx = case sst ^. assList . listSelectedL of
Nothing -> "-"
Just i -> show (i + 1)
totidx = show $ V.length nonblanks
where
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ sst ^. assList . listElementsL
bottomlabel = case mode of
Minibuffer label ed -> minibuffer label ed
_ -> quickhelp
where
quickhelp = borderKeysStr' [
("?", str "help")
-- ,("RIGHT", str "register")
,("t", renderToggle (tree_ ropts) "list" "tree")
-- ,("t", str "tree")
-- ,("l", str "list")
,("-+", str "depth")
,("", renderToggle (not ishistorical) "end-bals" "changes")
,("F", renderToggle1 (isJust . forecast_ $ inputopts_ copts) "forecast")
--,("/", "filter")
--,("DEL", "unfilter")
--,("ESC", "cancel/top")
,("a", str "add")
-- ,("g", "reload")
,("q", str "quit")
]
bsDraw _ = dlogUiTrace "bsDraw 2" $ errorWrongScreenType "draw function" -- PARTIAL:
bsDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name
bsDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
Widget Greedy Fixed $ do
-- c <- getContext
-- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt
render $
txt (fitText (Just acctwidth) (Just acctwidth) True True $ T.replicate (asItemIndentLevel) " " <> asItemDisplayAccountName) <+>
txt balspace <+>
splitAmounts balBuilder
where
balBuilder = maybe mempty showamt asItemMixedAmount
showamt = showMixedAmountB oneLine{displayMinWidth=Just balwidth, displayMaxWidth=Just balwidth}
balspace = T.replicate (2 + balwidth - wbWidth balBuilder) " "
splitAmounts = foldr1 (<+>) . intersperse (str ", ") . map renderamt . T.splitOn ", " . wbToText
renderamt :: T.Text -> Widget Name
renderamt a | T.any (=='-') a = withAttr (sel $ attrName "list" <> attrName "balance" <> attrName "negative") $ txt a
| otherwise = withAttr (sel $ attrName "list" <> attrName "balance" <> attrName "positive") $ txt a
sel | selected = (<> attrName "selected")
| otherwise = id
scrname = "balance sheet"
ropts' = (_rsReportOpts $ reportspec_ $ uoCliOpts $ aopts ui){balanceaccum_=Historical}
showbalchgkey = False
bsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
bsHandle ev = do

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

@ -36,12 +36,11 @@ import Hledger.UI.UIScreens
import Hledger.UI.Editor
esDraw :: UIState -> [Widget Name]
esDraw UIState{aopts=UIOpts{uoCliOpts=copts}
,aScreen=ES ESS{..}
esDraw UIState{aScreen=ES ESS{..}
,aMode=mode
} =
case mode of
Help -> [helpDialog copts, maincontent]
Help -> [helpDialog, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent]
where

2
hledger-ui/Hledger/UI/MenuScreen.hs
View File

@ -44,7 +44,7 @@ msDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=_rspec}}
,aMode=mode
} = dlogUiTrace "msDraw 1" $
case mode of
Help -> [helpDialog copts, maincontent]
Help -> [helpDialog, maincontent]
Minibuffer lbl ed -> [minibuffer lbl ed, maincontent]
_ -> [maincontent]
where

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

@ -47,7 +47,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
,aMode=mode
} = dlogUiTrace "rsDraw 1" $
case mode of
Help -> [helpDialog copts, maincontent]
Help -> [helpDialog, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent]
where

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

@ -42,7 +42,7 @@ tsDraw UIState{aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec
,aMode=mode
} =
case mode of
Help -> [helpDialog copts, maincontent]
Help -> [helpDialog, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent]
where

107
hledger-ui/Hledger/UI/UIScreens.hs
View File

@ -88,24 +88,35 @@ msNew =
msUpdate :: MenuScreenState -> MenuScreenState
msUpdate = dlogUiTrace "msUpdate`"
nullass macct = ASS {
_assSelectedAccount = fromMaybe "" macct
,_assList = list AccountsList (V.fromList []) 1
}
-- | Construct an accounts screen listing the appropriate set of accounts,
-- with the appropriate one selected.
-- Screen-specific arguments: the account to select if any.
asNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
asNew uopts d j macct =
dlogUiTrace "asNew" $
AS $
asUpdate uopts d j $
ASS {
_assSelectedAccount = fromMaybe "" macct
,_assList = list AccountsList (V.fromList []) 1
}
asNew uopts d j macct = dlogUiTrace "asNew" $ AS $ asUpdate uopts d j $ nullass macct
-- | Update an accounts screen from these options, reporting date, and journal.
asUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState
asUpdate uopts d j ass = dlogUiTrace "asUpdate" ass{_assList=l}
asUpdate uopts d = dlogUiTrace "asUpdate" . asUpdateHelper rspec'
where
UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts
rspec' =
updateReportSpec
ropts{declared_=True} -- always show declared accounts even if unused
rspec{_rsDay=d} -- update to the given day, might have changed since program start
& either (error "asUpdate: adjusting the query, should not have failed") id -- PARTIAL:
& reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions
-- | Update an accounts-screen-like screen from this report spec and journal.
asUpdateHelper :: ReportSpec -> Journal -> AccountsScreenState -> AccountsScreenState
asUpdateHelper rspec j ass = dlogUiTrace "asUpdate" ass{_assList=l}
where
ropts = _rsReportOpts rspec
-- decide which account is selected:
-- if selectfirst is true, the first account;
-- otherwise, the previously selected account if possible;
@ -127,14 +138,7 @@ asUpdate uopts d j ass = dlogUiTrace "asUpdate" ass{_assList=l}
displayitems = map displayitem items
where
-- run the report
(items, _) = balanceReport rspec' j
where
rspec' =
updateReportSpec
ropts{declared_=True} -- always show declared accounts even if unused
rspec{_rsDay=d} -- update to the given day, might have changed since program start
& either (error "asUpdate: adjusting the query, should not have failed") id -- PARTIAL:
& reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions
(items, _) = balanceReport rspec j
-- pre-render a list item
displayitem (fullacct, shortacct, indent, bal) =
@ -157,69 +161,22 @@ asUpdate uopts d j ass = dlogUiTrace "asUpdate" ass{_assList=l}
-- with the appropriate one selected.
-- Screen-specific arguments: the account to select if any.
bsNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
bsNew uopts d j macct =
dlogUiTrace "bsNew" $
BS $
bsUpdate uopts d j $
ASS {
_assSelectedAccount = fromMaybe "" macct
,_assList = list AccountsList (V.fromList []) 1
}
bsNew uopts d j macct = dlogUiTrace "bsNew" $ BS $ bsUpdate uopts d j $ nullass macct
-- | Update a balance sheet screen from these options, reporting date, and journal.
bsUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState
bsUpdate uopts d j ass = dlogUiTrace "bsUpdate" ass{_assList=l}
bsUpdate uopts d = dlogUiTrace "bsUpdate" . asUpdateHelper rspec'
where
UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts
-- decide which account is selected:
-- if selectfirst is true, the first account;
-- otherwise, the previously selected account if possible;
-- otherwise, the first account with the same prefix (eg first leaf account when entering flat mode);
-- otherwise, the alphabetically preceding account.
l =
listMoveTo selidx $
list AccountsList (V.fromList $ displayitems ++ blankitems) 1
where
selidx = headDef 0 $ catMaybes [
elemIndex a as
,findIndex (a `isAccountNamePrefixOf`) as
,Just $ max 0 (length (filter (< a) as) - 1)
]
where
a = _assSelectedAccount ass
as = map asItemAccountName displayitems
displayitems = map displayitem items
where
-- run the report
(items, _) = balanceReport rspec' j
where
rspec' =
updateReportSpec
ropts{declared_=True -- always show declared accounts even if unused
,balanceaccum_=Historical -- always show historical end balances
}
rspec{_rsDay=d} -- update to the given day, might have changed since program start
& either (error "bsUpdate: adjusting the query, should not have failed") id -- PARTIAL:
& reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions
& reportSpecAddQuery (Type [Asset,Liability,Equity]) -- restrict to balance sheet accounts
-- pre-render a list item
displayitem (fullacct, shortacct, indent, bal) =
AccountsScreenItem{asItemIndentLevel = indent
,asItemAccountName = fullacct
,asItemDisplayAccountName = replaceHiddenAccountsNameWith "All" $ if tree_ ropts then shortacct else fullacct
,asItemMixedAmount = Just bal
}
-- blanks added for scrolling control, cf RegisterScreen.
-- XXX Ugly. Changing to 0 helps when debugging.
blankitems = replicate uiNumBlankItems
AccountsScreenItem{asItemIndentLevel = 0
,asItemAccountName = ""
,asItemDisplayAccountName = ""
,asItemMixedAmount = Nothing
}
rspec' =
updateReportSpec
ropts{declared_=True -- always show declared accounts even if unused
,balanceaccum_=Historical -- always show historical end balances
}
rspec{_rsDay=d} -- update to the given day, might have changed since program start
& either (error "bsUpdate: adjusting the query, should not have failed") id -- PARTIAL:
& reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions
& reportSpecAddQuery (Type [Asset,Liability,Equity]) -- restrict to balance sheet accounts
-- | Construct a register screen listing the appropriate set of transactions,
-- with the appropriate one selected.

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

@ -56,7 +56,6 @@ import Graphics.Vty
import Lens.Micro.Platform
import Hledger
import Hledger.Cli (CliOpts)
import Hledger.Cli.DocFiles
import Hledger.UI.UITypes
@ -111,8 +110,8 @@ defaultLayout toplabel bottomlabel =
-- "the layout adjusts... if you use the core combinators"
-- | Draw the help dialog, called when help mode is active.
helpDialog :: CliOpts -> Widget Name
helpDialog _copts =
helpDialog :: Widget Name
helpDialog =
Widget Fixed Fixed $ do
c <- getContext
render $