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

2024-12-28 21:02:04 +03:00 · 2011-06-24 01:29:01 +00:00 · 2011-06-24 01:29:01 +00:00 · b165f796cc
commit b165f796cc
parent c7d1a8afaa
4 changed files with 138 additions and 67 deletions
--- a/hledger-web/.hledger/web/templates/registerreport2.hamlet
+++ b/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}
--- a/hledger-web/.hledger/web/templates/registerreport2item.hamlet
+++ b/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}
--- a/hledger-web/Handlers.hs
+++ b/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.
-accountOrJournalRegisterReport :: ViewData -> Journal -> RegisterReport
-accountOrJournalRegisterReport VD{opts=opts,m=m,qopts=qopts} j =
-    case inAccountMatcher qopts of Just m'  -> accountRegisterReport opts j m m'
-                                   Nothing -> registerReport opts nullfilterspec $ filterJournalPostings2 m j
+-- -- temporary helper - use the new account register report when in:ACCT is specified.
+-- accountOrJournalRegisterReport :: ViewData -> Journal -> RegisterReport
+-- accountOrJournalRegisterReport VD{opts=opts,m=m,qopts=qopts} j =
+--     case inAccountMatcher qopts of Just m'  -> accountRegisterReport opts j m m'
+--                                    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
+
--- a/hledger/Hledger/Cli/Register.hs
+++ b/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 [] _ _ _ = []