refactor: move basic report generation to hledger-lib

hledger-lib/Hledger.hs

@@ -1,6 +1,7 @@
 module Hledger (
                 module Hledger.Data
                ,module Hledger.Read
+               ,module Hledger.Report
                ,module Hledger.Utils
 )
 where

hledger-lib/Hledger/Report.hs

@@ -0,0 +1,448 @@
+{-|
+
+Generate various kinds of report from a journal/ledger.
+
+-}
+
+module Hledger.Report (
+  tests_Hledger_Report
+ ,JournalReport
+ ,JournalReportItem
+ ,PostingRegisterReport
+ ,PostingRegisterReportItem
+ ,AccountRegisterReport
+ ,AccountRegisterReportItem
+ ,BalanceReport
+ ,BalanceReportItem
+ ,ariDate
+ ,ariBalance
+ ,journalReport
+ ,postingRegisterReport
+ ,accountRegisterReport
+ ,journalRegisterReport
+ ,mkpostingRegisterItem
+ ,balanceReport
+ ,balanceReport2
+)
+where
+
+import Control.Monad
+import Data.List
+import Data.Maybe
+import Data.Ord
+import Data.Time.Calendar
+import Data.Tree
+import Safe (headMay, lastMay)
+import Test.HUnit
+import Text.ParserCombinators.Parsec
+import Text.Printf
+
+import Hledger.Cli.Options
+import Hledger.Cli.Utils
+import Hledger.Data
+import Hledger.Utils
+
+
+-- | A "journal report" is just a list of transactions.
+type JournalReport = [JournalReportItem]
+
+type JournalReportItem = Transaction
+
+-- | A posting register report lists postings to one or more accounts,
+-- with a running total. Postings may be actual postings, or aggregate
+-- postings corresponding to a reporting interval.
+type PostingRegisterReport = (String                      -- label for the running balance column XXX remove
+                             ,[PostingRegisterReportItem] -- line items, one per posting
+                             )
+
+type PostingRegisterReportItem = (Maybe (Day, String) -- transaction date and description if this is the first posting
+                                 ,Posting             -- the posting
+                                 ,MixedAmount         -- the running total after this posting
+                                 )
+
+-- | An account register report lists transactions to a single account (or
+-- possibly subs as well), with the accurate running account balance when
+-- possible (otherwise, a running total.)
+type AccountRegisterReport = (String                      -- label for the balance column, eg "balance" or "total"
+                             ,[AccountRegisterReportItem] -- line items, one per transaction
+                             )
+
+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
+                                 )
+
+ariDate (t,_,_,_,_,_) = tdate t
+ariBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"
+                                           (Amount{quantity=q}):_ -> show q
+
+-- | A balance report is a chart of accounts with balances, and their grand total.
+type BalanceReport = ([BalanceReportItem] -- line items, one per account
+                     ,MixedAmount         -- total balance of all accounts
+                     )
+
+type BalanceReportItem = (AccountName  -- full account name
+                         ,AccountName  -- account name elided for display: the leaf name,
+                                       -- prefixed by any boring parents immediately above
+                         ,Int          -- how many steps to indent this account (0-based account depth excluding boring parents)
+                         ,MixedAmount) -- account balance, includes subs unless --flat is present
+
+-------------------------------------------------------------------------------
+
+journalReport :: [Opt] -> FilterSpec -> Journal -> JournalReport
+journalReport opts fspec j = sortBy (comparing tdate) $ jtxns $ filterJournalTransactions fspec j'
+    where
+      j' = journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
+
+-------------------------------------------------------------------------------
+
+-- | 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 (+))
+    where
+      ps | interval == NoInterval = displayableps
+         | otherwise              = summarisePostingsByInterval interval depth empty filterspan displayableps
+      (precedingps, displayableps, _) = postingsMatchingDisplayExpr (displayExprFromOpts opts)
+                                        $ depthClipPostings depth
+                                        $ journalPostings
+                                        $ filterJournalPostings fspec{depth=Nothing}
+                                        $ journalSelectingDateFromOpts opts
+                                        $ journalSelectingAmountFromOpts opts
+                                        j
+      startbal = sumPostings precedingps
+      filterspan = datespan fspec
+      (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts)
+
+totallabel = "Total"
+balancelabel = "Balance"
+
+-- | Generate posting register report line items.
+postingRegisterItems :: [Posting] -> Posting -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingRegisterReportItem]
+postingRegisterItems [] _ _ _ = []
+postingRegisterItems (p:ps) pprev b sumfn = i:(postingRegisterItems ps p b' sumfn)
+    where
+      i = mkpostingRegisterItem isfirst p b'
+      isfirst = ptransaction p /= ptransaction pprev
+      b' = b `sumfn` pamount p
+
+-- | Generate one register report line item, from a flag indicating
+-- whether to include transaction info, a posting, and the current running
+-- balance.
+mkpostingRegisterItem :: Bool -> Posting -> MixedAmount -> PostingRegisterReportItem
+mkpostingRegisterItem False p b = (Nothing, p, b)
+mkpostingRegisterItem True p b = (ds, p, b)
+    where ds = case ptransaction p of Just (Transaction{tdate=da,tdescription=de}) -> Just (da,de)
+                                      Nothing -> Just (nulldate,"")
+
+-- | Date-sort and split a list of postings into three spans - postings matched
+-- by the given display expression, and the preceding and following postings.
+postingsMatchingDisplayExpr :: Maybe String -> [Posting] -> ([Posting],[Posting],[Posting])
+postingsMatchingDisplayExpr d ps = (before, matched, after)
+    where
+      sorted = sortBy (comparing postingDate) ps
+      (before, rest) = break (displayExprMatches d) sorted
+      (matched, after) = span (displayExprMatches d) rest
+
+-- | Does this display expression allow this posting to be displayed ?
+-- Raises an error if the display expression can't be parsed.
+displayExprMatches :: Maybe String -> Posting -> Bool
+displayExprMatches Nothing  _ = True
+displayExprMatches (Just d) p = (fromparse $ parsewith datedisplayexpr d) p
+
+-- | Parse a hledger display expression, which is a simple date test like
+-- "d>[DATE]" or "d<=[DATE]", and return a "Posting"-matching predicate.
+datedisplayexpr :: GenParser Char st (Posting -> Bool)
+datedisplayexpr = do
+  char 'd'
+  op <- compareop
+  char '['
+  (y,m,d) <- smartdate
+  char ']'
+  let date    = parsedate $ printf "%04s/%02s/%02s" y m d
+      test op = return $ (`op` date) . postingDate
+  case op of
+    "<"  -> test (<)
+    "<=" -> test (<=)
+    "="  -> test (==)
+    "==" -> test (==)
+    ">=" -> test (>=)
+    ">"  -> test (>)
+    _    -> mzero
+ where
+  compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]
+
+-- | Clip the account names to the specified depth in a list of postings.
+depthClipPostings :: Maybe Int -> [Posting] -> [Posting]
+depthClipPostings depth = map (depthClipPosting depth)
+
+-- | Clip a posting's account name to the specified depth.
+depthClipPosting :: Maybe Int -> Posting -> Posting
+depthClipPosting Nothing p = p
+depthClipPosting (Just d) p@Posting{paccount=a} = p{paccount=clipAccountName d a}
+
+-- XXX confusing, refactor
+
+-- | Convert a list of postings into summary postings. Summary postings
+-- are one per account per interval and aggregated to the specified depth
+-- if any.
+summarisePostingsByInterval :: Interval -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [Posting]
+summarisePostingsByInterval interval depth empty filterspan ps = concatMap summarisespan $ splitSpan interval reportspan
+    where
+      summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)
+      postingsinspan s = filter (isPostingInDateSpan s) ps
+      dataspan = postingsDateSpan ps
+      reportspan | empty = filterspan `orDatesFrom` dataspan
+                 | otherwise = dataspan
+
+-- | Given a date span (representing a reporting interval) and a list of
+-- postings within it: aggregate the postings so there is only one per
+-- account, and adjust their date/description so that they will render
+-- as a summary for this interval.
+--
+-- As usual with date spans the end date is exclusive, but for display
+-- purposes we show the previous day as end date, like ledger.
+--
+-- When a depth argument is present, postings to accounts of greater
+-- depth are aggregated where possible.
+--
+-- The showempty flag includes spans with no postings and also postings
+-- with 0 amount.
+summarisePostingsInDateSpan :: DateSpan -> Maybe Int -> Bool -> [Posting] -> [Posting]
+summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
+    | null ps && (isNothing b || isNothing e) = []
+    | null ps && showempty = [summaryp]
+    | otherwise = summaryps'
+    where
+      summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e'))
+      b' = fromMaybe (maybe nulldate postingDate $ headMay ps) b
+      e' = fromMaybe (maybe (addDays 1 nulldate) postingDate $ lastMay ps) e
+      summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}
+
+      summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps
+      summaryps = [summaryp{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames]
+      anames = sort $ nub $ map paccount ps
+      -- aggregate balances by account, like journalToLedger, then do depth-clipping
+      (_,_,exclbalof,inclbalof) = groupPostings ps
+      clippedanames = nub $ map (clipAccountName d) anames
+      isclipped a = accountNameLevel a >= d
+      d = fromMaybe 99999 $ depth
+      balancetoshowfor a =
+          (if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)
+
+-------------------------------------------------------------------------------
+
+-- | Get a ledger-style register report showing all matched transactions and postings.
+-- Similar to "postingRegisterReport" except it uses matchers and
+-- per-transaction report items like "accountRegisterReport".
+journalRegisterReport :: [Opt] -> Journal -> Matcher -> AccountRegisterReport
+journalRegisterReport _ Journal{jtxns=ts} m = (totallabel, items)
+   where
+     ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts
+     items = reverse $ accountRegisterReportItems m Nothing nullmixedamt id ts'
+     -- XXX items' first element should be the full transaction with all postings
+
+-------------------------------------------------------------------------------
+
+-- | 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,
+--    aggregated if there is more than one other account posting.
+--
+-- 2. With no transaction filtering in effect other than a start date, it
+--    shows the accurate historical running balance for this
+--    account. Otherwise it shows a running total starting at 0 like the posting register report.
+--
+-- 3. Currently this report does not handle reporting intervals.
+--
+-- 4. Report items will be most recent first.
+--
+accountRegisterReport :: [Opt] -> Journal -> Matcher -> Matcher -> AccountRegisterReport
+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) | 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
+     items = reverse $ accountRegisterReportItems m (Just thisacctmatcher) startbal negate ts
+
+-- | Generate account register line items from a list of transactions,
+-- using the provided query and "this account" matchers, starting balance,
+-- sign-setting function and balance-summing function.
+
+-- This is used for both accountRegisterReport and journalRegisterReport,
+-- which makes it a bit overcomplicated.
+accountRegisterReportItems :: Matcher -> Maybe Matcher -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [AccountRegisterReportItem]
+accountRegisterReportItems _ _ _ _ [] = []
+accountRegisterReportItems matcher thisacctmatcher bal signfn (t:ts) =
+    case i of Just i' -> i':is
+              Nothing -> is
+    where
+      tmatched@Transaction{tpostings=psmatched} = filterTransactionPostings matcher t
+      (psthisacct,psotheracct) = case thisacctmatcher of Just m  -> partition (matchesPosting m) psmatched
+                                                         Nothing -> ([],psmatched)
+      numotheraccts = length $ nub $ map paccount psotheracct
+      amt = sum $ map pamount psotheracct
+      acct | isNothing thisacctmatcher = summarisePostings psmatched -- journal register
+           | numotheraccts == 0 = "transfer between " ++ summarisePostingAccounts psthisacct
+           | otherwise          = prefix              ++ summarisePostingAccounts psotheracct
+           where prefix = maybe "" (\b -> if b then "from " else "to ") $ isNegativeMixedAmount amt
+      (i,bal') = case psmatched of
+           [] -> (Nothing,bal)
+           _  -> (Just (t, tmatched, numotheraccts > 1, acct, a, b), b)
+                 where
+                  a = signfn amt
+                  b = bal + a
+      is = accountRegisterReportItems matcher thisacctmatcher bal' signfn ts
+
+-- | Generate a short readable summary of some postings, like
+-- "from (negatives) to (positives)".
+summarisePostings :: [Posting] -> String
+summarisePostings ps =
+    case (summarisePostingAccounts froms, summarisePostingAccounts tos) of
+       ("",t) -> "to "++t
+       (f,"") -> "from "++f
+       (f,t)  -> "from "++f++" to "++t
+    where
+      (froms,tos) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps
+
+-- | Generate a simplified summary of some postings' accounts.
+summarisePostingAccounts :: [Posting] -> String
+summarisePostingAccounts = intercalate ", " . map accountLeafName . nub . map paccount
+
+filterTransactionPostings :: Matcher -> Transaction -> Transaction
+filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}
+
+-------------------------------------------------------------------------------
+
+-- | Get a balance report with the specified options for this journal.
+balanceReport :: [Opt] -> FilterSpec -> Journal -> BalanceReport
+balanceReport opts filterspec j = balanceReport' opts j (journalToLedger filterspec)
+
+-- | Get a balance report with the specified options for this
+-- journal. Like balanceReport but uses the new matchers.
+balanceReport2 :: [Opt] -> Matcher -> Journal -> BalanceReport
+balanceReport2 opts matcher j = balanceReport' opts j (journalToLedger2 matcher)
+
+-- Balance report helper.
+balanceReport' :: [Opt] -> Journal -> (Journal -> Ledger) -> BalanceReport
+balanceReport' opts j jtol = (items, total)
+    where
+      items = map mkitem interestingaccts
+      interestingaccts | NoElide `elem` opts = acctnames
+                       | otherwise = filter (isInteresting opts l) acctnames
+      acctnames = sort $ tail $ flatten $ treemap aname accttree
+      accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l
+      total = sum $ map abalance $ ledgerTopAccounts l
+      l =  jtol $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
+
+      -- | Get data for one balance report line item.
+      mkitem :: AccountName -> BalanceReportItem
+      mkitem a = (a, adisplay, indent, abal)
+          where
+            adisplay | Flat `elem` opts = a
+                     | otherwise = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
+                where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
+            indent | Flat `elem` opts = 0
+                   | otherwise = length interestingparents
+            interestingparents = filter (`elem` interestingaccts) parents
+            parents = parentAccountNames a
+            abal | Flat `elem` opts = exclusiveBalance acct
+                 | otherwise = abalance acct
+                 where acct = ledgerAccount l a
+
+exclusiveBalance :: Account -> MixedAmount
+exclusiveBalance = sumPostings . apostings
+
+-- | Is the named account considered interesting for this ledger's balance report ?
+-- We follow the style of ledger's balance command.
+isInteresting :: [Opt] -> Ledger -> AccountName -> Bool
+isInteresting opts l a | Flat `elem` opts = isInterestingFlat opts l a
+                       | otherwise = isInterestingIndented opts l a
+
+isInterestingFlat :: [Opt] -> Ledger -> AccountName -> Bool
+isInterestingFlat opts l a = notempty || emptyflag
+    where
+      acct = ledgerAccount l a
+      notempty = not $ isZeroMixedAmount $ exclusiveBalance acct
+      emptyflag = Empty `elem` opts
+
+isInterestingIndented :: [Opt] -> Ledger -> AccountName -> Bool
+isInterestingIndented opts l a
+    | numinterestingsubs==1 && not atmaxdepth = notlikesub
+    | otherwise = notzero || emptyflag
+    where
+      atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depthFromOpts opts
+      emptyflag = Empty `elem` opts
+      acct = ledgerAccount l a
+      notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct
+      notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumPostings $ apostings acct
+      numinterestingsubs = length $ filter isInterestingTree subtrees
+          where
+            isInterestingTree = treeany (isInteresting opts l . aname)
+            subtrees = map (fromJust . ledgerAccountTreeAt l) $ ledgerSubAccounts l $ ledgerAccount l a
+
+-------------------------------------------------------------------------------
+
+tests_Hledger_Report :: Test
+tests_Hledger_Report = TestList
+ [
+
+  "summarisePostingsByInterval" ~: do
+    summarisePostingsByInterval (Quarters 1) Nothing False (DateSpan Nothing Nothing) [] ~?= []
+
+  -- ,"summarisePostingsInDateSpan" ~: do
+  --   let gives (b,e,depth,showempty,ps) =
+  --           (summarisePostingsInDateSpan (mkdatespan b e) depth showempty ps `is`)
+  --   let ps =
+  --           [
+  --            nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]}
+  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [dollars 2]}
+  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food",          lpamount=Mixed [dollars 4]}
+  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [dollars 8]}
+  --           ]
+  --   ("2008/01/01","2009/01/01",0,9999,False,[]) `gives`
+  --    []
+  --   ("2008/01/01","2009/01/01",0,9999,True,[]) `gives`
+  --    [
+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"}
+  --    ]
+  --   ("2008/01/01","2009/01/01",0,9999,False,ts) `gives`
+  --    [
+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",          lpamount=Mixed [dollars 4]}
+  --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining",   lpamount=Mixed [dollars 10]}
+  --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]}
+  --    ]
+  --   ("2008/01/01","2009/01/01",0,2,False,ts) `gives`
+  --    [
+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [dollars 15]}
+  --    ]
+  --   ("2008/01/01","2009/01/01",0,1,False,ts) `gives`
+  --    [
+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [dollars 15]}
+  --    ]
+  --   ("2008/01/01","2009/01/01",0,0,False,ts) `gives`
+  --    [
+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [dollars 15]}
+  --    ]
+
+ ]

hledger/Hledger/Cli/Balance.hs

@@ -96,18 +96,13 @@ balance report:
 -}
 
 module Hledger.Cli.Balance (
-  BalanceReport
+  balance
- ,BalanceReportItem
- ,balance
- ,balanceReport
- ,balanceReport2
  ,balanceReportAsText
  ,tests_Hledger_Cli_Balance
- -- ,tests_Balance
 ) where
+
 import Data.List
 import Data.Maybe
-import Data.Tree
 import Test.HUnit
 
 import Hledger.Cli.Format
@@ -120,18 +115,6 @@ import Prelude hiding (putStr)
 import Hledger.Utils.UTF8 (putStr)
 
 
--- | A balance report is a chart of accounts with balances, and their grand total.
-type BalanceReport = ([BalanceReportItem] -- line items, one per account
-                     ,MixedAmount         -- total balance of all accounts
-                     )
-
--- | The data for a single balance report line item, representing one account.
-type BalanceReportItem = (AccountName  -- full account name
-                         ,AccountName  -- account name elided for display: the leaf name,
-                                       -- prefixed by any boring parents immediately above
-                         ,Int          -- how many steps to indent this account (0-based account depth excluding boring parents)
-                         ,MixedAmount) -- account balance, includes subs unless --flat is present
-
 -- | Print a balance report.
 balance :: [Opt] -> [String] -> Journal -> IO ()
 balance opts args j = do
@@ -196,73 +179,6 @@ formatAccount opts accountName depth balance leftJustified min max field = case
     where
       a = maybe "" (accountNameDrop (dropFromOpts opts)) accountName
 
--- | Get a balance report with the specified options for this journal.
-balanceReport :: [Opt] -> FilterSpec -> Journal -> BalanceReport
-balanceReport opts filterspec j = balanceReport' opts j (journalToLedger filterspec)
-
--- | Get a balance report with the specified options for this
--- journal. Like balanceReport but uses the new matchers.
-balanceReport2 :: [Opt] -> Matcher -> Journal -> BalanceReport
-balanceReport2 opts matcher j = balanceReport' opts j (journalToLedger2 matcher)
-
--- Balance report helper.
-balanceReport' :: [Opt] -> Journal -> (Journal -> Ledger) -> BalanceReport
-balanceReport' opts j jtol = (items, total)
-    where
-      items = map mkitem interestingaccts
-      interestingaccts | NoElide `elem` opts = acctnames
-                       | otherwise = filter (isInteresting opts l) acctnames
-      acctnames = sort $ tail $ flatten $ treemap aname accttree
-      accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l
-      total = sum $ map abalance $ ledgerTopAccounts l
-      l =  jtol $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
-
-      -- | Get data for one balance report line item.
-      mkitem :: AccountName -> BalanceReportItem
-      mkitem a = (a, adisplay, indent, abal)
-          where
-            adisplay | Flat `elem` opts = a
-                     | otherwise = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
-                where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
-            indent | Flat `elem` opts = 0
-                   | otherwise = length interestingparents
-            interestingparents = filter (`elem` interestingaccts) parents
-            parents = parentAccountNames a
-            abal | Flat `elem` opts = exclusiveBalance acct
-                 | otherwise = abalance acct
-                 where acct = ledgerAccount l a
-
-exclusiveBalance :: Account -> MixedAmount
-exclusiveBalance = sumPostings . apostings
-
--- | Is the named account considered interesting for this ledger's balance report ?
--- We follow the style of ledger's balance command.
-isInteresting :: [Opt] -> Ledger -> AccountName -> Bool
-isInteresting opts l a | Flat `elem` opts = isInterestingFlat opts l a
-                       | otherwise = isInterestingIndented opts l a
-
-isInterestingFlat :: [Opt] -> Ledger -> AccountName -> Bool
-isInterestingFlat opts l a = notempty || emptyflag
-    where
-      acct = ledgerAccount l a
-      notempty = not $ isZeroMixedAmount $ exclusiveBalance acct
-      emptyflag = Empty `elem` opts
-
-isInterestingIndented :: [Opt] -> Ledger -> AccountName -> Bool
-isInterestingIndented opts l a
-    | numinterestingsubs==1 && not atmaxdepth = notlikesub
-    | otherwise = notzero || emptyflag
-    where
-      atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depthFromOpts opts
-      emptyflag = Empty `elem` opts
-      acct = ledgerAccount l a
-      notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct
-      notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumPostings $ apostings acct
-      numinterestingsubs = length $ filter isInterestingTree subtrees
-          where
-            isInterestingTree = treeany (isInteresting opts l . aname)
-            subtrees = map (fromJust . ledgerAccountTreeAt l) $ ledgerSubAccounts l $ ledgerAccount l a
-
 tests_Hledger_Cli_Balance = TestList
  [
  ]

hledger/Hledger/Cli/Print.hs

@@ -6,27 +6,17 @@ A ledger-compatible @print@ command.
 -}
 
 module Hledger.Cli.Print (
-  JournalReport
+  print'
- ,JournalReportItem
- ,print'
- ,journalReport
  ,showTransactions
 ) where
 import Data.List
-import Data.Ord
 
 import Hledger.Cli.Options
 import Hledger.Cli.Utils
 import Hledger.Data
 import Prelude hiding (putStr)
 import Hledger.Utils.UTF8 (putStr)
-
+import Hledger.Cli.Options
-
--- | A "journal report" is just a list of transactions.
-type JournalReport = [JournalReportItem]
-
--- | The data for a single journal report item, representing one transaction.
-type JournalReportItem = Transaction
 
 -- | Print journal transactions in standard format.
 print' :: [Opt] -> [String] -> Journal -> IO ()
@@ -41,8 +31,3 @@ journalReportAsText :: [Opt] -> FilterSpec -> JournalReport -> String
 journalReportAsText opts _ items = concatMap (showTransactionForPrint effective) items
     where effective = Effective `elem` opts
 
-journalReport :: [Opt] -> FilterSpec -> Journal -> JournalReport
-journalReport opts fspec j = sortBy (comparing tdate) $ jtxns $ filterJournalTransactions fspec j'
-    where
-      j' = journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
-

hledger/Hledger/Cli/Register.hs

@@ -6,29 +6,15 @@ A ledger-compatible @register@ command.
 -}
 
 module Hledger.Cli.Register (
-  PostingRegisterReport
+  register
- ,PostingRegisterReportItem
- ,AccountRegisterReport
- ,AccountRegisterReportItem
- ,register
- ,postingRegisterReport
- ,accountRegisterReport
- ,journalRegisterReport
  ,postingRegisterReportAsText
  ,showPostingWithBalanceForVty
- ,ariDate
- ,ariBalance
  ,tests_Hledger_Cli_Register
 ) where
 
-import Control.Monad
 import Data.List
 import Data.Maybe
-import Data.Ord
-import Data.Time.Calendar
-import Safe (headMay, lastMay)
 import Test.HUnit
-import Text.ParserCombinators.Parsec
 import Text.Printf
 
 import Hledger.Cli.Options
@@ -39,39 +25,6 @@ import Prelude hiding (putStr)
 import Hledger.Utils.UTF8 (putStr)
 
 
--- | A posting register report lists postings to one or more accounts,
--- with a running total. Postings may be actual postings, or aggregate
--- postings corresponding to a reporting interval.
-type PostingRegisterReport = (String                      -- label for the running balance column XXX remove
-                             ,[PostingRegisterReportItem] -- line items, one per posting
-                             )
-
--- | A single posting register line item, representing one posting.
-type PostingRegisterReportItem = (Maybe (Day, String) -- transaction date and description if this is the first posting
-                                 ,Posting             -- the posting
-                                 ,MixedAmount         -- the running total after this posting
-                                 )
-
--- | An account register report lists transactions to a single account (or
--- possibly subs as well), with the accurate running account balance when
--- possible (otherwise, a running total.)
-type AccountRegisterReport = (String                      -- label for the balance column, eg "balance" or "total"
-                             ,[AccountRegisterReportItem] -- line items, one per transaction
-                             )
-
--- | 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
-                                 )
-
-ariDate (t,_,_,_,_,_) = tdate t
-ariBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"
-                                           (Amount{quantity=q}):_ -> show q
-
 -- | Print a (posting) register report.
 register :: [Opt] -> [String] -> Journal -> IO ()
 register opts args j = do
@@ -104,278 +57,11 @@ postingRegisterReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr,
       pstr = showPostingForRegister p
       bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b)
 
-showPostingWithBalanceForVty showtxninfo p b = postingRegisterReportItemAsText [] $ mkitem showtxninfo p b
+-- XXX
-
+showPostingWithBalanceForVty showtxninfo p b = postingRegisterReportItemAsText [] $ mkpostingRegisterItem showtxninfo p b
-totallabel = "Total"
-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 (+))
-    where
-      ps | interval == NoInterval = displayableps
-         | otherwise              = summarisePostingsByInterval interval depth empty filterspan displayableps
-      (precedingps, displayableps, _) = postingsMatchingDisplayExpr (displayExprFromOpts opts)
-                                        $ depthClipPostings depth
-                                        $ journalPostings
-                                        $ filterJournalPostings fspec{depth=Nothing}
-                                        $ journalSelectingDateFromOpts opts
-                                        $ journalSelectingAmountFromOpts opts
-                                        j
-      startbal = sumPostings precedingps
-      filterspan = datespan fspec
-      (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts)
-
--- | Generate posting register report line items.
-postingRegisterItems :: [Posting] -> Posting -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingRegisterReportItem]
-postingRegisterItems [] _ _ _ = []
-postingRegisterItems (p:ps) pprev b sumfn = i:(postingRegisterItems ps p b' sumfn)
-    where
-      i = mkitem isfirst p b'
-      isfirst = ptransaction p /= ptransaction pprev
-      b' = b `sumfn` pamount p
-
--- | Generate one register report line item, from a flag indicating
--- whether to include transaction info, a posting, and the current running
--- balance.
-mkitem :: Bool -> Posting -> MixedAmount -> PostingRegisterReportItem
-mkitem False p b = (Nothing, p, b)
-mkitem True p b = (ds, p, b)
-    where ds = case ptransaction p of Just (Transaction{tdate=da,tdescription=de}) -> Just (da,de)
-                                      Nothing -> Just (nulldate,"")
-
--- | Date-sort and split a list of postings into three spans - postings matched
--- by the given display expression, and the preceding and following postings.
-postingsMatchingDisplayExpr :: Maybe String -> [Posting] -> ([Posting],[Posting],[Posting])
-postingsMatchingDisplayExpr d ps = (before, matched, after)
-    where 
-      sorted = sortBy (comparing postingDate) ps
-      (before, rest) = break (displayExprMatches d) sorted
-      (matched, after) = span (displayExprMatches d) rest
-
--- | Does this display expression allow this posting to be displayed ?
--- Raises an error if the display expression can't be parsed.
-displayExprMatches :: Maybe String -> Posting -> Bool
-displayExprMatches Nothing  _ = True
-displayExprMatches (Just d) p = (fromparse $ parsewith datedisplayexpr d) p
-                        
--- | Parse a hledger display expression, which is a simple date test like
--- "d>[DATE]" or "d<=[DATE]", and return a "Posting"-matching predicate.
-datedisplayexpr :: GenParser Char st (Posting -> Bool)
-datedisplayexpr = do
-  char 'd'
-  op <- compareop
-  char '['
-  (y,m,d) <- smartdate
-  char ']'
-  let date    = parsedate $ printf "%04s/%02s/%02s" y m d
-      test op = return $ (`op` date) . postingDate
-  case op of
-    "<"  -> test (<)
-    "<=" -> test (<=)
-    "="  -> test (==)
-    "==" -> test (==)
-    ">=" -> test (>=)
-    ">"  -> test (>)
-    _    -> mzero
- where
-  compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]
-
--- | Get a ledger-style register report showing all matched transactions and postings.
--- Similar to "postingRegisterReport" except it uses matchers and
--- per-transaction report items like "accountRegisterReport".
-journalRegisterReport :: [Opt] -> Journal -> Matcher -> AccountRegisterReport
-journalRegisterReport _ Journal{jtxns=ts} m = (totallabel, items)
-   where
-     ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts
-     items = reverse $ accountRegisterReportItems m Nothing nullmixedamt id ts'
-     -- XXX items' first element should be the full transaction with all postings
-
--- | 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,
---    aggregated if there is more than one other account posting.
---
--- 2. With no transaction filtering in effect other than a start date, it
---    shows the accurate historical running balance for this
---    account. Otherwise it shows a running total starting at 0 like the posting register report.
---
--- 3. Currently this report does not handle reporting intervals.
---
--- 4. Report items will be most recent first.
---
-accountRegisterReport :: [Opt] -> Journal -> Matcher -> Matcher -> AccountRegisterReport
-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) | 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
-     items = reverse $ accountRegisterReportItems m (Just thisacctmatcher) startbal negate ts
-
--- | Generate account register line items from a list of transactions,
--- using the provided query and "this account" matchers, starting balance,
--- sign-setting function and balance-summing function.
-
--- This is used for both accountRegisterReport and journalRegisterReport,
--- which makes it a bit overcomplicated.
-accountRegisterReportItems :: Matcher -> Maybe Matcher -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [AccountRegisterReportItem]
-accountRegisterReportItems _ _ _ _ [] = []
-accountRegisterReportItems matcher thisacctmatcher bal signfn (t:ts) =
-    case i of Just i' -> i':is
-              Nothing -> is
-    where
-      tmatched@Transaction{tpostings=psmatched} = filterTransactionPostings matcher t
-      (psthisacct,psotheracct) = case thisacctmatcher of Just m  -> partition (matchesPosting m) psmatched
-                                                         Nothing -> ([],psmatched)
-      numotheraccts = length $ nub $ map paccount psotheracct
-      amt = sum $ map pamount psotheracct
-      acct | isNothing thisacctmatcher = summarisePostings psmatched -- journal register
-           | numotheraccts == 0 = "transfer between " ++ summarisePostingAccounts psthisacct
-           | otherwise          = prefix              ++ summarisePostingAccounts psotheracct
-           where prefix = maybe "" (\b -> if b then "from " else "to ") $ isNegativeMixedAmount amt
-      (i,bal') = case psmatched of
-           [] -> (Nothing,bal)
-           _  -> (Just (t, tmatched, numotheraccts > 1, acct, a, b), b)
-                 where
-                  a = signfn amt
-                  b = bal + a
-      is = accountRegisterReportItems matcher thisacctmatcher bal' signfn ts
-
--- | Generate a short readable summary of some postings, like
--- "from (negatives) to (positives)".
-summarisePostings :: [Posting] -> String
-summarisePostings ps =
-    case (summarisePostingAccounts froms, summarisePostingAccounts tos) of
-       ("",t) -> "to "++t
-       (f,"") -> "from "++f
-       (f,t)  -> "from "++f++" to "++t
-    where
-      (froms,tos) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps
-
--- | Generate a simplified summary of some postings' accounts.
-summarisePostingAccounts :: [Posting] -> String
-summarisePostingAccounts = intercalate ", " . map accountLeafName . nub . map paccount
-
-filterTransactionPostings :: Matcher -> Transaction -> Transaction
-filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}
-
--- XXX confusing, refactor
-
--- | Convert a list of postings into summary postings. Summary postings
--- are one per account per interval and aggregated to the specified depth
--- if any.
-summarisePostingsByInterval :: Interval -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [Posting]
-summarisePostingsByInterval interval depth empty filterspan ps = concatMap summarisespan $ splitSpan interval reportspan
-    where
-      summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)
-      postingsinspan s = filter (isPostingInDateSpan s) ps
-      dataspan = postingsDateSpan ps
-      reportspan | empty = filterspan `orDatesFrom` dataspan
-                 | otherwise = dataspan
-
--- | Given a date span (representing a reporting interval) and a list of
--- postings within it: aggregate the postings so there is only one per
--- account, and adjust their date/description so that they will render
--- as a summary for this interval.
--- 
--- As usual with date spans the end date is exclusive, but for display
--- purposes we show the previous day as end date, like ledger.
--- 
--- When a depth argument is present, postings to accounts of greater
--- depth are aggregated where possible.
--- 
--- The showempty flag includes spans with no postings and also postings
--- with 0 amount.
-summarisePostingsInDateSpan :: DateSpan -> Maybe Int -> Bool -> [Posting] -> [Posting]
-summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
-    | null ps && (isNothing b || isNothing e) = []
-    | null ps && showempty = [summaryp]
-    | otherwise = summaryps'
-    where
-      summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e'))
-      b' = fromMaybe (maybe nulldate postingDate $ headMay ps) b
-      e' = fromMaybe (maybe (addDays 1 nulldate) postingDate $ lastMay ps) e
-      summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}
-
-      summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps
-      summaryps = [summaryp{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames]
-      anames = sort $ nub $ map paccount ps
-      -- aggregate balances by account, like journalToLedger, then do depth-clipping
-      (_,_,exclbalof,inclbalof) = groupPostings ps
-      clippedanames = nub $ map (clipAccountName d) anames
-      isclipped a = accountNameLevel a >= d
-      d = fromMaybe 99999 $ depth
-      balancetoshowfor a =
-          (if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)
-
--- | Clip the account names to the specified depth in a list of postings.
-depthClipPostings :: Maybe Int -> [Posting] -> [Posting]
-depthClipPostings depth = map (depthClipPosting depth)
-
--- | Clip a posting's account name to the specified depth.
-depthClipPosting :: Maybe Int -> Posting -> Posting
-depthClipPosting Nothing p = p
-depthClipPosting (Just d) p@Posting{paccount=a} = p{paccount=clipAccountName d a}
-
 
 tests_Hledger_Cli_Register :: Test
 tests_Hledger_Cli_Register = TestList
  [
 
-  "summarisePostingsByInterval" ~: do
-    summarisePostingsByInterval (Quarters 1) Nothing False (DateSpan Nothing Nothing) [] ~?= []
-
-  -- ,"summarisePostingsInDateSpan" ~: do
-  --   let gives (b,e,depth,showempty,ps) =
-  --           (summarisePostingsInDateSpan (mkdatespan b e) depth showempty ps `is`)
-  --   let ps =
-  --           [
-  --            nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]}
-  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [dollars 2]}
-  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food",          lpamount=Mixed [dollars 4]}
-  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [dollars 8]}
-  --           ]
-  --   ("2008/01/01","2009/01/01",0,9999,False,[]) `gives` 
-  --    []
-  --   ("2008/01/01","2009/01/01",0,9999,True,[]) `gives` 
-  --    [
-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"}
-  --    ]
-  --   ("2008/01/01","2009/01/01",0,9999,False,ts) `gives` 
-  --    [
-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",          lpamount=Mixed [dollars 4]}
-  --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining",   lpamount=Mixed [dollars 10]}
-  --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]}
-  --    ]
-  --   ("2008/01/01","2009/01/01",0,2,False,ts) `gives` 
-  --    [
-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [dollars 15]}
-  --    ]
-  --   ("2008/01/01","2009/01/01",0,1,False,ts) `gives` 
-  --    [
-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [dollars 15]}
-  --    ]
-  --   ("2008/01/01","2009/01/01",0,0,False,ts) `gives` 
-  --    [
-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [dollars 15]}
-  --    ]
-
  ]