ui: provide a more useful transaction register

The register screen is now like the register view in hledger-web (and
other accounting systems), rather than hledger's register command.
This means:

- it shows transactions affecting a particular current account, rather
  than postings matching a pattern.

- Each line represents a whole transaction.

- The account field shows the *other* account being transacted with.
  When there is more than one, they are all listed, abbreviated and
  marked with "(split)".

- The amount field shows the effect of the transaction on the current
  account; positive for an inflow to this account, negative for an
  outflow.

- The balance field should usually show the current account's historic
  balance as of the transaction date, even when you change the report
  start date. (Not working yet - currently it always shows the running
  total).

- Transactions are listed most recent first, currently.

hledger-lib/Hledger/Data/AccountName.hs

@@ -10,6 +10,7 @@ hierarchy.
 module Hledger.Data.AccountName
 where
 import Data.List
+import Data.List.Split (splitOn)
 import Data.Tree
 import Test.HUnit
 import Text.Printf
@@ -31,6 +32,15 @@ accountNameFromComponents = concat . intersperse [acctsepchar]
 accountLeafName :: AccountName -> String
 accountLeafName = last . accountNameComponents
 
+accountSummarisedName :: AccountName -> String
+accountSummarisedName a
+  -- | length cs > 1 = take 2 (head cs) ++ ":" ++ a'
+  | length cs > 1 = intercalate ":" (map (take 2) $ init cs) ++ ":" ++ a'
+  | otherwise     = a'
+    where
+      cs = accountNameComponents a
+      a' = accountLeafName a
+
 accountNameLevel :: AccountName -> Int
 accountNameLevel "" = 0
 accountNameLevel a = length (filter (==acctsepchar) a) + 1
@@ -100,7 +110,18 @@ nullaccountnametree = Node "root" []
 --     ..:Af:Lu:Sn:Ca:Ch:Cash  ; Abbreviated and elided!
 -- @
 elideAccountName :: Int -> AccountName -> AccountName
-elideAccountName width s =
+elideAccountName width s
+  -- XXX special case for transactions register's multi-account pseudo-names
+  | " (split)" `isSuffixOf` s =
+    let
+      names = splitOn ", " $ take (length s - 8) s
+      widthpername = (max 0 (width - 8 - 2 * (max 1 (length names) - 1))) `div` length names
+    in
+     elideLeft width $
+     (++" (split)") $
+     intercalate ", " $
+     [accountNameFromComponents $ elideparts widthpername [] $ accountNameComponents s' | s' <- names]
+  | otherwise =
     elideLeft width $ accountNameFromComponents $ elideparts width [] $ accountNameComponents s
       where
         elideparts :: Int -> [String] -> [String] -> [String]

hledger-lib/Hledger/Reports/TransactionsReports.hs

@@ -11,6 +11,8 @@ a some base account.  They are used by hledger-web.
 module Hledger.Reports.TransactionsReports (
   TransactionsReport,
   TransactionsReportItem,
+  AccountTransactionsReport,
+  AccountTransactionsReportItem,
   triOrigTransaction,
   triDate,
   triAmount,
@@ -78,15 +80,16 @@ journalTransactionsReport opts j q = (totallabel, items)
 
 -- | An account transactions report represents transactions affecting
 -- a particular account (or possibly several accounts, but we don't
--- use that). It is used by hledger-web's account register view, where
+-- use that). It is used by hledger-web's (and hledger-ui's) account
--- we want to show one row per journal transaction, with:
+-- register view, where we want to show one row per journal
+-- transaction, with:
 --
 -- - the total increase/decrease to the current account
 --
 -- - the names of the other account(s) posted to/from
 --
--- - transaction dates adjusted to the date of the earliest posting to
+-- - transaction dates, adjusted to the date of the earliest posting to
---   the current account, if those postings have their own dates
+--   the current account if those postings have their own dates
 --
 -- Currently, reporting intervals are not supported, and report items
 -- are most recent first.
@@ -199,7 +202,7 @@ accountTransactionsReportItems query thisacctquery bal signfn (torig:ts) =
 
 -- | Generate a simplified summary of some postings' accounts.
 summarisePostingAccounts :: [Posting] -> String
-summarisePostingAccounts = intercalate ", " . map accountLeafName . nub . map paccount
+summarisePostingAccounts = intercalate ", " . map accountSummarisedName . nub . map paccount
 
 filterTransactionPostings :: Query -> Transaction -> Transaction
 filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -26,7 +26,7 @@ import Hledger.Cli hiding (progname,prognameandversion,green)
 import Hledger.UI.Options
 import Hledger.UI.UITypes
 import Hledger.UI.UIUtils
-import qualified Hledger.UI.RegisterScreen as RS (screen)
+import qualified Hledger.UI.RegisterScreen2 as RS2 (screen)
 
 screen = AccountsScreen{
    asState  = list "accounts" V.empty 1
@@ -105,7 +105,7 @@ handleAccountsScreen st@AppState{aScreen=scr@AccountsScreen{asState=is}} e = do
         Vty.EvKey (Vty.KLeft) []     -> continue $ popScreen st
         Vty.EvKey (Vty.KRight) []    -> continue st'
           where
-            st' = screenEnter d args RS.screen st
+            st' = screenEnter d args RS2.screen st
             args = case listSelectedElement is of
                     Just (_, ((acct, _, _), _)) -> ["acct:"++accountNameToAccountRegex acct]
                     Nothing -> []

hledger-ui/Hledger/UI/Main.hs

@@ -4,20 +4,27 @@ Copyright (c) 2007-2015 Simon Michael <simon@joyful.com>
 Released under GPL version 3 or later.
 
 TODO:
-reg: don't repeat date/description for postings in same txn
+show journal entries
-reg: show a hledger-web-style register
 --
 switch to next brick release
-reg: use full width
+ reg: use full width
-reg: keep cursor at bottom of screen when jumping to end
+ home/end
-page up/down
+ keep cursor at bottom of screen if jumping to end
-home/end
+ reg2: find subaccounts' transactions better
+ reg2: track current account better
+ reg2: track current query better
+--
+-H
+--drop
 search
 filter
---
+depth adjustment
-show journal entries
 add
 edit
+options adjustment
+reload on screen change
+reload on redraw
+reload on file change
 -}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -45,14 +52,15 @@ import Hledger.UI.Options
 import Hledger.UI.UITypes
 import Hledger.UI.UIUtils
 import Hledger.UI.AccountsScreen as AS
-import Hledger.UI.RegisterScreen as RS
+-- import Hledger.UI.RegisterScreen as RS
+import Hledger.UI.RegisterScreen2 as RS2
 
 ----------------------------------------------------------------------
 
 -- | The available screens.
 appScreens = [
    AS.screen
-  ,RS.screen
+  ,RS2.screen
   ]
 
 main :: IO ()

hledger-ui/Hledger/UI/RegisterScreen.hs

@@ -98,6 +98,6 @@ handleRegisterScreen st@AppState{aScreen=s@RegisterScreen{rsState=is}} e =
     -- fall through to the list's event handler (handles [pg]up/down)
     ev                       -> do
                                  is' <- handleEvent ev is
-                                 continue $ st{aScreen=s{rsState=is'}}
+                                 continue st{aScreen=s{rsState=is'}}
                                  -- continue =<< handleEventLensed st someLens ev
 handleRegisterScreen _ _ = error "event handler called with wrong screen type, should not happen"

hledger-ui/Hledger/UI/RegisterScreen2.hs

@@ -0,0 +1,125 @@
+-- The register screen, showing account postings, like the CLI register command.
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hledger.UI.RegisterScreen2
+ (screen)
+where
+
+import Control.Lens ((^.))
+-- import Control.Monad.IO.Class (liftIO)
+import Data.List
+import Data.List.Split (splitOn)
+import Data.Time.Calendar (Day)
+import qualified Data.Vector as V
+import qualified Graphics.Vty as Vty
+import Brick
+import Brick.Widgets.List
+import Brick.Widgets.Border
+import Brick.Widgets.Center
+
+import Hledger
+import Hledger.Cli hiding (progname,prognameandversion,green)
+import Hledger.UI.Options
+import Hledger.UI.UITypes
+import Hledger.UI.UIUtils
+
+screen = RegisterScreen2{
+   rs2State  = list "register" V.empty 1
+  ,sInitFn    = initRegisterScreen2
+  ,sDrawFn    = drawRegisterScreen2
+  ,sHandleFn = handleRegisterScreen2
+  }
+
+initRegisterScreen2 :: Day -> [String] -> AppState -> AppState
+initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen2{}} =
+  st{aScreen=s{rs2State=is'}}
+  where
+    is' =
+      -- listMoveTo (length items) $
+      list (Name "register") (V.fromList items) 1
+
+    (_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
+
+        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]
+  where
+    label = str "Transaction "
+            <+> cur
+            <+> str " of "
+            <+> total
+            <+> str " to/from this account" -- " <+> str query <+> "and subaccounts"
+    cur = str $ case is^.(listSelectedL) of
+                 Nothing -> "-"
+                 Just i -> show (i + 1)
+    total = str $ show $ length $ is^.(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."
+                          ]
+drawRegisterScreen2 _ = error "draw function called with wrong screen type, should not happen"
+
+drawRegisterItem :: Bool -> AccountTransactionsReportItem -> 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)
+                 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 "160"} $ -- XXX
+         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
+
+handleRegisterScreen2 :: AppState -> Vty.Event -> EventM (Next AppState)
+handleRegisterScreen2 st@AppState{aopts=_opts,aScreen=s@RegisterScreen2{rs2State=is}} e = do
+  case e of
+    Vty.EvKey Vty.KEsc []        -> halt st
+    Vty.EvKey (Vty.KChar 'q') [] -> halt st
+    Vty.EvKey (Vty.KLeft) []     -> continue $ popScreen st
+    -- Vty.EvKey (Vty.KRight) []    -> error (show curItem) where curItem = listSelectedElement is
+    -- fall through to the list's event handler (handles [pg]up/down)
+    ev                       -> do
+                                 is' <- handleEvent ev is
+                                 continue st{aScreen=s{rs2State=is'}}
+                                 -- continue =<< handleEventLensed st someLens ev
+handleRegisterScreen2 _ _ = error "event handler called with wrong screen type, should not happen"

hledger-ui/Hledger/UI/UITypes.hs

@@ -37,5 +37,11 @@ data Screen =
     ,sDrawFn :: AppState -> [Widget]
     }
   deriving (Show)
+  | RegisterScreen2 {
+     rs2State :: List AccountTransactionsReportItem
+    ,sInitFn :: Day -> [String] -> AppState -> AppState
+    ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
+    ,sDrawFn :: AppState -> [Widget]
+    }
 
 instance Show (List a) where show _ = "<List>"

hledger-ui/hledger-ui.cabal

@@ -78,4 +78,5 @@ executable hledger-ui
       Hledger.UI.UIUtils
       Hledger.UI.AccountsScreen
       Hledger.UI.RegisterScreen
+      Hledger.UI.RegisterScreen2
   default-language: Haskell2010