ui: solidified register screen, added themes

- register screen:
  - smarter width-sensitive layout, with multi-commodity amounts on one line
  - items are sorted in date order
  - jumps to the latest item by default, with consistent scroll position
  - more prerendering, might speed up movement/paging slightly

- themes! --theme to select, --help to list (current themes: default, terminal, greenterm)

- border tweaks - dropped side borders, added side padding

hledger-ui/Hledger/UI.hs

@@ -5,6 +5,7 @@ Re-export the modules of the hledger-ui program.
 module Hledger.UI (
                      module Hledger.UI.Main,
                      module Hledger.UI.Options,
+                     module Hledger.UI.Theme,
                      tests_Hledger_UI
               )
 where
@@ -12,6 +13,7 @@ import Test.HUnit
 
 import Hledger.UI.Main
 import Hledger.UI.Options
+import Hledger.UI.Theme
 
 tests_Hledger_UI :: Test
 tests_Hledger_UI = TestList

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -14,16 +14,17 @@ import Data.List
 -- import Data.Monoid              -- 
 import Data.Time.Calendar (Day)
 import qualified Data.Vector as V
-import qualified Graphics.Vty as Vty
+import Graphics.Vty as Vty
 import Brick
 import Brick.Widgets.List
-import Brick.Widgets.Border
-import Brick.Widgets.Center
+-- import Brick.Widgets.Border
+-- import Brick.Widgets.Center
 
 import Hledger
 import Hledger.Cli hiding (progname,prognameandversion,green)
 -- import Hledger.Cli.Options (defaultBalanceLineFormat)
 import Hledger.UI.Options
+-- import Hledger.UI.Theme
 import Hledger.UI.UITypes
 import Hledger.UI.UIUtils
 import qualified Hledger.UI.RegisterScreen2 as RS2 (screen)
@@ -47,7 +48,10 @@ initAccountsScreen d args st@AppState{aopts=opts, ajournal=j, aScreen=s@Accounts
              --{query_=unwords' $ locArgs l}
         ropts = (reportopts_ cliopts)
                 {no_elide_=True}
-                {query_=unwords' args}
+                {
+                  query_=unwords' args,
+                  balancetype_=HistoricalBalance -- XXX balanceReport doesn't respect this yet
+                }
         cliopts = cliopts_ opts
 initAccountsScreen _ _ _ = error "init function called with wrong screen type, should not happen"
 
@@ -59,15 +63,7 @@ drawAccountsScreen st@AppState{aScreen=AccountsScreen{asState=is}} = [ui]
                   Nothing -> "-"
                   Just i -> show (i + 1))
       total = str $ show $ length $ is^.listElementsL
-      box = borderWithLabel label $
-            -- hLimit 25 $
-            -- vLimit 15 $
-            renderList is (drawAccountsItem fmt)
-      ui = box
-      _ui = vCenter $ vBox [ hCenter box
-                            , str " "
-                            , hCenter $ str "Press Esc to exit."
-                            ]
+
       items = listElements is
       flat = flat_ $ reportopts_ $ cliopts_ $ aopts st
       acctcolwidth = maximum $
@@ -82,16 +78,17 @@ drawAccountsScreen st@AppState{aScreen=AccountsScreen{asState=is}} = [ui]
              , FormatField False (Just 40) Nothing TotalField
              ]
 
+      ui = defaultLayout label $ renderList is (drawAccountsItem fmt)
+
 drawAccountsScreen _ = error "draw function called with wrong screen type, should not happen"
 
 drawAccountsItem :: StringFormat -> Bool -> BalanceReportItem -> Widget
-drawAccountsItem fmt sel item =
-    let selStr i = if sel
-                   then withAttr customAttr (str $ showitem i)
-                   else str $ showitem i
-        showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt
-    in
-     selStr item
+drawAccountsItem fmt _sel item =
+  Widget Greedy Fixed $ do
+    -- c <- getContext
+    let
+      showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt
+    render $ str $ showitem item
 
 handleAccountsScreen :: AppState -> Vty.Event -> EventM (Next AppState)
 handleAccountsScreen st@AppState{aScreen=scr@AccountsScreen{asState=is}} e = do
@@ -104,8 +101,9 @@ handleAccountsScreen st@AppState{aScreen=scr@AccountsScreen{asState=is}} e = do
         Vty.EvKey (Vty.KChar 'q') [] -> halt st
         Vty.EvKey (Vty.KLeft) []     -> continue $ popScreen st
         Vty.EvKey (Vty.KRight) []    -> do
-          (w,h) <- getViewportSize "accounts"
-          continue $ screenEnter d args RS2.screen{rs2Size=(w,h)} st
+          let st' = screenEnter d args RS2.screen st
+          vScrollToBeginning $ viewportScroll "register"
+          continue st'
           where
             args = case listSelectedElement is of
                     Just (_, ((acct, _, _), _)) -> ["acct:"++accountNameToAccountRegex acct]

hledger-ui/Hledger/UI/Main.hs

@@ -12,10 +12,11 @@ module Hledger.UI.Main where
 -- import Control.Applicative
 -- import Control.Lens ((^.))
 import Control.Monad
+-- import Control.Monad.IO.Class (liftIO)
 -- import Data.Default
 -- import Data.Monoid              -- 
 -- import Data.List
--- import Data.Maybe
+import Data.Maybe
 -- import Data.Time.Calendar
 -- import Safe
 import System.Exit
@@ -27,19 +28,14 @@ import Hledger
 import Hledger.Cli hiding (progname,prognameandversion,green)
 import Hledger.UI.Options
 import Hledger.UI.UITypes
-import Hledger.UI.UIUtils
+-- import Hledger.UI.UIUtils
+import Hledger.UI.Theme
 import Hledger.UI.AccountsScreen as AS
 -- import Hledger.UI.RegisterScreen as RS
-import Hledger.UI.RegisterScreen2 as RS2
+-- import Hledger.UI.RegisterScreen2 as RS2
 
 ----------------------------------------------------------------------
 
--- | The available screens.
-appScreens = [
-   AS.screen
-  ,RS2.screen
-  ]
-
 main :: IO ()
 main = do
   opts <- getHledgerUIOpts
@@ -65,8 +61,10 @@ runBrickUi opts j = do
   d <- getCurrentDay
 
   let
+    theme = maybe defaultTheme (fromMaybe defaultTheme . getTheme) $
+            maybestringopt "theme" $ rawopts_ $ cliopts_ opts
     args = words' $ query_ $ reportopts_ $ cliopts_ opts
-    scr = head appScreens
+    scr = AS.screen
     st = (sInitFn scr) d args
          AppState{
             aopts=opts
@@ -80,10 +78,11 @@ runBrickUi opts j = do
     app = App {
         appLiftVtyEvent = id
       , appStartEvent   = return
-      , appAttrMap      = const customAttrMap
+      , appAttrMap      = const theme
       , appChooseCursor = showFirstCursor
       , appHandleEvent  = \st ev -> (sHandleFn $ aScreen st) st ev
       , appDraw         = \st -> (sDrawFn $ aScreen st) st
       }
 
   void $ defaultMain app st
+

hledger-ui/Hledger/UI/Options.hs

@@ -5,10 +5,12 @@
 
 module Hledger.UI.Options
 where
+import Data.List (intercalate)
 import System.Console.CmdArgs
 import System.Console.CmdArgs.Explicit
 
 import Hledger.Cli hiding (progname,version,prognameandversion)
+import Hledger.UI.Theme (themeNames)
 
 progname, version :: String
 progname = "hledger-ui"
@@ -25,6 +27,7 @@ uiflags = [
   ,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented"
   ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"
   ,flagReq  ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format"
+  ,flagReq  ["theme"] (\s opts -> Right $ setopt "theme" s opts) "THEME" ("use this custom display theme ("++intercalate ", " themeNames++")")
   ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "no eliding at all, stronger than --empty"
   -- ,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total"
  ]
@@ -66,6 +69,10 @@ toUIOpts rawopts = do
 checkUIOpts :: UIOpts -> IO UIOpts
 checkUIOpts opts = do
   checkCliOpts $ cliopts_ opts
+  case maybestringopt "theme" $ rawopts_ $ cliopts_ opts of
+    Just t | not $ elem t themeNames ->
+      optserror $ "invalid theme name: "++t
+    _ -> return ()
   return opts
 
 getHledgerUIOpts :: IO UIOpts

hledger-ui/Hledger/UI/RegisterScreen.hs

@@ -7,6 +7,7 @@ module Hledger.UI.RegisterScreen
 where
 
 import Control.Lens ((^.))
+-- import Control.Monad.IO.Class (liftIO)
 import Data.List
 import Data.Time.Calendar (Day)
 import qualified Data.Vector as V
@@ -42,7 +43,7 @@ initRegisterScreen d args st@AppState{aopts=opts, ajournal=j, aScreen=s@Register
              -- query_="cur:\\$"} -- XXX limit to one commodity to ensure one-line items
              --{query_=unwords' $ locArgs l}
         ropts = (reportopts_ cliopts)
-                {query_=unwords' args}
+                { query_=unwords' args }
         cliopts = cliopts_ opts
 initRegisterScreen _ _ _ = error "init function called with wrong screen type, should not happen"
 
@@ -72,12 +73,17 @@ drawRegisterScreen _ = error "draw function called with wrong screen type, shoul
 
 drawRegisterItem :: Bool -> PostingsReportItem -> Widget
 drawRegisterItem sel item =
+
+  -- (w,_) <- getViewportSize "register" -- getCurrentViewportSize
+  -- st@AppState{aopts=opts} <- getAppState
+  -- let opts' = opts{width_=Just $ show w}
+
   let selStr i = if sel
-                 then withAttr customAttr (str $ showitem i)
+                 then {- withAttr selectedAttr -} str $ showitem i
                  else str $ showitem i
       showitem (_,_,_,p,b) =
         intercalate ", " $ map strip $ lines $ 
-        postingsReportItemAsText defcliopts $
+        postingsReportItemAsText defcliopts{width_=Just "160"} $ -- XXX
         mkpostingsReportItem True True PrimaryDate Nothing p b
       -- fmt = BottomAligned [
       --     FormatField False (Just 20) Nothing TotalField
@@ -89,7 +95,7 @@ drawRegisterItem sel item =
    selStr item
 
 handleRegisterScreen :: AppState -> Vty.Event -> EventM (Next AppState)
-handleRegisterScreen st@AppState{aScreen=s@RegisterScreen{rsState=is}} e =
+handleRegisterScreen st@AppState{aopts=_opts,aScreen=s@RegisterScreen{rsState=is}} e = do
   case e of
     Vty.EvKey Vty.KEsc []        -> halt st
     Vty.EvKey (Vty.KChar 'q') [] -> halt st

hledger-ui/Hledger/UI/RegisterScreen2.hs

@@ -1,6 +1,6 @@
 -- The register screen, showing account postings, like the CLI register command.
 
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
 
 module Hledger.UI.RegisterScreen2
  (screen)
@@ -8,111 +8,147 @@ where
 
 import Control.Lens ((^.))
 -- import Control.Monad.IO.Class (liftIO)
-import Data.List
+-- import Data.List
 import Data.List.Split (splitOn)
+-- import Data.Maybe
 import Data.Time.Calendar (Day)
 import qualified Data.Vector as V
-import qualified Graphics.Vty as Vty
+import Graphics.Vty as Vty
 import Brick
 import Brick.Widgets.List
-import Brick.Widgets.Border
-import Brick.Widgets.Center
+-- import Brick.Widgets.Border
+-- import Brick.Widgets.Border.Style
+-- import Brick.Widgets.Center
+-- import Text.Printf
 
 import Hledger
 import Hledger.Cli hiding (progname,prognameandversion,green)
 import Hledger.UI.Options
+-- import Hledger.UI.Theme
 import Hledger.UI.UITypes
 import Hledger.UI.UIUtils
 
 screen = RegisterScreen2{
    rs2State  = list "register" V.empty 1
-  ,rs2Size   = (0,0)
   ,sInitFn    = initRegisterScreen2
   ,sDrawFn    = drawRegisterScreen2
   ,sHandleFn = handleRegisterScreen2
   }
 
 initRegisterScreen2 :: Day -> [String] -> AppState -> AppState
-initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen2{rs2Size=size}} =
-  st{aScreen=s{rs2State=is'}}
+initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen2{}} =
+  st{aScreen=s{rs2State=l}}
   where
-    is' =
-      -- listMoveTo (length items) $
-      list (Name "register") (V.fromList items') 1
+    -- gather arguments and queries
+    ropts = (reportopts_ $ cliopts_ opts)
+            {
+              query_=unwords' args,
+              balancetype_=HistoricalBalance
+            }
+    -- XXX temp
+    curacct = drop 5 $ head args -- should be "acct:..." 
+    thisacctq = Acct $ curacct -- XXX why is this excluding subs: accountNameToAccountRegex curacct
+    q = queryFromOpts d ropts
+         -- query_="cur:\\$"} -- XXX limit to one commodity to ensure one-line items
+         --{query_=unwords' $ locArgs l}
 
-    -- XXX temporary hack: include saved viewport size in list elements
-    -- for element draw function
-    items' = zip (repeat size) items
-    (_label,items) = accountTransactionsReport ropts j thisacctq q
-      where
-        -- XXX temp
-        curacct = drop 5 $ head args -- should be "acct:..." 
-        thisacctq = Acct $ curacct -- XXX why is this excluding subs: accountNameToAccountRegex curacct
+    -- run a transactions report, most recent last
+    (_label,items') = accountTransactionsReport ropts j thisacctq q
+    items = reverse items'
+
+    -- pre-render all items; these will be the List elements. This helps calculate column widths.
+    displayitem (_, t, _issplit, otheracctsstr, change, bal) =
+      (showDate $ tdate t
+      ,tdescription t
+      ,case splitOn ", " otheracctsstr of
+        [s] -> s
+        _   -> "<split>"
+      ,showMixedAmountOneLineWithoutPrice change
+      ,showMixedAmountOneLineWithoutPrice bal
+      )
+    displayitems = map displayitem items
+
+    -- build the List, moving the selection to the end
+    l = listMoveTo (length items) $
+        list (Name "register") (V.fromList displayitems) 1
+
+        -- (listName someList)
 
-        q = queryFromOpts d ropts
-             -- query_="cur:\\$"} -- XXX limit to one commodity to ensure one-line items
-             --{query_=unwords' $ locArgs l}
-        ropts = (reportopts_ cliopts)
-                {query_=unwords' args}
-        cliopts = cliopts_ opts
 initRegisterScreen2 _ _ _ = error "init function called with wrong screen type, should not happen"
 
 drawRegisterScreen2 :: AppState -> [Widget]
-drawRegisterScreen2 AppState{aopts=_opts, aScreen=RegisterScreen2{rs2State=is}} = [ui]
+drawRegisterScreen2 AppState{aopts=_opts, aScreen=RegisterScreen2{rs2State=l}} = [ui]
   where
     label = str "Transaction "
             <+> cur
             <+> str " of "
             <+> total
             <+> str " to/from this account" -- " <+> str query <+> "and subaccounts"
-    cur = str $ case is^.(listSelectedL) of
+    cur = str $ case l^.listSelectedL of
                  Nothing -> "-"
                  Just i -> show (i + 1)
-    total = str $ show $ length $ is^.(listElementsL)
+    total = str $ show $ length displayitems
+    displayitems = V.toList $ l^.listElementsL
+
     -- query = query_ $ reportopts_ $ cliopts_ opts
-    box = borderWithLabel label $
-          -- hLimit 25 $
-          -- vLimit 15 $
-          renderList is drawRegisterItem
-    ui = box
-    _ui = vCenter $ vBox [ hCenter box
-                          , str " "
-                          , hCenter $ str "Press Esc to exit."
-                          ]
+
+    ui = Widget Greedy Greedy $ do
+
+      -- calculate column widths, based on current available width
+      c <- getContext
+      let
+        totalwidth = c^.availWidthL - 2 -- XXX trimmed.. for the margin ?
+
+        -- the date column is fixed width
+        datewidth = 10
+
+        -- multi-commodity amounts rendered on one line can be
+        -- arbitrarily wide.  Give the two amounts as much space as
+        -- they need, while reserving a minimum of space for other
+        -- columns and whitespace.  If they don't get all they need,
+        -- allocate it to them proportionally to their maximum widths.
+        maxamtswidth = max 0 (totalwidth - 21)
+        changewidth' = maximum' $ map (length . fourth5) displayitems
+        balwidth' = maximum' $ map (length . fifth5) displayitems
+        changewidthproportion = (changewidth' + balwidth') `div` changewidth'
+        maxchangewidth = maxamtswidth `div` changewidthproportion
+        maxbalwidth = maxamtswidth - maxchangewidth
+        changewidth = min maxchangewidth changewidth' 
+        balwidth = min maxbalwidth balwidth'
+
+        -- assign the remaining space to the description and accounts columns
+        maxdescacctswidth = totalwidth - 17 - changewidth - balwidth
+        -- allocating proportionally.
+        -- descwidth' = maximum' $ map (length . second5) displayitems
+        -- acctswidth' = maximum' $ map (length . third5) displayitems
+        -- descwidthproportion = (descwidth' + acctswidth') `div` descwidth'
+        -- maxdescwidth = min (maxdescacctswidth - 7) (maxdescacctswidth `div` descwidthproportion)
+        -- maxacctswidth = maxdescacctswidth - maxdescwidth
+        -- descwidth = min maxdescwidth descwidth' 
+        -- acctswidth = min maxacctswidth acctswidth'
+        -- allocating equally.
+        descwidth = maxdescacctswidth `div` 2
+        acctswidth = maxdescacctswidth - descwidth
+
+        colwidths = (datewidth,descwidth,acctswidth,changewidth,balwidth)
+
+      render $ defaultLayout label $ renderList l (drawRegisterItem colwidths)
+
 drawRegisterScreen2 _ = error "draw function called with wrong screen type, should not happen"
 
-drawRegisterItem :: Bool -> ((Int,Int), AccountTransactionsReportItem) -> Widget
-drawRegisterItem sel ((w,_h),item) =
-
-  -- (w,_) <- getViewportSize "register" -- getCurrentViewportSize
-  -- st@AppState{aopts=opts} <- getAppState
-  -- let opts' = opts{width_=Just $ show w}
-
-  let selStr i = if sel
-                 then withAttr customAttr (str $ showitem i)
-                 else str $ showitem i
-      showitem (_origt,t,split,acctsstr,postedamt,totalamt) =
-        -- make a fake posting to render
-        let p = nullposting{
-                  pdate=Just $ tdate t
-                 ,paccount=if split then intercalate ", " acctnames ++" (split)" else acctsstr
-                    -- XXX elideAccountName doesn't elide combined split names well
-                 ,pamount=postedamt
-                 ,ptransaction=Just t
-                 }
-            acctnames = nub $ sort $ splitOn ", " acctsstr -- XXX
-        in
-         intercalate ", " $ map strip $ lines $ 
-         postingsReportItemAsText defcliopts{width_=Just (show w)} $
-         mkpostingsReportItem True True PrimaryDate Nothing p totalamt
-      -- fmt = BottomAligned [
-      --     FormatField False (Just 20) Nothing TotalField
-      --   , FormatLiteral "  "
-      --   , FormatField True (Just 2) Nothing DepthSpacerField
-      --   , FormatField True Nothing Nothing AccountField
-      --   ]
-  in
-   selStr item
+drawRegisterItem :: (Int,Int,Int,Int,Int) -> Bool -> (String,String,String,String,String) -> Widget
+drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) _sel (date,desc,accts,change,bal) =
+  Widget Greedy Fixed $ do
+    render $
+      str (padright datewidth $ elideRight datewidth date) <+>
+      str " " <+>
+      str (padright descwidth $ elideRight descwidth desc) <+>
+      str "  " <+>
+      str (padright acctswidth $ elideLeft acctswidth $ accts) <+>
+      str "  " <+>
+      str (padleft changewidth $ elideLeft changewidth change) <+>
+      str "  " <+>
+      str (padleft balwidth $ elideLeft balwidth bal)
 
 handleRegisterScreen2 :: AppState -> Vty.Event -> EventM (Next AppState)
 handleRegisterScreen2 st@AppState{aopts=_opts,aScreen=s@RegisterScreen2{rs2State=is}} e = do

hledger-ui/Hledger/UI/Theme.hs

@@ -1,34 +1,99 @@
-----------------------------------------------------------------------
--- Theme       
--- the all-important theming engine!
+-- | The all-important theming engine!
+--
+-- Cf
+-- https://hackage.haskell.org/package/vty/docs/Graphics-Vty-Attributes.html
+-- http://hackage.haskell.org/package/brick/docs/Brick-AttrMap.html
+-- http://hackage.haskell.org/package/brick-0.1/docs/Brick-Util.html
+-- http://hackage.haskell.org/package/brick-0.1/docs/Brick-Widgets-Core.html#g:5
+-- http://hackage.haskell.org/package/brick-0.1/docs/Brick-Widgets-Border.html
 
--- theme = Restrained
--- -- theme = Colorful
--- -- theme = Blood
 
--- data UITheme = Restrained | Colorful | Blood
+{-# LANGUAGE OverloadedStrings #-}
 
--- (defaultattr,
---  currentlineattr,
---  statusattr
---  ) = case theme of
---        Restrained -> (defAttr
---                     ,defAttr `withStyle` bold
---                     ,defAttr `withStyle` reverseVideo
---                     )
---        Colorful   -> (defAttr `withStyle` reverseVideo
---                     ,defAttr `withForeColor` white `withBackColor` red
---                     ,defAttr `withForeColor` black `withBackColor` green
---                     )
---        Blood      -> (defAttr `withStyle` reverseVideo
---                     ,defAttr `withForeColor` white `withBackColor` red
---                     ,defAttr `withStyle` reverseVideo
---                     )
+module Hledger.UI.Theme (
+   defaultTheme
+  ,getTheme
+  ,themes
+  ,themeNames
+ ) where
 
--- -- halfbrightattr = defAttr `withStyle` dim
--- -- reverseattr = defAttr `withStyle` reverseVideo
--- -- redattr = defAttr `withForeColor` red
--- -- greenattr = defAttr `withForeColor` green
--- -- reverseredattr = defAttr `withStyle` reverseVideo `withForeColor` red
--- -- reversegreenattr= defAttr `withStyle` reverseVideo `withForeColor` green
+import qualified Data.Map as M
+import Data.Maybe
+import Data.Monoid
+import Graphics.Vty
+import Brick
+import Brick.Widgets.Border
+import Brick.Widgets.List
+
+defaultTheme :: AttrMap
+defaultTheme = fromMaybe (snd $ head themesList) $ getTheme "white"
+  -- the theme named here should exist;
+  -- otherwise it will take the first one from the list,
+  -- which must be non-empty.
+
+-- | Look up the named theme, if it exists.
+getTheme :: String -> Maybe AttrMap
+getTheme name = M.lookup name themes
+
+-- | A selection of named themes specifying terminal colours and styles.
+-- One of these is active at a time.
+--
+-- A hledger-ui theme is a vty/brick AttrMap.  Each theme specifies a
+-- default style (Attr), plus extra styles which are applied when
+-- their (hierarchical) name matches the widget rendering context.  Eg
+-- when rendering a widget named "b" which is inside a widget named
+-- "a", the following styles will be applied if they exist: the
+-- default style, then a style named "a", and finally a style named
+-- "a" <> "b".
+--
+themes :: M.Map String AttrMap
+themes = M.fromList themesList
+
+themeNames :: [String]
+themeNames = map fst themesList
+
+(&) = withStyle
+
+themesList :: [(String, AttrMap)]
+themesList = [
+  ("default", attrMap
+            (black `on` white & bold) [ -- default style for this theme
+              (borderAttr       , white `on` black),
+              -- ("normal"                , black `on` white),
+              ("list"                  , black `on` white),      -- regular list items
+              ("list" <> "selected"    , white `on` blue & bold) -- selected list items
+              -- ("list" <> "selected"     , black `on` brightYellow),
+              -- ("list" <> "accounts"  , white `on` brightGreen),
+              -- ("list" <> "amount"       , black `on` white & bold)
+              ]),
+
+  ("terminal", attrMap
+            defAttr [  -- use the current terminal's default style
+              (borderAttr       , white `on` black),
+              -- ("normal"         , defAttr),
+              (listAttr         , defAttr),
+              (listSelectedAttr , defAttr & reverseVideo & bold)
+              -- ("status"         , defAttr & reverseVideo)
+              ]),
+
+  ("greenterm", attrMap
+            (green `on` black) [
+              -- (listAttr                  , green `on` black),
+              (listSelectedAttr          , black `on` green & bold)
+              ])
+  -- ("colorful", attrMap
+  --           defAttr [
+  --             (listAttr         , defAttr & reverseVideo),
+  --             (listSelectedAttr , defAttr `withForeColor` white `withBackColor` red)
+  --             -- ("status"         , defAttr `withForeColor` black `withBackColor` green)
+  --             ])
+
+  ]
+
+-- halfbrightattr = defAttr & dim
+-- reverseattr = defAttr & reverseVideo
+-- redattr = defAttr `withForeColor` red
+-- greenattr = defAttr `withForeColor` green
+-- reverseredattr = defAttr & reverseVideo `withForeColor` red
+-- reversegreenattr= defAttr & reverseVideo `withForeColor` green
 

hledger-ui/Hledger/UI/UITypes.hs

@@ -37,8 +37,7 @@ data Screen =
     ,sDrawFn :: AppState -> [Widget]
     }
   | RegisterScreen2 {
-     rs2Size :: (Int,Int) -- ^ XXX prev screen's viewport size on entering this screen
-    ,rs2State :: List ((Int,Int), AccountTransactionsReportItem)
+     rs2State :: List (String,String,String,String,String)
     ,sInitFn :: Day -> [String] -> AppState -> AppState
     ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
     ,sDrawFn :: AppState -> [Widget]

hledger-ui/Hledger/UI/UIUtils.hs

@@ -4,23 +4,27 @@ module Hledger.UI.UIUtils (
   pushScreen
  ,popScreen
  ,screenEnter
- ,attrMap
- ,customAttrMap
- ,customAttr
  ,getViewportSize
+ ,margin
+ ,withBorderAttr
+ ,topBottomBorderWithLabel
+ ,defaultLayout
  ) where
 
 import Control.Lens ((^.))
 -- import Control.Monad
-import Control.Monad.IO.Class
+-- import Control.Monad.IO.Class
 -- import Data.Default
-import Data.Monoid              -- 
+-- import Data.Monoid              -- 
 import Data.Time.Calendar (Day)
-import qualified Graphics.Vty as V
 import Brick
-import Brick.Widgets.List
+-- import Brick.Widgets.List
+import Brick.Widgets.Border
+import Brick.Widgets.Border.Style
+import Graphics.Vty as Vty
 
 import Hledger.UI.UITypes
+import Hledger.Utils (applyN)
 
 pushScreen :: Screen -> AppState -> AppState
 pushScreen scr st = st{aPrevScreens=(aScreen st:aPrevScreens st)
@@ -43,15 +47,6 @@ screenEnter d args scr st = (sInitFn scr) d args $
                             pushScreen scr
                             st
 
-customAttrMap :: AttrMap
-customAttrMap = attrMap V.defAttr
-    [ (listAttr,            V.white `on` V.blue)
-    , (listSelectedAttr,    V.black `on` V.white)
-    -- , (customAttr,            fg V.cyan)
-    ]
-
-customAttr :: AttrName
-
 -- | In the EventM monad, get the named current viewport's width and height,
 -- or (0,0) if the named viewport is not found.
 getViewportSize :: Name -> EventM (Int,Int)
@@ -60,6 +55,55 @@ getViewportSize name = do
   let (w,h) = case mvp of
         Just vp -> vp ^. vpSize
         Nothing -> (0,0)
+  -- liftIO $ putStrLn $ show (w,h)
   return (w,h)
 
-customAttr = listSelectedAttr <> "custom"
+defaultLayout label =
+  topBottomBorderWithLabel label .
+  margin 1 0 Nothing
+  -- margin 1 0 (Just white)
+
+topBottomBorderWithLabel label = \wrapped ->
+  Widget Greedy Greedy $ do
+    c <- getContext
+    let (_w,h) = (c^.availWidthL, c^.availHeightL)
+        h' = h - 2
+        wrapped' = vLimit (h') wrapped
+        debugmsg =
+          ""
+          -- "  debug: "++show (_w,h')
+    render $
+      hBorderWithLabel (label <+> str debugmsg)
+      <=>
+      wrapped'
+      <=>
+      hBorder
+
+-- | Wrap a widget in a margin with the given horizontal and vertical
+-- thickness, using the current background colour or the specified
+-- colour. XXX May disrupt border style of inner widgets.
+margin :: Int -> Int -> Maybe Color -> Widget -> Widget
+margin h v mcolour = \w ->
+  Widget Greedy Greedy $ do
+    c <- getContext
+    let w' = vLimit (c^.availHeightL - v*2) $ hLimit (c^.availWidthL - h*2) w
+        attr = maybe currentAttr (\c -> c `on` c) mcolour
+    render $
+      withBorderAttr attr $
+      withBorderStyle (borderStyleFromChar ' ') $
+      applyN v (hBorder <=>) $
+      applyN h (vBorder <+>) $
+      applyN v (<=> hBorder) $
+      applyN h (<+> vBorder) $
+      w'
+
+   -- withBorderAttr attr .
+   -- withBorderStyle (borderStyleFromChar ' ') .
+   -- applyN n border
+
+withBorderAttr attr = updateAttrMap (applyAttrMappings [(borderAttr, attr)])
+
+-- _ui = vCenter $ vBox [ hCenter box
+--                       , str " "
+--                       , hCenter $ str "Press Esc to exit."
+--                       ]

hledger-ui/README

@@ -8,17 +8,31 @@ hledger-ui currently allows browsing the balance, register and print
 reports, with drill-down and scrolling.
 
 
-Backlog:
-show journal entries
+# HACKING
+
+## Backlog:
+```
+merge to master
+ brick release
+
+make it more useful
+ register
+  simplify/remove unhelpful account names ?
+ show journal entries
+  transaction dialog / journal screen
+ bs/is/cf-ish reports
+ save custom reports
+
 fix -H
 fix --drop
 track current account better
+ show it in register title
 track current query better
-search
-filter
-depth adjustment
+search in page
+adjust query
+adjust depth
+use color, selectable themes
 switch to next brick release
- reg: use full width
  reg2: find subaccounts' transactions better
  keep cursor at bottom of screen if jumping to end
 add
@@ -28,3 +42,5 @@ reload
  on screen change
  on redraw
  on file change
+
+```

hledger-ui/hledger-ui.cabal

@@ -56,6 +56,7 @@ executable hledger-ui
     , base >= 3 && < 5
     , brick
     , cmdargs >= 0.8
+    , containers
     , data-default
     , HUnit
     , lens >= 4.12.3 && < 4.13
@@ -74,6 +75,7 @@ executable hledger-ui
       Hledger.UI
       Hledger.UI.Main
       Hledger.UI.Options
+      Hledger.UI.Theme
       Hledger.UI.UITypes
       Hledger.UI.UIUtils
       Hledger.UI.AccountsScreen

hledger-ui/package.yaml

@@ -66,6 +66,7 @@ executables:
       - hledger-lib == 0.26.98
       - base >= 3 && < 5
       - cmdargs >= 0.8
+      - containers
       - HUnit
       - safe >= 0.2
       - split >= 0.1 && < 0.3

hledger/Hledger/Cli/Register.hs

@@ -113,6 +113,10 @@ tests_postingsReportAsText = [
 --
 -- date and description are shown for the first posting of a transaction only.
 --
+-- Returns a string which can be multi-line, eg if the running balance
+-- has multiple commodities. Does not yet support formatting control
+-- like balance reports.
+--
 postingsReportItemAsText :: CliOpts -> PostingsReportItem -> String
 postingsReportItemAsText opts (mdate, menddate, mdesc, p, b) =
   intercalate "\n" $