web: make journal register work like account registers; show multiple postings

hledger-web/.hledger/web/static/hledger.js

@@ -14,6 +14,7 @@ $(document).ready(function() {
     /* set up various show/hide toggles */
     $('#search-help-link').click(function() { $('#search-help').slideToggle('fast'); });
     $('#accounts-toggle-link').click(function() { $('#accounts').slideToggle('fast'); });
+    $('.postings-toggle-link').click(function() { $(this).parent().parent().nextUntil(':not(.posting)').toggle(); event.preventDefault(); });
 
 });
 

hledger-web/.hledger/web/static/style.css

@@ -112,6 +112,9 @@ table.registerreport        { border-spacing:0; }
 table.registerreport tr     { vertical-align:top; }
 table.registerreport td     { padding-bottom:0.2em; }
 table.registerreport .date  { white-space:nowrap; }
+table.registerreport tr.posting { display:none; font-size:smaller; }
+table.registerreport tr.posting .account  { padding-left:1.5em; }
+table.registerreport tr.posting .amount  { padding-right:0.5em; }
 tr.firstposting td          { }
 tr.newday td                { border-top: 1px solid black; }
 tr.newmonth td              { border-top: 2px solid black; }

hledger-web/.hledger/web/templates/accountregisterreportitem.hamlet

@@ -1,6 +1,24 @@
 <tr.item.#{evenodd}.#{firstposting}.#{datetransition}
  <td.date>#{date}
- <td.description title="#{desc}">#{elideRight 30 desc}
+ <td.description title="#{show t}">#{elideRight 30 desc}
- <td.account><a href="@?{accturl}" title="#{acct}">#{elideRight 40 acct}
+ <td.account>
- <td.amount align=right>#{mixedAmountAsHtml amt}
+  $if split
+   <a title="#{acct}"
+    #{elideRight 40 acct}
+   &nbsp;
+   <a.postings-toggle-link.togglelink href="#" title="Toggle postings"
+    [+/-]
+  $else
+   <a href="@?{acctquery}" title="Go to #{acct}">#{elideRight 40 acct}
+ <td.amount align=right>
+  $if showamt
+   #{mixedAmountAsHtml amt}
  <td.balance align=right>#{mixedAmountAsHtml bal}
+$if split
+ $forall p <- tpostings t'
+  <tr.item.#{evenodd}.posting
+   <td.date
+   <td.description
+   <td.account>&nbsp;<a href="@?{accountUrl here $ paccount p}" title="#{stringIfLongerThan 40 $ paccount p}">#{elideRight 40 $ paccount p}
+   <td.amount align=right>#{mixedAmountAsHtml $ pamount p}
+   <td.balance align=right>

hledger-web/.hledger/web/templates/balancereportitem.hamlet

@@ -1,12 +1,13 @@
 <tr.item.#{inacctclass}
  <td.account.#{depthclass}
   #{indent}
-  <a href="@?{accturl}">#{adisplay}
+  <a href="@?{acctquery}" title="Focus on this account">#{adisplay}
   <span.accountextralinks
    &nbsp;
-   <a href="@?{acctsurl}">+subs
+   <a href="@?{acctsquery}" title="Focus on this account and sub-accounts">+subs
-   &nbsp;
+   <!--
-   <a href="@?{acctsonlyurl}">-others
+    &nbsp;
+    <a href="@?{acctsonlyquery}" title="Focus on this account and sub-accounts and hide others">-others -->
 
  <td.balance align=right>#{mixedAmountAsHtml abal}
  <td.numpostings align=right>(#{numpostingsinacct acct})

hledger-web/.hledger/web/templates/postingregisterreportitem.hamlet

@@ -1,6 +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.account><a href="@?{acctquery}" title="#{acct}">#{elideRight 40 acct}
  <td.amount align=right>#{mixedAmountAsHtml $ pamount posting}
  <td.balance align=right>#{mixedAmountAsHtml b}

hledger-web/Handlers.hs

@@ -65,7 +65,7 @@ getRegisterR = do
   let sidecontent = balanceReportAsHtml  opts vd{q=""} $ balanceReport opts nullfilterspec j
       maincontent =
           case inAccountMatcher qopts of Just m' -> accountRegisterReportAsHtml opts vd $ accountRegisterReport opts j m m'
-                                         Nothing -> postingRegisterReportAsHtml opts vd $ postingRegisterReport opts nullfilterspec $ filterJournalPostings2 m j
+                                         Nothing -> accountRegisterReportAsHtml opts vd $ journalRegisterReport opts j m
       editform' = editform vd
   defaultLayout $ do
       setTitle "hledger-web register"
@@ -93,7 +93,7 @@ getRegisterOnlyR = do
       setTitle "hledger-web register only"
       addHamlet $
           case inAccountMatcher qopts of Just m' -> accountRegisterReportAsHtml opts vd $ accountRegisterReport opts j m m'
-                                         Nothing -> postingRegisterReportAsHtml opts vd $ postingRegisterReport opts nullfilterspec $ filterJournalPostings2 m j
+                                         Nothing -> accountRegisterReportAsHtml opts vd $ journalRegisterReport opts j m
 
 postRegisterOnlyR :: Handler RepPlain
 postRegisterOnlyR = handlePost
@@ -119,34 +119,37 @@ getAccountsJsonR = do
 
 -- helpers
 
-accountUrl :: String -> String
+accountQuery :: AccountName -> String
-accountUrl a = "inacct:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a)
+accountQuery a = "inacct:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a)
 
-accountsUrl :: String -> String
+accountsQuery :: AccountName -> String
-accountsUrl a = "inaccts:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a)
+accountsQuery a = "inaccts:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a)
 
-accountsOnlyUrl :: String -> String
+accountsOnlyQuery :: AccountName -> String
-accountsOnlyUrl a = "inacctsonly:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a)
+accountsOnlyQuery a = "inacctsonly:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a)
+
+-- accountUrl :: AppRoute -> AccountName -> (AppRoute,[(String,ByteString)])
+accountUrl r a = (r, [("q",pack $ accountQuery a)])
 
 -- | Render a balance report as HTML.
 balanceReportAsHtml :: [Opt] -> ViewData -> BalanceReport -> Hamlet AppRoute
 balanceReportAsHtml _ vd@VD{here=here,q=q,m=m,qopts=qopts,j=j} (items,total) = $(Settings.hamletFile "balancereport")
  where
    l = journalToLedger nullfilterspec j
-   numpostingsinacct = length . apostings . ledgerAccount l
    inacctmatcher = inAccountMatcher qopts
    allaccts = isNothing inacctmatcher
    itemAsHtml :: ViewData -> BalanceReportItem -> Hamlet AppRoute
    itemAsHtml VD{here=here,q=q} (acct, adisplay, aindent, abal) = $(Settings.hamletFile "balancereportitem")
      where
+       numpostings = length $ apostings $ ledgerAccount l acct
        depthclass = "depth"++show aindent
        inacctclass = case inacctmatcher of
                        Just m -> if m `matchesAccount` acct then "inacct" else "notinacct"
                        Nothing -> "" :: String
        indent = preEscapedString $ concat $ replicate (2 * aindent) " "
-       accturl = (here, [("q", pack $ accountUrl acct)])
+       acctquery = (here, [("q", pack $ accountQuery acct)])
-       acctsurl = (here, [("q", pack $ accountsUrl acct)])
+       acctsquery = (here, [("q", pack $ accountsQuery acct)])
-       acctsonlyurl = (here, [("q", pack $ accountsOnlyUrl acct)])
+       acctsonlyquery = (here, [("q", pack $ accountsOnlyQuery acct)])
 
 -- | Render a journal report as HTML.
 journalReportAsHtml :: [Opt] -> ViewData -> JournalReport -> Hamlet AppRoute
@@ -158,54 +161,23 @@ journalReportAsHtml _ vd items = $(Settings.hamletFile "journalreport")
        evenodd = if even n then "even" else "odd" :: String
        txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse
 
--- | Render a register report as HTML.
--- Journal-wide postings register, when no account has focus.
-postingRegisterReportAsHtml :: [Opt] -> ViewData -> PostingRegisterReport -> Hamlet AppRoute
-postingRegisterReportAsHtml _ vd (balancelabel,items) = $(Settings.hamletFile "postingregisterreport")
- where
-   itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, PostingRegisterReportItem) -> Hamlet AppRoute
-   itemAsHtml VD{here=here} (n, newd, newm, newy, (ds, posting, b)) = $(Settings.hamletFile "postingregisterreportitem")
-     where
-       evenodd = if even n then "even" else "odd" :: String
-       datetransition | newm = "newmonth"
-                      | newd = "newday"
-                      | otherwise = "" :: String
-       (firstposting, date, desc) = case ds of Just (da, de) -> ("firstposting", show da, de)
-                                               Nothing -> ("", "", "") :: (String,String,String)
-       acct = paccount posting
-       accturl = (here, [("q", pack $ accountUrl acct)])
-
--- Add incrementing transaction numbers to a list of register report items
--- starting at 1.  Also add three flags that are true if the date, month,
--- and year is different from the previous item's.
-numberPostingRegisterReportItems :: [PostingRegisterReportItem] -> [(Int,Bool,Bool,Bool,PostingRegisterReportItem)]
-numberPostingRegisterReportItems [] = []
-numberPostingRegisterReportItems is = number 0 nulldate is
-  where
-    number :: Int -> Day -> [PostingRegisterReportItem] -> [(Int,Bool,Bool,Bool,PostingRegisterReportItem)]
-    number _ _ [] = []
-    number n prevd (i@(Nothing, _, _)   :is)  = (n,False,False,False,i)    :(number n prevd is)
-    number n prevd (i@(Just (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
-
 -- Account-specific transaction register, when an account is focussed.
 accountRegisterReportAsHtml :: [Opt] -> ViewData -> AccountRegisterReport -> Hamlet AppRoute
 accountRegisterReportAsHtml _ vd (balancelabel,items) = $(Settings.hamletFile "accountregisterreport")
  where
    itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, AccountRegisterReportItem) -> Hamlet AppRoute
-   itemAsHtml VD{here=here} (n, newd, newm, newy, (t, acct, amt, bal)) = $(Settings.hamletFile "accountregisterreportitem")
+   itemAsHtml VD{here=here} (n, newd, newm, newy, (t, t', split, acct, amt, bal)) = $(Settings.hamletFile "accountregisterreportitem")
      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)])
+       acctquery = (here, [("q", pack $ accountQuery acct)])
+       showamt = not split || not (isZeroMixedAmount amt)
+
+stringIfLongerThan :: Int -> String -> String
+stringIfLongerThan n s = if length s > n then s else ""
 
 numberAccountRegisterReportItems :: [AccountRegisterReportItem] -> [(Int,Bool,Bool,Bool,AccountRegisterReportItem)]
 numberAccountRegisterReportItems [] = []
@@ -213,7 +185,7 @@ numberAccountRegisterReportItems is = number 0 nulldate is
   where
     number :: Int -> Day -> [AccountRegisterReportItem] -> [(Int,Bool,Bool,Bool,AccountRegisterReportItem)]
     number _ _ [] = []
-    number n prevd (i@(Transaction{tdate=d},_,_,_):is)  = (n+1,newday,newmonth,newyear,i):(number (n+1) d is)
+    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

hledger/Hledger/Cli/Register.hs

@@ -13,6 +13,7 @@ module Hledger.Cli.Register (
  ,register
  ,postingRegisterReport
  ,accountRegisterReport
+ ,journalRegisterReport
  ,postingRegisterReportAsText
  ,showPostingWithBalanceForVty
  ,tests_Hledger_Cli_Register
@@ -58,6 +59,8 @@ type AccountRegisterReport = (String                      -- label for the balan
 
 -- | A single account register line item, representing one transaction to/from the focussed account.
 type AccountRegisterReportItem = (Transaction -- the corresponding transaction
+                                 ,Transaction -- the transaction with postings to the focussed account removed
+                                 ,Bool        -- is this a split (more than one other-account posting) ?
                                  ,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
@@ -103,7 +106,7 @@ balancelabel = "Balance"
 -- | Get a ledger-style posting register report, with the specified options,
 -- for the whole journal. See also "accountRegisterReport".
 postingRegisterReport :: [Opt] -> FilterSpec -> Journal -> PostingRegisterReport
-postingRegisterReport opts fspec j = (totallabel,postingRegisterItems ps nullposting startbal (+))
+postingRegisterReport opts fspec j = (totallabel, postingRegisterItems ps nullposting startbal (+))
     where
       ps | interval == NoInterval = displayableps
          | otherwise              = summarisePostingsByInterval interval depth empty filterspan displayableps
@@ -173,10 +176,19 @@ datedisplayexpr = do
  where
   compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]
 
--- | Get a quicken/gnucash-style account register report, with the
+-- | Get a ledger-style register report showing all matched transactions and postings.
--- specified options, for the currently focussed account (or possibly the
+-- Similar to "postingRegisterReport" except it uses matchers and
--- focussed account plus sub-accounts.) This differs from
+-- per-transaction report items like "accountRegisterReport".
--- "postingRegisterReport" in several ways:
+journalRegisterReport :: [Opt] -> Journal -> Matcher -> AccountRegisterReport
+journalRegisterReport opts j@Journal{jtxns=ts} m = (totallabel, items)
+   where
+     ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts
+     items = reverse $ accountRegisterReportItems m MatchAny nullmixedamt (+) ts'
+
+-- | Get a conventional account register report, with the specified
+-- options, for the currently focussed account (or possibly the focussed
+-- account plus sub-accounts.) This differs from "postingRegisterReport"
+-- in several ways:
 --
 -- 1. it shows transactions, from the point of view of the focussed
 --    account. The other account's name and posted amount is displayed,
@@ -195,7 +207,6 @@ accountRegisterReport opts j m thisacctmatcher = (label, items)
  where
      -- 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,(-))
@@ -210,35 +221,45 @@ accountRegisterReport opts j m thisacctmatcher = (label, items)
                         tostartdatematcher = MatchDate True (DateSpan Nothing startdate)
                         startdate = matcherStartDate effective m
                         effective = Effective `elem` opts
-
+     items = reverse $ accountRegisterReportItems m thisacctmatcher startbal sumfn ts
-     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
+-- using the provided query and "this account" matchers, starting balance,
--- the displayed item), starting transaction, starting balance, and
+-- and balance summing function.
--- balance summing function.
+accountRegisterReportItems :: Matcher -> Matcher -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [Transaction] -> [AccountRegisterReportItem]
-accountRegisterReportItems :: [Transaction] -> Matcher -> Transaction -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [AccountRegisterReportItem]
+accountRegisterReportItems _ _ _ _ [] = []
-accountRegisterReportItems [] _ _ _ _ = []
+accountRegisterReportItems matcher thisacctmatcher bal sumfn (t@Transaction{tpostings=ps}:ts) =
-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
+      thisacctps = tpostings $ filterTransactionPostings thisacctmatcher t
+      numthisacctsposted = length $ nub $ map paccount thisacctps
+      displaymatcher | numthisacctsposted > 1 = matcher
+                     | otherwise              = MatchAnd [negateMatcher thisacctmatcher, matcher]
+      t'@Transaction{tpostings=ps'} = filterTransactionPostings displaymatcher t
+      (i,bal'') = case ps' of
            []  -> (Nothing,bal) -- maybe a virtual transaction, or transfer to self
-           [p] -> (Just (t, acct, amt, bal'), bal')
+           [p] -> (Just (t, t', False, acct, amt, bal'), bal')
                where
                  acct = paccount p
                  amt = pamount p
                  bal' = bal `sumfn` amt
-           ps' -> (Just (t,acct,amt,bal'), bal')
+           ps' -> (Just (t, t', True, acct, amt, bal'), bal')
                where
-                 acct = "SPLIT ("++intercalate ", " (map (accountLeafName . paccount) ps')++")"
+                 -- describe split as from ..., to ... (not always right)
+                 acct = case (simplify tos, simplify froms) of
+                         ([],ts) -> "to "++commafy ts
+                         (fs,[]) -> "from "++commafy fs
+                         (fs,ts) -> "to "++commafy ts++" from "++commafy fs
+                        where (tos,froms) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps'
+                              simplify = nub . map (accountLeafName . paccount)
+                              commafy = intercalate ", "
                  amt = sum $ map pamount ps'
                  bal' = bal `sumfn` amt
-      is = (accountRegisterReportItems ts displaymatcher t bal'' sumfn)
+      is = accountRegisterReportItems matcher thisacctmatcher bal'' sumfn ts
+
+filterTransactionPostings :: Matcher -> Transaction -> Transaction
+filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}
 
 -- XXX confusing, refactor