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

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -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}}
+asDraw ui = dlogUiTrace "asDraw 1" $ asDrawHelper ui ropts' scrname showbalchgkey
-              ,ajournal=j
-              ,aScreen=AS sst
-              ,aMode=mode
-              } = dlogUiTrace "asDraw 1" $
-    case mode of
-      Help       -> [helpDialog copts, maincontent]
-      -- Minibuffer e -> [minibuffer e, maincontent]
-      _          -> [maincontent]
   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")
               ]
-
+asDrawHelper _ _ _ _ = dlogUiTrace "asDrawHelper" $ errorWrongScreenType "draw function"  -- PARTIAL:
-asDraw _ =  dlogUiTrace "asDraw 2" $ errorWrongScreenType "draw function"  -- PARTIAL:
 
 asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name
 asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =

hledger-ui/Hledger/UI/BalancesheetScreen.hs

@@ -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}}
+bsDraw ui = dlogUiTrace "bsDraw" $ asDrawHelper ui ropts' scrname showbalchgkey
-              ,ajournal=j
-              ,aScreen=BS sst
-              ,aMode=mode
-              } = dlogUiTrace "bsDraw 1" $
-    case mode of
-      Help       -> [helpDialog copts, maincontent]
-      -- Minibuffer e -> [minibuffer e, maincontent]
-      _          -> [maincontent]
   where
-    maincontent = Widget Greedy Greedy $ do
+    scrname = "balance sheet"
-      c <- getContext
+    ropts' = (_rsReportOpts $ reportspec_ $ uoCliOpts $ aopts ui){balanceaccum_=Historical}
-      let
+    showbalchgkey = False
-        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
 
 bsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
 bsHandle ev = do

hledger-ui/Hledger/UI/ErrorScreen.hs

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

hledger-ui/Hledger/UI/MenuScreen.hs

@@ -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

hledger-ui/Hledger/UI/RegisterScreen.hs

@@ -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

hledger-ui/Hledger/UI/TransactionScreen.hs

@@ -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

hledger-ui/Hledger/UI/UIScreens.hs

@@ -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 =
+asNew uopts d j macct = dlogUiTrace "asNew" $ AS $ asUpdate uopts d j $ nullass macct
-  dlogUiTrace "asNew" $
-  AS $
-  asUpdate uopts d j $
-  ASS {
-     _assSelectedAccount = fromMaybe "" macct
-    ,_assList            = list AccountsList (V.fromList []) 1
-    }
 
 -- | 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
+            (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
 
             -- 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 =
+bsNew uopts d j macct = dlogUiTrace "bsNew" $ BS $ bsUpdate uopts d j $ nullass macct
-  dlogUiTrace "bsNew" $
-  BS $
-  bsUpdate uopts d j $
-  ASS {
-     _assSelectedAccount = fromMaybe "" macct
-    ,_assList            = list AccountsList (V.fromList []) 1
-    }
 
 -- | 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:
+    rspec' =
-    -- if selectfirst is true, the first account;
+      updateReportSpec
-    -- otherwise, the previously selected account if possible;
+        ropts{declared_=True            -- always show declared accounts even if unused
-    -- otherwise, the first account with the same prefix (eg first leaf account when entering flat mode);
+              ,balanceaccum_=Historical  -- always show historical end balances
-    -- otherwise, the alphabetically preceding account.
+              }
-    l =
+        rspec{_rsDay=d}                 -- update to the given day, might have changed since program start
-      listMoveTo selidx $
+      & either (error "bsUpdate: adjusting the query, should not have failed") id -- PARTIAL:
-      list AccountsList (V.fromList $ displayitems ++ blankitems) 1
+      & reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts)  -- include/exclude future & forecast transactions
-      where
+      & reportSpecAddQuery (Type [Asset,Liability,Equity])  -- restrict to balance sheet accounts
-        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
-                            }
 
 -- | Construct a register screen listing the appropriate set of transactions,
 -- with the appropriate one selected.

hledger-ui/Hledger/UI/UIUtils.hs

@@ -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 :: Widget Name
-helpDialog _copts =
+helpDialog =
   Widget Fixed Fixed $ do
     c <- getContext
     render $