web: start txn-centric register refactoring, account register shows most recent first

hledger-web/.hledger/web/templates/registerreport2.hamlet

@@ -0,0 +1,10 @@
+<table.registerreport
+ <tr.headings
+  <th.date align=left>Date
+  <th.description align=left>Description
+  <th.account align=left>Account
+  <th.amount align=right>Amount
+  <th.balance align=right>#{balancelabel}
+
+ $forall i <- numberRegisterReport2Items items
+  ^{itemAsHtml vd i}

hledger-web/.hledger/web/templates/registerreport2item.hamlet

@@ -0,0 +1,6 @@
+<tr.item.#{evenodd}.#{firstposting}.#{datetransition}
+ <td.date>#{date}
+ <td.description title="#{desc}">#{elideRight 30 desc}
+ <td.account><a href="@?{accturl}" title="#{acct}">#{elideRight 40 acct}
+ <td.amount align=right>#{mixedAmountAsHtml amt}
+ <td.balance align=right>#{mixedAmountAsHtml bal}

hledger-web/Handlers.hs

@@ -61,9 +61,11 @@ postJournalR = handlePost
 -- | The main register view, with accounts sidebar.
 getRegisterR :: Handler RepHtml
 getRegisterR = do
-  vd@VD{opts=opts,j=j} <- getViewData
+  vd@VD{opts=opts,qopts=qopts,m=m,j=j} <- getViewData
   let sidecontent = balanceReportAsHtml  opts vd{q=""} $ balanceReport  opts nullfilterspec j
-      maincontent = registerReportAsHtml opts vd $ accountOrJournalRegisterReport vd j
+      maincontent =
+          case inAccountMatcher qopts of Just m'  -> registerReport2AsHtml opts vd $ accountRegisterReport opts j m m'
+                                         Nothing -> registerReportAsHtml opts vd $ registerReport opts nullfilterspec $ filterJournalPostings2 m j
       editform' = editform vd
   defaultLayout $ do
       setTitle "hledger-web register"
@@ -86,19 +88,21 @@ postJournalOnlyR = handlePost
 -- | A simple postings view, like hledger register (with editing.)
 getRegisterOnlyR :: Handler RepHtml
 getRegisterOnlyR = do
-  vd@VD{opts=opts,j=j} <- getViewData
+  vd@VD{opts=opts,qopts=qopts,m=m,j=j} <- getViewData
   defaultLayout $ do
       setTitle "hledger-web register only"
-      addHamlet $ registerReportAsHtml opts vd $ accountOrJournalRegisterReport vd j
+      addHamlet $
+          case inAccountMatcher qopts of Just m'  -> registerReport2AsHtml opts vd $ accountRegisterReport opts j m m'
+                                         Nothing -> registerReportAsHtml opts vd $ registerReport opts nullfilterspec $ filterJournalPostings2 m j
 
 postRegisterOnlyR :: Handler RepPlain
 postRegisterOnlyR = handlePost
 
--- temporary helper - use the new account register report when in:ACCT is specified.
+-- -- temporary helper - use the new account register report when in:ACCT is specified.
-accountOrJournalRegisterReport :: ViewData -> Journal -> RegisterReport
+-- accountOrJournalRegisterReport :: ViewData -> Journal -> RegisterReport
-accountOrJournalRegisterReport VD{opts=opts,m=m,qopts=qopts} j =
+-- accountOrJournalRegisterReport VD{opts=opts,m=m,qopts=qopts} j =
-    case inAccountMatcher qopts of Just m'  -> accountRegisterReport opts j m m'
+--     case inAccountMatcher qopts of Just m'  -> accountRegisterReport opts j m m'
-                                   Nothing -> registerReport opts nullfilterspec $ filterJournalPostings2 m j
+--                                    Nothing -> registerReport opts nullfilterspec $ filterJournalPostings2 m j
 
 -- | A simple accounts view, like hledger balance. If the Accept header
 -- specifies json, returns the chart of accounts as json.
@@ -167,6 +171,34 @@ registerReportAsHtml _ vd (balancelabel,items) = $(Settings.hamletFile "register
        acct = paccount posting
        accturl = (here, [("q", pack $ accountUrl acct)])
 
+-- mark II
+registerReport2AsHtml :: [Opt] -> ViewData -> RegisterReport2 -> Hamlet AppRoute
+registerReport2AsHtml _ vd (balancelabel,items) = $(Settings.hamletFile "registerreport2")
+ where
+   itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, RegisterReport2Item) -> Hamlet AppRoute
+   itemAsHtml VD{here=here} (n, newd, newm, newy, (t, acct, amt, bal)) = $(Settings.hamletFile "registerreport2item")
+     where
+       evenodd = if even n then "even" else "odd" :: String
+       datetransition | newm = "newmonth"
+                      | newd = "newday"
+                      | otherwise = "" :: String
+       (firstposting, date, desc) = (False, show $ tdate t, tdescription t)
+       accturl = (here, [("q", pack $ accountUrl acct)])
+
+numberRegisterReport2Items :: [RegisterReport2Item] -> [(Int,Bool,Bool,Bool,RegisterReport2Item)]
+numberRegisterReport2Items [] = []
+numberRegisterReport2Items is = number 0 nulldate is
+  where
+    number :: Int -> Day -> [RegisterReport2Item] -> [(Int,Bool,Bool,Bool,RegisterReport2Item)]
+    number _ _ [] = []
+    number n prevd (i@(Transaction{tdate=d},_,_,_):is)  = (n+1,newday,newmonth,newyear,i):(number (n+1) d is)
+        where
+          newday = d/=prevd
+          newmonth = dm/=prevdm || dy/=prevdy
+          newyear = dy/=prevdy
+          (dy,dm,_) = toGregorian d
+          (prevdy,prevdm,_) = toGregorian prevd
+
 mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "<br>" $ lines $ show b
     where addclass = printf "<span class=\"%s\">%s</span>" (c :: String)
           c = case isNegativeMixedAmount b of Just True -> "negative amount"
@@ -468,3 +500,4 @@ numberTransactions is = number 0 nulldate is
           newyear = dy/=prevdy
           (dy,dm,_) = toGregorian d
           (prevdy,prevdm,_) = toGregorian prevd
+

hledger/Hledger/Cli/Register.hs

@@ -8,6 +8,8 @@ A ledger-compatible @register@ command.
 module Hledger.Cli.Register (
   RegisterReport
  ,RegisterReportItem
+ ,RegisterReport2
+ ,RegisterReport2Item
  ,register
  ,registerReport
  ,accountRegisterReport
@@ -48,6 +50,17 @@ type RegisterReportItem = (Maybe (Day, String) -- transaction date and descripti
                           ,MixedAmount         -- balance so far
                           )
 
+-- | Register report mark II, used in hledger-web's account register (see "accountRegisterReport".
+type RegisterReport2 = (String                -- a possibly null label for the running balance column
+                       ,[RegisterReport2Item] -- line items, one per transaction
+                       )
+-- | A single register report 2 line item, representing one transaction to/from the focussed account.
+type RegisterReport2Item = (Transaction -- the corresponding transaction
+                           ,String      -- the (possibly aggregated) account info to display
+                           ,MixedAmount -- the (possibly aggregated) amount to display (sum of the other-account postings)
+                           ,MixedAmount -- the running balance for the focussed account after this transaction
+                           )
+
 -- | Print a register report.
 register :: [Opt] -> [String] -> Journal -> IO ()
 register opts args j = do
@@ -82,7 +95,73 @@ registerReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", ba
 
 showPostingWithBalanceForVty showtxninfo p b = registerReportItemAsText [] $ mkitem showtxninfo p b
 
--- | Get a register report with the specified options for this journal.
+totallabel = "Total"
+balancelabel = "Balance"
+
+-- | Get an account register report with the specified options for this
+-- journal.  An account register report is like the traditional account
+-- register seen in bank statements and personal finance programs.  It is
+-- focussed on one account only; it shows this account's transactions'
+-- postings to other accounts; and if there is no transaction filtering in
+-- effect other than a start date, it shows a historically-accurate
+-- running balance for this account. Once additional filters are applied,
+-- the running balance reverts to a running total starting at 0.
+-- Does not handle reporting intervals.
+-- Items are returned most recent first.
+accountRegisterReport :: [Opt] -> Journal -> Matcher -> Matcher -> RegisterReport2
+accountRegisterReport opts j m thisacctmatcher = (label, items)
+ where
+      -- | interval == NoInterval = items
+      -- | otherwise              = summarisePostingsByInterval interval depth empty filterspan displayps
+
+     -- transactions affecting this account, in date order
+     ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctmatcher) $ jtxns j
+
+     -- starting balance: if we are filtering by a start date and nothing else,
+     -- the sum of postings to this account before that date; otherwise zero.
+     (startbal,label, sumfn) | matcherIsNull m = (nullmixedamt,balancelabel,(-))
+                             | matcherIsStartDateOnly effective m = (sumPostings priorps,balancelabel,(-))
+                             | otherwise = (nullmixedamt,totallabel,(+))
+                      where
+                        priorps = -- ltrace "priorps" $
+                                  filter (matchesPosting
+                                          (-- ltrace "priormatcher" $
+                                           MatchAnd [thisacctmatcher, tostartdatematcher]))
+                                         $ transactionsPostings ts
+                        tostartdatematcher = MatchDate True (DateSpan Nothing startdate)
+                        startdate = matcherStartDate effective m
+                        effective = Effective `elem` opts
+
+     displaymatcher = -- ltrace "displaymatcher" $
+                      MatchAnd [negateMatcher thisacctmatcher, m]
+
+     items = reverse $ accountRegisterReportItems ts displaymatcher nulltransaction startbal sumfn
+
+-- | Generate account register line items from a list of transactions,
+-- using the provided matcher (postings not matching this will not affect
+-- the displayed item), starting transaction, starting balance, and
+-- balance summing function.
+accountRegisterReportItems :: [Transaction] -> Matcher -> Transaction -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [RegisterReport2Item]
+accountRegisterReportItems [] _ _ _ _ = []
+accountRegisterReportItems (t@Transaction{tpostings=ps}:ts) displaymatcher _ bal sumfn =
+    case i of Just i' -> i':is
+              Nothing -> is
+    where
+      (i,bal'') = case filter (displaymatcher `matchesPosting`) ps of
+           []  -> (Nothing,bal) -- maybe a virtual transaction, or transfer to self
+           [p] -> (Just (t, acct, amt, bal'), bal')
+               where
+                 acct = paccount p
+                 amt = pamount p
+                 bal' = bal `sumfn` amt
+           ps' -> (Just (t,acct,amt,bal'), bal')
+               where
+                 acct = "SPLIT ("++intercalate ", " (map (accountLeafName . paccount) ps')++")"
+                 amt = sum $ map pamount ps'
+                 bal' = bal `sumfn` amt
+      is = (accountRegisterReportItems ts displaymatcher t bal'' sumfn)
+
+-- | Get a traditional register report with the specified options for this journal.
 -- This is a journal register report, covering the whole journal like
 -- ledger's register command; for an account-specific register see
 -- accountRegisterReport.
@@ -102,63 +181,6 @@ registerReport opts fspec j = (totallabel,postingsToRegisterReportItems ps nullp
       filterspan = datespan fspec
       (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts)
 
--- | Get an account register report with the specified options for this
--- journal.  An account register report is like the traditional account
--- register seen in bank statements and personal finance programs.  It is
--- focussed on one account only; it shows this account's transactions'
--- postings to other accounts; and if there is no transaction filtering in
--- effect other than a start date, it shows a historically-accurate
--- running balance for this account. Once additional filters are applied,
--- the running balance reverts to a running total starting at 0.
---
--- Does not handle reporting intervals.
---
-accountRegisterReport :: [Opt] -> Journal -> Matcher -> Matcher -> RegisterReport
-accountRegisterReport opts j m thisacctmatcher = (label, postingsToRegisterReportItems displayps nullposting startbal sumfn)
- where
-      -- displayps' | interval == NoInterval = displayps
-      --            | otherwise              = summarisePostingsByInterval interval depth empty filterspan displayps
-
-     -- transactions affecting this account
-     ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctmatcher) $ jtxns j
-
-     -- starting balance: if we are filtering by a start date and nothing else,
-     -- the sum of postings to this account before that date; otherwise zero.
-     (startbal,label, sumfn) | matcherIsNull m = (nullmixedamt,balancelabel,(-))
-                             | matcherIsStartDateOnly effective m = (sumPostings priorps,balancelabel,(-))
-                             | otherwise = (nullmixedamt,totallabel,(+))
-                      where
-                        priorps = -- ltrace "priorps" $
-                                  filter (matchesPosting
-                                          (-- ltrace "priormatcher" $
-                                           MatchAnd [thisacctmatcher, tostartdatematcher]))
-                                         $ transactionsPostings ts
-                        tostartdatematcher = MatchDate True (DateSpan Nothing startdate)
-                        startdate = matcherStartDate effective m
-                        effective = Effective `elem` opts
-
-     -- postings to display: this account's transactions' "other" postings, with any additional filter applied
-     -- XXX would be better to collapse multiple postings from one txn into one (expandable) "split" item
-     displayps = -- ltrace "displayps" $
-                 catMaybes $ map displayPostingFromTransaction ts
-
-     displaymatcher = -- ltrace "displaymatcher" $
-                      MatchAnd [negateMatcher thisacctmatcher, m]
-
-     -- get the other account posting from this transaction, or if there
-     -- is more than one make a dummy posting indicating that
-     displayPostingFromTransaction :: Transaction -> Maybe Posting
-     displayPostingFromTransaction Transaction{tpostings=ps} =
-         case filter (displaymatcher `matchesPosting`) ps of
-           [] -> Nothing -- a virtual transaction, maybe
-           [p] -> Just p
-           ps'@(p':_) -> Just p'{paccount=splitdesc,pamount=splitamt}
-               where splitdesc = "SPLIT ("++intercalate ", " (map (accountLeafName . paccount) ps')++")"
-                     splitamt = sum $ map pamount ps'
-
-totallabel = "Total"
-balancelabel = "Balance"
-
 -- | Generate register report line items.
 postingsToRegisterReportItems :: [Posting] -> Posting -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [RegisterReportItem]
 postingsToRegisterReportItems [] _ _ _ = []