From df7dc1464e9facad68db06075dbae9083bbb8bd9 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 17 Jul 2011 23:47:52 +0000 Subject: [PATCH] refactor: move basic report generation to hledger-lib --- hledger-lib/Hledger.hs | 1 + hledger-lib/Hledger/Report.hs | 448 ++++++++++++++++++++++++++++++++ hledger/Hledger/Cli/Balance.hs | 88 +------ hledger/Hledger/Cli/Print.hs | 19 +- hledger/Hledger/Cli/Register.hs | 320 +---------------------- 5 files changed, 456 insertions(+), 420 deletions(-) create mode 100644 hledger-lib/Hledger/Report.hs diff --git a/hledger-lib/Hledger.hs b/hledger-lib/Hledger.hs index 7d6e1a81e..757d35324 100644 --- a/hledger-lib/Hledger.hs +++ b/hledger-lib/Hledger.hs @@ -1,6 +1,7 @@ module Hledger ( module Hledger.Data ,module Hledger.Read + ,module Hledger.Report ,module Hledger.Utils ) where diff --git a/hledger-lib/Hledger/Report.hs b/hledger-lib/Hledger/Report.hs new file mode 100644 index 000000000..440c367a2 --- /dev/null +++ b/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]} + -- ] + + ] diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index 0dfcfe9e7..7aeed8ec0 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -96,18 +96,13 @@ balance report: -} module Hledger.Cli.Balance ( - BalanceReport - ,BalanceReportItem - ,balance - ,balanceReport - ,balanceReport2 + balance ,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 [ ] diff --git a/hledger/Hledger/Cli/Print.hs b/hledger/Hledger/Cli/Print.hs index 00847f24c..9bdff7290 100644 --- a/hledger/Hledger/Cli/Print.hs +++ b/hledger/Hledger/Cli/Print.hs @@ -6,27 +6,17 @@ A ledger-compatible @print@ command. -} module Hledger.Cli.Print ( - JournalReport - ,JournalReportItem - ,print' - ,journalReport + print' ,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) - - --- | 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 +import Hledger.Cli.Options -- | 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 - diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index c0480dfe0..ef95faf4b 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -6,29 +6,15 @@ A ledger-compatible @register@ command. -} module Hledger.Cli.Register ( - PostingRegisterReport - ,PostingRegisterReportItem - ,AccountRegisterReport - ,AccountRegisterReportItem - ,register - ,postingRegisterReport - ,accountRegisterReport - ,journalRegisterReport + register ,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 - -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} - +-- XXX +showPostingWithBalanceForVty showtxninfo p b = postingRegisterReportItemAsText [] $ mkpostingRegisterItem showtxninfo p b 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]} - -- ] - ]