1035 lines
		
	
	
		
			46 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
			
		
		
	
	
			1035 lines
		
	
	
		
			46 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
| {-# LANGUAGE RecordWildCards #-}
 | |
| {-|
 | |
| 
 | |
| Generate several common kinds of report from a journal, as \"*Report\" -
 | |
| simple intermediate data structures intended to be easily rendered as
 | |
| text, html, json, csv etc. by hledger commands, hamlet templates,
 | |
| javascript, or whatever. This is under Hledger.Cli since it depends
 | |
| on the command-line options, should move to hledger-lib later.
 | |
| 
 | |
| -}
 | |
| 
 | |
| module Hledger.Reports (
 | |
|   ReportOpts(..),
 | |
|   DisplayExp,
 | |
|   FormatStr,
 | |
|   defreportopts,
 | |
|   dateSpanFromOpts,
 | |
|   intervalFromOpts,
 | |
|   clearedValueFromOpts,
 | |
|   whichDateFromOpts,
 | |
|   journalSelectingAmountFromOpts,
 | |
|   queryFromOpts,
 | |
|   queryOptsFromOpts,
 | |
|   -- * Entries report
 | |
|   EntriesReport,
 | |
|   EntriesReportItem,
 | |
|   entriesReport,
 | |
|   -- * Postings report
 | |
|   PostingsReport,
 | |
|   PostingsReportItem,
 | |
|   postingsReport,
 | |
|   mkpostingsReportItem, -- XXX for showPostingWithBalanceForVty in Hledger.Cli.Register
 | |
|   -- * Transactions report
 | |
|   TransactionsReport,
 | |
|   TransactionsReportItem,
 | |
|   triDate,
 | |
|   triBalance,
 | |
|   journalTransactionsReport,
 | |
|   accountTransactionsReport,
 | |
|   -- * Accounts report
 | |
|   AccountsReport,
 | |
|   AccountsReportItem,
 | |
|   accountsReport,
 | |
|   -- * Other "reports"
 | |
|   accountBalanceHistory,
 | |
|   -- * Tests
 | |
|   tests_Hledger_Reports
 | |
| )
 | |
| where
 | |
| 
 | |
| import Control.Monad
 | |
| import Data.List
 | |
| import Data.Maybe
 | |
| -- import qualified Data.Map as M
 | |
| import Data.Ord
 | |
| import Data.Time.Calendar
 | |
| -- import Data.Tree
 | |
| import Safe (headMay, lastMay)
 | |
| import System.Console.CmdArgs  -- for defaults support
 | |
| import Test.HUnit
 | |
| import Text.ParserCombinators.Parsec
 | |
| import Text.Printf
 | |
| 
 | |
| import Hledger.Data
 | |
| import Hledger.Read (mamountp')
 | |
| import Hledger.Query
 | |
| import Hledger.Utils
 | |
| 
 | |
| -- | Standard options for customising report filtering and output,
 | |
| -- corresponding to hledger's command-line options and query language
 | |
| -- arguments. Used in hledger-lib and above.
 | |
| data ReportOpts = ReportOpts {
 | |
|      begin_          :: Maybe Day
 | |
|     ,end_            :: Maybe Day
 | |
|     ,period_         :: Maybe (Interval,DateSpan)
 | |
|     ,cleared_        :: Bool
 | |
|     ,uncleared_      :: Bool
 | |
|     ,cost_           :: Bool
 | |
|     ,depth_          :: Maybe Int
 | |
|     ,display_        :: Maybe DisplayExp
 | |
|     ,effective_      :: Bool
 | |
|     ,empty_          :: Bool
 | |
|     ,no_elide_       :: Bool
 | |
|     ,real_           :: Bool
 | |
|     ,flat_           :: Bool -- for balance command
 | |
|     ,drop_           :: Int  -- "
 | |
|     ,no_total_       :: Bool -- "
 | |
|     ,daily_          :: Bool
 | |
|     ,weekly_         :: Bool
 | |
|     ,monthly_        :: Bool
 | |
|     ,quarterly_      :: Bool
 | |
|     ,yearly_         :: Bool
 | |
|     ,format_         :: Maybe FormatStr
 | |
|     ,query_          :: String -- all arguments, as a string
 | |
|  } deriving (Show)
 | |
| 
 | |
| type DisplayExp = String
 | |
| type FormatStr = String
 | |
| 
 | |
| defreportopts = ReportOpts
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
|     def
 | |
| 
 | |
| instance Default ReportOpts where def = defreportopts
 | |
| 
 | |
| -- | Figure out the date span we should report on, based on any
 | |
| -- begin/end/period options provided. A period option will cause begin and
 | |
| -- end options to be ignored.
 | |
| dateSpanFromOpts :: Day -> ReportOpts -> DateSpan
 | |
| dateSpanFromOpts _ ReportOpts{..} =
 | |
|     case period_ of Just (_,span) -> span
 | |
|                     Nothing -> DateSpan begin_ end_
 | |
| 
 | |
| -- | Figure out the reporting interval, if any, specified by the options.
 | |
| -- --period overrides --daily overrides --weekly overrides --monthly etc.
 | |
| intervalFromOpts :: ReportOpts -> Interval
 | |
| intervalFromOpts ReportOpts{..} =
 | |
|     case period_ of
 | |
|       Just (interval,_) -> interval
 | |
|       Nothing -> i
 | |
|           where i | daily_ = Days 1
 | |
|                   | weekly_ = Weeks 1
 | |
|                   | monthly_ = Months 1
 | |
|                   | quarterly_ = Quarters 1
 | |
|                   | yearly_ = Years 1
 | |
|                   | otherwise =  NoInterval
 | |
| 
 | |
| -- | Get a maybe boolean representing the last cleared/uncleared option if any.
 | |
| clearedValueFromOpts :: ReportOpts -> Maybe Bool
 | |
| clearedValueFromOpts ReportOpts{..} | cleared_   = Just True
 | |
|                                     | uncleared_ = Just False
 | |
|                                     | otherwise  = Nothing
 | |
| 
 | |
| -- depthFromOpts :: ReportOpts -> Int
 | |
| -- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)
 | |
| 
 | |
| -- | Report which date we will report on based on --effective.
 | |
| whichDateFromOpts :: ReportOpts -> WhichDate
 | |
| whichDateFromOpts ReportOpts{..} = if effective_ then EffectiveDate else ActualDate
 | |
| 
 | |
| -- | Select a Transaction date accessor based on --effective.
 | |
| transactionDateFn :: ReportOpts -> (Transaction -> Day)
 | |
| transactionDateFn ReportOpts{..} = if effective_ then transactionEffectiveDate else transactionActualDate
 | |
| 
 | |
| -- | Convert this journal's postings' amounts to the cost basis amounts if
 | |
| -- specified by options.
 | |
| journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
 | |
| journalSelectingAmountFromOpts opts
 | |
|     | cost_ opts = journalConvertAmountsToCost
 | |
|     | otherwise = id
 | |
| 
 | |
| -- | Convert report options and arguments to a query.
 | |
| queryFromOpts :: Day -> ReportOpts -> Query
 | |
| queryFromOpts d opts@ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq]
 | |
|   where
 | |
|     flagsq = And $
 | |
|               [(if effective_ then EDate else Date) $ dateSpanFromOpts d opts]
 | |
|               ++ (if real_ then [Real True] else [])
 | |
|               ++ (if empty_ then [Empty True] else []) -- ?
 | |
|               ++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts))
 | |
|               ++ (maybe [] ((:[]) . Depth) depth_)
 | |
|     argsq = fst $ parseQuery d query_
 | |
| 
 | |
| tests_queryFromOpts = [
 | |
|  "queryFromOpts" ~: do
 | |
|   assertEqual "" Any (queryFromOpts nulldate defreportopts)
 | |
|   assertEqual "" (Acct "a") (queryFromOpts nulldate defreportopts{query_="a"})
 | |
|   assertEqual "" (Desc "a a") (queryFromOpts nulldate defreportopts{query_="desc:'a a'"})
 | |
|   assertEqual "" (Date $ mkdatespan "2012/01/01" "2013/01/01")
 | |
|                  (queryFromOpts nulldate defreportopts{begin_=Just (parsedate "2012/01/01")
 | |
|                                                       ,query_="date:'to 2013'"
 | |
|                                                       })
 | |
|   assertEqual "" (EDate $ mkdatespan "2012/01/01" "2013/01/01")
 | |
|                  (queryFromOpts nulldate defreportopts{query_="edate:'in 2012'"})
 | |
|   assertEqual "" (Or [Acct "a a", Acct "'b"])
 | |
|                  (queryFromOpts nulldate defreportopts{query_="'a a' 'b"})
 | |
|  ]
 | |
| 
 | |
| -- | Convert report options and arguments to query options.
 | |
| queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]
 | |
| queryOptsFromOpts d ReportOpts{..} = flagsqopts ++ argsqopts
 | |
|   where
 | |
|     flagsqopts = []
 | |
|     argsqopts = snd $ parseQuery d query_
 | |
| 
 | |
| tests_queryOptsFromOpts = [
 | |
|  "queryOptsFromOpts" ~: do
 | |
|   assertEqual "" [] (queryOptsFromOpts nulldate defreportopts)
 | |
|   assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{query_="a"})
 | |
|   assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{begin_=Just (parsedate "2012/01/01")
 | |
|                                                              ,query_="date:'to 2013'"
 | |
|                                                              })
 | |
|  ]
 | |
| 
 | |
| -------------------------------------------------------------------------------
 | |
| 
 | |
| -- | A journal entries report is a list of whole transactions as
 | |
| -- originally entered in the journal (mostly). Used by eg hledger's print
 | |
| -- command and hledger-web's journal entries view.
 | |
| type EntriesReport = [EntriesReportItem]
 | |
| type EntriesReportItem = Transaction
 | |
| 
 | |
| -- | Select transactions for an entries report.
 | |
| entriesReport :: ReportOpts -> Query -> Journal -> EntriesReport
 | |
| entriesReport opts q j =
 | |
|   sortBy (comparing date) $ filter (q `matchesTransaction`) ts
 | |
|     where
 | |
|       date = transactionDateFn opts
 | |
|       ts = jtxns $ journalSelectingAmountFromOpts opts j
 | |
| 
 | |
| tests_entriesReport = [
 | |
|   "entriesReport" ~: do
 | |
|     assertEqual "not acct" 1 (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal)
 | |
|     let span = mkdatespan "2008/06/01" "2008/07/01"
 | |
|     assertEqual "date" 3 (length $ entriesReport defreportopts (Date $ span) samplejournal)
 | |
|  ]
 | |
| 
 | |
| -------------------------------------------------------------------------------
 | |
| 
 | |
| -- | A postings report is a list of postings with a running total, a label
 | |
| -- for the total field, and a little extra transaction info to help with rendering.
 | |
| type PostingsReport = (String               -- label for the running balance column XXX remove
 | |
|                       ,[PostingsReportItem] -- line items, one per posting
 | |
|                       )
 | |
| type PostingsReportItem = (Maybe (Day, String) -- posting date and description if this is the first posting
 | |
|                           ,Posting             -- the posting, possibly with account name depth-clipped
 | |
|                           ,MixedAmount         -- the running total after this posting
 | |
|                           )
 | |
| 
 | |
| -- | Select postings from the journal and add running balance and other
 | |
| -- information to make a postings report. Used by eg hledger's register command.
 | |
| postingsReport :: ReportOpts -> Query -> Journal -> PostingsReport
 | |
| postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $
 | |
|                           (totallabel, postingsReportItems ps nullposting wd depth startbal (+))
 | |
|     where
 | |
|       ps | interval == NoInterval = displayableps
 | |
|          | otherwise              = summarisePostingsByInterval interval depth empty reportspan displayableps
 | |
|       j' = journalSelectingAmountFromOpts opts j
 | |
|       wd = whichDateFromOpts opts
 | |
|       -- delay depth filtering until the end
 | |
|       (depth, q') = (queryDepth q, filterQuery (not . queryIsDepth) q)
 | |
|       (precedingps, displayableps, _) =   dbg "ps3" $ postingsMatchingDisplayExpr (display_ opts)
 | |
|                                         $ dbg "ps2" $ filter (q' `matchesPosting`)
 | |
|                                         $ dbg "ps1" $ journalPostings j'
 | |
|       dbg :: Show a => String -> a -> a
 | |
|       dbg = flip const
 | |
|       -- dbg = lstrace
 | |
| 
 | |
|       empty = queryEmpty q
 | |
|       displayexpr = display_ opts  -- XXX
 | |
|       interval = intervalFromOpts opts -- XXX
 | |
|       journalspan = journalDateSpan j'
 | |
|       -- requestedspan should be the intersection of any span specified
 | |
|       -- with period options and any span specified with display option.
 | |
|       -- The latter is not easily available, fake it for now.
 | |
|       requestedspan = periodspan `spanIntersect` displayspan
 | |
|       periodspan = queryDateSpan effectivedate q
 | |
|       effectivedate = whichDateFromOpts opts == EffectiveDate
 | |
|       displayspan = postingsDateSpan ps
 | |
|           where (_,ps,_) = postingsMatchingDisplayExpr displayexpr $ journalPostings j'
 | |
|       matchedspan = postingsDateSpan displayableps
 | |
|       reportspan | empty     = requestedspan `orDatesFrom` journalspan
 | |
|                  | otherwise = requestedspan `spanIntersect` matchedspan
 | |
|       startbal = sumPostings precedingps
 | |
| 
 | |
| totallabel = "Total"
 | |
| balancelabel = "Balance"
 | |
| 
 | |
| -- | Generate postings report line items.
 | |
| postingsReportItems :: [Posting] -> Posting -> WhichDate -> Int -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingsReportItem]
 | |
| postingsReportItems [] _ _ _ _ _ = []
 | |
| postingsReportItems (p:ps) pprev wd d b sumfn = i:(postingsReportItems ps p wd d b' sumfn)
 | |
|     where
 | |
|       i = mkpostingsReportItem isfirstintxn wd p' b'
 | |
|       p' = p{paccount=clipAccountName d $ paccount p}
 | |
|       isfirstintxn = ptransaction p /= ptransaction pprev
 | |
|       b' = b `sumfn` pamount p
 | |
| 
 | |
| -- | Generate one postings report line item, given a flag indicating
 | |
| -- whether to include transaction info, the posting, and the current
 | |
| -- running balance.
 | |
| mkpostingsReportItem :: Bool -> WhichDate -> Posting -> MixedAmount -> PostingsReportItem
 | |
| mkpostingsReportItem False _ p b = (Nothing, p, b)
 | |
| mkpostingsReportItem True wd p b = (Just (date,desc), p, b)
 | |
|     where
 | |
|       date = case wd of ActualDate    -> postingDate p
 | |
|                         EffectiveDate -> postingEffectiveDate p
 | |
|       desc = maybe "" tdescription $ ptransaction p
 | |
| 
 | |
| -- | Date-sort and split a list of postings into three spans - postings matched
 | |
| -- by the given display expression, and the preceding and following postings.
 | |
| -- XXX always sorts by primary date, should sort by effective date if expression is about that
 | |
| 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 -> Int -> Bool -> DateSpan -> [Posting] -> [Posting]
 | |
| summarisePostingsByInterval interval depth empty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan
 | |
|     where
 | |
|       summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)
 | |
|       postingsinspan s = filter (isPostingInDateSpan s) ps
 | |
| 
 | |
| tests_summarisePostingsByInterval = [
 | |
|   "summarisePostingsByInterval" ~: do
 | |
|     summarisePostingsByInterval (Quarters 1) 99999 False (DateSpan Nothing Nothing) [] ~?= []
 | |
|  ]
 | |
| 
 | |
| -- | 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 -> 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=balance a} | a <- clippedanames]
 | |
|       clippedanames = nub $ map (clipAccountName depth) anames
 | |
|       anames = sort $ nub $ map paccount ps
 | |
|       -- aggregate balances by account, like ledgerFromJournal, then do depth-clipping
 | |
|       accts = accountsFromPostings ps
 | |
|       balance a = maybe nullmixedamt bal $ lookupAccount a accts 
 | |
|         where
 | |
|           bal = if isclipped a then aibalance else aebalance
 | |
|           isclipped a = accountNameLevel a >= depth
 | |
| 
 | |
| -------------------------------------------------------------------------------
 | |
| 
 | |
| -- | A transactions report includes a list of transactions
 | |
| -- (posting-filtered and unfiltered variants), a running balance, and some
 | |
| -- other information helpful for rendering a register view (a flag
 | |
| -- indicating multiple other accounts and a display string describing
 | |
| -- them) with or without a notion of current account(s).
 | |
| type TransactionsReport = (String                   -- label for the balance column, eg "balance" or "total"
 | |
|                           ,[TransactionsReportItem] -- line items, one per transaction
 | |
|                           )
 | |
| type TransactionsReportItem = (Transaction -- the corresponding transaction
 | |
|                               ,Transaction -- the transaction with postings to the current account(s) removed
 | |
|                               ,Bool        -- is this a split, ie more than one other account posting
 | |
|                               ,String      -- a display string describing the other account(s), if any
 | |
|                               ,MixedAmount -- the amount posted to the current account(s) (or total amount posted)
 | |
|                               ,MixedAmount -- the running balance for the current account(s) after this transaction
 | |
|                               )
 | |
| 
 | |
| triDate (t,_,_,_,_,_) = tdate t
 | |
| triBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"
 | |
|                                            (Amount{aquantity=q}):_ -> show q
 | |
| 
 | |
| -- | Select transactions from the whole journal for a transactions report,
 | |
| -- with no \"current\" account. The end result is similar to
 | |
| -- "postingsReport" except it uses queries and transaction-based report
 | |
| -- items and the items are most recent first. Used by eg hledger-web's
 | |
| -- journal view.
 | |
| journalTransactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport
 | |
| journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items)
 | |
|    where
 | |
|      ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts
 | |
|      items = reverse $ accountTransactionsReportItems m Nothing nullmixedamt id ts'
 | |
|      -- XXX items' first element should be the full transaction with all postings
 | |
| 
 | |
| -------------------------------------------------------------------------------
 | |
| 
 | |
| -- | Select transactions within one or more \"current\" accounts, and make a
 | |
| -- transactions report relative to those account(s). This means:
 | |
| --
 | |
| -- 1. it shows transactions from the point of view of the current account(s).
 | |
| --    The transaction amount is the amount posted to the current account(s).
 | |
| --    The other accounts' names are provided. 
 | |
| --
 | |
| -- 2. With no transaction filtering in effect other than a start date, it
 | |
| --    shows the accurate historical running balance for the current account(s).
 | |
| --    Otherwise it shows a running total starting at 0.
 | |
| --
 | |
| -- Currently, reporting intervals are not supported, and report items are
 | |
| -- most recent first. Used by eg hledger-web's account register view.
 | |
| --
 | |
| accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> TransactionsReport
 | |
| accountTransactionsReport opts j m thisacctquery = (label, items)
 | |
|  where
 | |
|      -- transactions affecting this account, in date order
 | |
|      ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctquery) $ jtxns $
 | |
|           journalSelectingAmountFromOpts opts 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) | queryIsNull m                           = (nullmixedamt,        balancelabel)
 | |
|                       | queryIsStartDateOnly (effective_ opts) m = (sumPostings priorps, balancelabel)
 | |
|                       | otherwise                                 = (nullmixedamt,        totallabel)
 | |
|                       where
 | |
|                         priorps = -- ltrace "priorps" $
 | |
|                                   filter (matchesPosting
 | |
|                                           (-- ltrace "priormatcher" $
 | |
|                                            And [thisacctquery, tostartdatequery]))
 | |
|                                          $ transactionsPostings ts
 | |
|                         tostartdatequery = Date (DateSpan Nothing startdate)
 | |
|                         startdate = queryStartDate (effective_ opts) m
 | |
|      items = reverse $ accountTransactionsReportItems m (Just thisacctquery) startbal negate ts
 | |
| 
 | |
| -- | Generate transactions report items from a list of transactions,
 | |
| -- using the provided query and current account queries, starting balance,
 | |
| -- sign-setting function and balance-summing function.
 | |
| accountTransactionsReportItems :: Query -> Maybe Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [TransactionsReportItem]
 | |
| accountTransactionsReportItems _ _ _ _ [] = []
 | |
| accountTransactionsReportItems query thisacctquery bal signfn (t:ts) =
 | |
|     -- This is used for both accountTransactionsReport and journalTransactionsReport,
 | |
|     -- which makes it a bit overcomplicated
 | |
|     case i of Just i' -> i':is
 | |
|               Nothing -> is
 | |
|     where
 | |
|       tmatched@Transaction{tpostings=psmatched} = filterTransactionPostings query t
 | |
|       (psthisacct,psotheracct) = case thisacctquery of Just m  -> partition (matchesPosting m) psmatched
 | |
|                                                        Nothing -> ([],psmatched)
 | |
|       numotheraccts = length $ nub $ map paccount psotheracct
 | |
|       amt = negate $ sum $ map pamount psthisacct
 | |
|       acct | isNothing thisacctquery = 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 = accountTransactionsReportItems query thisacctquery 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 :: Query -> Transaction -> Transaction
 | |
| filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}
 | |
| 
 | |
| -------------------------------------------------------------------------------
 | |
| 
 | |
| -- | An accounts report is a list of account names (full and short
 | |
| -- variants) with their balances, appropriate indentation for rendering as
 | |
| -- a hierarchy, and grand total.
 | |
| type AccountsReport = ([AccountsReportItem] -- line items, one per account
 | |
|                       ,MixedAmount          -- total balance of all accounts
 | |
|                       )
 | |
| type AccountsReportItem = (AccountName  -- full account name
 | |
|                           ,AccountName  -- short account name for display (the leaf name, prefixed by any boring parents immediately above)
 | |
|                           ,Int          -- how many steps to indent this account (0 with --flat, otherwise the 0-based account depth excluding boring parents)
 | |
|                           ,MixedAmount) -- account balance, includes subs unless --flat is present
 | |
| 
 | |
| -- | Select accounts, and get their balances at the end of the selected
 | |
| -- period, and misc. display information, for an accounts report.
 | |
| accountsReport :: ReportOpts -> Query -> Journal -> AccountsReport
 | |
| accountsReport opts q j = (items, total)
 | |
|     where
 | |
|       l =  ledgerFromJournal q $ journalSelectingAmountFromOpts opts j
 | |
|       accts = clipAccounts (queryDepth q) $ ledgerRootAccount l
 | |
|       accts'
 | |
|           | flat_ opts = filterzeros $ tail $ flattenAccounts accts
 | |
|           | otherwise  = filter (not.aboring) $ tail $ flattenAccounts $ markboring $ prunezeros accts
 | |
|           where
 | |
|             filterzeros | empty_ opts = id
 | |
|                         | otherwise = filter (not . isZeroMixedAmount . aebalance)
 | |
|             prunezeros | empty_ opts = id
 | |
|                        | otherwise   = fromMaybe nullacct . pruneAccounts (isZeroMixedAmount.aibalance)
 | |
|             markboring | no_elide_ opts = id
 | |
|                        | otherwise      = markBoringParentAccounts
 | |
|       items = map (accountsReportItem opts) accts'
 | |
|       total = sum [amt | (a,_,indent,amt) <- items, if flat_ opts then accountNameLevel a == 1 else indent == 0]
 | |
| 
 | |
| -- | In an account tree with zero-balance leaves removed, mark the
 | |
| -- elidable parent accounts (those with one subaccount and no balance
 | |
| -- of their own).
 | |
| markBoringParentAccounts :: Account -> Account
 | |
| markBoringParentAccounts = tieAccountParents . mapAccounts mark
 | |
|   where
 | |
|     mark a | length (asubs a) == 1 && isZeroMixedAmount (aebalance a) = a{aboring=True}
 | |
|            | otherwise = a
 | |
| 
 | |
| accountsReportItem :: ReportOpts -> Account -> AccountsReportItem
 | |
| accountsReportItem opts a@Account{aname=name, aibalance=ibal}
 | |
|   | flat_ opts = (name, name,       0,      ibal)
 | |
|   | otherwise  = (name, elidedname, indent, ibal)
 | |
|   where
 | |
|     elidedname = accountNameFromComponents (adjacentboringparentnames ++ [accountLeafName name])
 | |
|     adjacentboringparentnames = reverse $ map (accountLeafName.aname) $ takeWhile aboring $ parents
 | |
|     indent = length $ filter (not.aboring) parents
 | |
|     parents = init $ parentAccounts a
 | |
| 
 | |
| 
 | |
| -------------------------------------------------------------------------------
 | |
| 
 | |
| -- | Get the historical running inclusive balance of a particular account,
 | |
| -- from earliest to latest posting date.
 | |
| -- XXX Accounts should know the Ledger & Journal they came from
 | |
| accountBalanceHistory :: ReportOpts -> Journal -> Account -> [(Day, MixedAmount)]
 | |
| accountBalanceHistory ropts j a = [(getdate t, bal) | (t,_,_,_,_,bal) <- items]
 | |
|   where
 | |
|     (_,items) = journalTransactionsReport ropts j acctquery
 | |
|     inclusivebal = True
 | |
|     acctquery = Acct $ (if inclusivebal then accountNameToAccountRegex else accountNameToAccountOnlyRegex) $ aname a
 | |
|     getdate = if effective_ ropts then transactionEffectiveDate else transactionActualDate
 | |
| 
 | |
| 
 | |
| -------------------------------------------------------------------------------
 | |
| -- TESTS
 | |
| 
 | |
| tests_postingsReport = [
 | |
|   "postingsReport" ~: do
 | |
| 
 | |
|    -- with the query specified explicitly
 | |
|    let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) `is` n
 | |
|    (Any, nulljournal) `gives` 0
 | |
|    (Any, samplejournal) `gives` 11
 | |
|    -- register --depth just clips account names
 | |
|    (Depth 2, samplejournal) `gives` 11
 | |
|    (And [Depth 1, Status True, Acct "expenses"], samplejournal) `gives` 2
 | |
|    (And [And [Depth 1, Status True], Acct "expenses"], samplejournal) `gives` 2
 | |
| 
 | |
|    -- with query and/or command-line options
 | |
|    assertEqual "" 11 (length $ snd $ postingsReport defreportopts Any samplejournal)
 | |
|    assertEqual ""  9 (length $ snd $ postingsReport defreportopts{monthly_=True} Any samplejournal)
 | |
|    assertEqual "" 19 (length $ snd $ postingsReport defreportopts{monthly_=True} (Empty True) samplejournal)
 | |
|    assertEqual ""  4 (length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal)
 | |
| 
 | |
|    -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0
 | |
|    -- [(Just (parsedate "2008-01-01","income"),assets:bank:checking             $1,$1)
 | |
|    -- ,(Nothing,income:salary                   $-1,0)
 | |
|    -- ,(Just (2008-06-01,"gift"),assets:bank:checking             $1,$1)
 | |
|    -- ,(Nothing,income:gifts                    $-1,0)
 | |
|    -- ,(Just (2008-06-02,"save"),assets:bank:saving               $1,$1)
 | |
|    -- ,(Nothing,assets:bank:checking            $-1,0)
 | |
|    -- ,(Just (2008-06-03,"eat & shop"),expenses:food                    $1,$1)
 | |
|    -- ,(Nothing,expenses:supplies                $1,$2)
 | |
|    -- ,(Nothing,assets:cash                     $-2,0)
 | |
|    -- ,(Just (2008-12-31,"pay off"),liabilities:debts                $1,$1)
 | |
|    -- ,(Nothing,assets:bank:checking            $-1,0)
 | |
|    -- ]
 | |
| 
 | |
| {-
 | |
|     let opts = defreportopts
 | |
|     (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
 | |
|      ["2008/01/01 income               assets:bank:checking             $1           $1"
 | |
|      ,"                                income:salary                   $-1            0"
 | |
|      ,"2008/06/01 gift                 assets:bank:checking             $1           $1"
 | |
|      ,"                                income:gifts                    $-1            0"
 | |
|      ,"2008/06/02 save                 assets:bank:saving               $1           $1"
 | |
|      ,"                                assets:bank:checking            $-1            0"
 | |
|      ,"2008/06/03 eat & shop           expenses:food                    $1           $1"
 | |
|      ,"                                expenses:supplies                $1           $2"
 | |
|      ,"                                assets:cash                     $-2            0"
 | |
|      ,"2008/12/31 pay off              liabilities:debts                $1           $1"
 | |
|      ,"                                assets:bank:checking            $-1            0"
 | |
|      ]
 | |
| 
 | |
|   ,"postings report with cleared option" ~:
 | |
|    do 
 | |
|     let opts = defreportopts{cleared_=True}
 | |
|     j <- readJournal' sample_journal_str
 | |
|     (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
 | |
|      ["2008/06/03 eat & shop           expenses:food                    $1           $1"
 | |
|      ,"                                expenses:supplies                $1           $2"
 | |
|      ,"                                assets:cash                     $-2            0"
 | |
|      ,"2008/12/31 pay off              liabilities:debts                $1           $1"
 | |
|      ,"                                assets:bank:checking            $-1            0"
 | |
|      ]
 | |
| 
 | |
|   ,"postings report with uncleared option" ~:
 | |
|    do 
 | |
|     let opts = defreportopts{uncleared_=True}
 | |
|     j <- readJournal' sample_journal_str
 | |
|     (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
 | |
|      ["2008/01/01 income               assets:bank:checking             $1           $1"
 | |
|      ,"                                income:salary                   $-1            0"
 | |
|      ,"2008/06/01 gift                 assets:bank:checking             $1           $1"
 | |
|      ,"                                income:gifts                    $-1            0"
 | |
|      ,"2008/06/02 save                 assets:bank:saving               $1           $1"
 | |
|      ,"                                assets:bank:checking            $-1            0"
 | |
|      ]
 | |
| 
 | |
|   ,"postings report sorts by date" ~:
 | |
|    do 
 | |
|     j <- readJournal' $ unlines
 | |
|         ["2008/02/02 a"
 | |
|         ,"  b  1"
 | |
|         ,"  c"
 | |
|         ,""
 | |
|         ,"2008/01/01 d"
 | |
|         ,"  e  1"
 | |
|         ,"  f"
 | |
|         ]
 | |
|     let opts = defreportopts
 | |
|     registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/02/02"]
 | |
| 
 | |
|   ,"postings report with account pattern" ~:
 | |
|    do
 | |
|     j <- samplejournal
 | |
|     let opts = defreportopts{patterns_=["cash"]}
 | |
|     (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
 | |
|      ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"
 | |
|      ]
 | |
| 
 | |
|   ,"postings report with account pattern, case insensitive" ~:
 | |
|    do 
 | |
|     j <- samplejournal
 | |
|     let opts = defreportopts{patterns_=["cAsH"]}
 | |
|     (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
 | |
|      ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"
 | |
|      ]
 | |
| 
 | |
|   ,"postings report with display expression" ~:
 | |
|    do 
 | |
|     j <- samplejournal
 | |
|     let gives displayexpr = 
 | |
|             (registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is`)
 | |
|                 where opts = defreportopts{display_=Just displayexpr}
 | |
|     "d<[2008/6/2]"  `gives` ["2008/01/01","2008/06/01"]
 | |
|     "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]
 | |
|     "d=[2008/6/2]"  `gives` ["2008/06/02"]
 | |
|     "d>=[2008/6/2]" `gives` ["2008/06/02","2008/06/03","2008/12/31"]
 | |
|     "d>[2008/6/2]"  `gives` ["2008/06/03","2008/12/31"]
 | |
| 
 | |
|   ,"postings report with period expression" ~:
 | |
|    do 
 | |
|     j <- samplejournal
 | |
|     let periodexpr `gives` dates = do
 | |
|           j' <- samplejournal
 | |
|           registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j') `is` dates
 | |
|               where opts = defreportopts{period_=maybePeriod date1 periodexpr}
 | |
|     ""     `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
 | |
|     "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
 | |
|     "2007" `gives` []
 | |
|     "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]
 | |
|     "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]
 | |
|     "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]
 | |
|     let opts = defreportopts{period_=maybePeriod date1 "yearly"}
 | |
|     (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
 | |
|      ["2008/01/01 - 2008/12/31         assets:bank:saving               $1           $1"
 | |
|      ,"                                assets:cash                     $-2          $-1"
 | |
|      ,"                                expenses:food                    $1            0"
 | |
|      ,"                                expenses:supplies                $1           $1"
 | |
|      ,"                                income:gifts                    $-1            0"
 | |
|      ,"                                income:salary                   $-1          $-1"
 | |
|      ,"                                liabilities:debts                $1            0"
 | |
|      ]
 | |
|     let opts = defreportopts{period_=maybePeriod date1 "quarterly"}
 | |
|     registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]
 | |
|     let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True}
 | |
|     registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]
 | |
| 
 | |
|   ]
 | |
| 
 | |
|   , "postings report with depth arg" ~:
 | |
|    do 
 | |
|     j <- samplejournal
 | |
|     let opts = defreportopts{depth_=Just 2}
 | |
|     (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
 | |
|      ["2008/01/01 income               assets:bank                      $1           $1"
 | |
|      ,"                                income:salary                   $-1            0"
 | |
|      ,"2008/06/01 gift                 assets:bank                      $1           $1"
 | |
|      ,"                                income:gifts                    $-1            0"
 | |
|      ,"2008/06/02 save                 assets:bank                      $1           $1"
 | |
|      ,"                                assets:bank                     $-1            0"
 | |
|      ,"2008/06/03 eat & shop           expenses:food                    $1           $1"
 | |
|      ,"                                expenses:supplies                $1           $2"
 | |
|      ,"                                assets:cash                     $-2            0"
 | |
|      ,"2008/12/31 pay off              liabilities:debts                $1           $1"
 | |
|      ,"                                assets:bank                     $-1            0"
 | |
|      ]
 | |
| 
 | |
| -}
 | |
|  ]
 | |
| 
 | |
| tests_accountsReport =
 | |
|   let (opts,journal) `gives` r = do
 | |
|          let (eitems, etotal) = r
 | |
|              (aitems, atotal) = accountsReport opts (queryFromOpts nulldate opts) journal
 | |
|          assertEqual "items" eitems aitems
 | |
|          -- assertEqual "" (length eitems) (length aitems)
 | |
|          -- mapM (\(e,a) -> assertEqual "" e a) $ zip eitems aitems
 | |
|          assertEqual "total" etotal atotal
 | |
|   in [
 | |
| 
 | |
|    "accountsReport with no args on null journal" ~: do
 | |
|    (defreportopts, nulljournal) `gives` ([], Mixed [nullamt])
 | |
| 
 | |
|   ,"accountsReport with no args on sample journal" ~: do
 | |
|    (defreportopts, samplejournal) `gives`
 | |
|     ([
 | |
|       ("assets","assets",0, mamountp' "$-1.00")
 | |
|      ,("assets:bank:saving","bank:saving",1, mamountp' "$1.00")
 | |
|      ,("assets:cash","cash",1, mamountp' "$-2.00")
 | |
|      ,("expenses","expenses",0, mamountp' "$2.00")
 | |
|      ,("expenses:food","food",1, mamountp' "$1.00")
 | |
|      ,("expenses:supplies","supplies",1, mamountp' "$1.00")
 | |
|      ,("income","income",0, mamountp' "$-2.00")
 | |
|      ,("income:gifts","gifts",1, mamountp' "$-1.00")
 | |
|      ,("income:salary","salary",1, mamountp' "$-1.00")
 | |
|      ,("liabilities:debts","liabilities:debts",0, mamountp' "$1.00")
 | |
|      ],
 | |
|      Mixed [nullamt])
 | |
| 
 | |
|   ,"accountsReport with --depth=N" ~: do
 | |
|    (defreportopts{depth_=Just 1}, samplejournal) `gives`
 | |
|     ([
 | |
|       ("assets",      "assets",      0, mamountp' "$-1.00")
 | |
|      ,("expenses",    "expenses",    0, mamountp'  "$2.00")
 | |
|      ,("income",      "income",      0, mamountp' "$-2.00")
 | |
|      ,("liabilities", "liabilities", 0, mamountp'  "$1.00")
 | |
|      ],
 | |
|      Mixed [nullamt])
 | |
| 
 | |
|   ,"accountsReport with depth:N" ~: do
 | |
|    (defreportopts{query_="depth:1"}, samplejournal) `gives`
 | |
|     ([
 | |
|       ("assets",      "assets",      0, mamountp' "$-1.00")
 | |
|      ,("expenses",    "expenses",    0, mamountp'  "$2.00")
 | |
|      ,("income",      "income",      0, mamountp' "$-2.00")
 | |
|      ,("liabilities", "liabilities", 0, mamountp'  "$1.00")
 | |
|      ],
 | |
|      Mixed [nullamt])
 | |
| 
 | |
|   ,"accountsReport with a date or effective date span" ~: do
 | |
|    (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives`
 | |
|     ([],
 | |
|      Mixed [nullamt])
 | |
|    (defreportopts{query_="edate:'in 2009'"}, samplejournal2) `gives`
 | |
|     ([
 | |
|       ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
 | |
|      ,("income:salary","income:salary",0,mamountp' "$-1.00")
 | |
|      ],
 | |
|      Mixed [nullamt])
 | |
| 
 | |
|   ,"accountsReport with desc:" ~: do
 | |
|    (defreportopts{query_="desc:income"}, samplejournal) `gives`
 | |
|     ([
 | |
|       ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
 | |
|      ,("income:salary","income:salary",0, mamountp' "$-1.00")
 | |
|      ],
 | |
|      Mixed [nullamt])
 | |
| 
 | |
|   ,"accountsReport with not:desc:" ~: do
 | |
|    (defreportopts{query_="not:desc:income"}, samplejournal) `gives`
 | |
|     ([
 | |
|       ("assets","assets",0, mamountp' "$-2.00")
 | |
|      ,("assets:bank","bank",1, Mixed [nullamt])
 | |
|      ,("assets:bank:checking","checking",2,mamountp' "$-1.00")
 | |
|      ,("assets:bank:saving","saving",2, mamountp' "$1.00")
 | |
|      ,("assets:cash","cash",1, mamountp' "$-2.00")
 | |
|      ,("expenses","expenses",0, mamountp' "$2.00")
 | |
|      ,("expenses:food","food",1, mamountp' "$1.00")
 | |
|      ,("expenses:supplies","supplies",1, mamountp' "$1.00")
 | |
|      ,("income:gifts","income:gifts",0, mamountp' "$-1.00")
 | |
|      ,("liabilities:debts","liabilities:debts",0, mamountp' "$1.00")
 | |
|      ],
 | |
|      Mixed [nullamt])
 | |
| 
 | |
| 
 | |
| {-
 | |
|     ,"accounts report with account pattern o" ~:
 | |
|      defreportopts{patterns_=["o"]} `gives`
 | |
|      ["                  $1  expenses:food"
 | |
|      ,"                 $-2  income"
 | |
|      ,"                 $-1    gifts"
 | |
|      ,"                 $-1    salary"
 | |
|      ,"--------------------"
 | |
|      ,"                 $-1"
 | |
|      ]
 | |
| 
 | |
|     ,"accounts report with account pattern o and --depth 1" ~:
 | |
|      defreportopts{patterns_=["o"],depth_=Just 1} `gives`
 | |
|      ["                  $1  expenses"
 | |
|      ,"                 $-2  income"
 | |
|      ,"--------------------"
 | |
|      ,"                 $-1"
 | |
|      ]
 | |
| 
 | |
|     ,"accounts report with account pattern a" ~:
 | |
|      defreportopts{patterns_=["a"]} `gives`
 | |
|      ["                 $-1  assets"
 | |
|      ,"                  $1    bank:saving"
 | |
|      ,"                 $-2    cash"
 | |
|      ,"                 $-1  income:salary"
 | |
|      ,"                  $1  liabilities:debts"
 | |
|      ,"--------------------"
 | |
|      ,"                 $-1"
 | |
|      ]
 | |
| 
 | |
|     ,"accounts report with account pattern e" ~:
 | |
|      defreportopts{patterns_=["e"]} `gives`
 | |
|      ["                 $-1  assets"
 | |
|      ,"                  $1    bank:saving"
 | |
|      ,"                 $-2    cash"
 | |
|      ,"                  $2  expenses"
 | |
|      ,"                  $1    food"
 | |
|      ,"                  $1    supplies"
 | |
|      ,"                 $-2  income"
 | |
|      ,"                 $-1    gifts"
 | |
|      ,"                 $-1    salary"
 | |
|      ,"                  $1  liabilities:debts"
 | |
|      ,"--------------------"
 | |
|      ,"                   0"
 | |
|      ]
 | |
| 
 | |
|     ,"accounts report with unmatched parent of two matched subaccounts" ~: 
 | |
|      defreportopts{patterns_=["cash","saving"]} `gives`
 | |
|      ["                 $-1  assets"
 | |
|      ,"                  $1    bank:saving"
 | |
|      ,"                 $-2    cash"
 | |
|      ,"--------------------"
 | |
|      ,"                 $-1"
 | |
|      ]
 | |
| 
 | |
|     ,"accounts report with multi-part account name" ~: 
 | |
|      defreportopts{patterns_=["expenses:food"]} `gives`
 | |
|      ["                  $1  expenses:food"
 | |
|      ,"--------------------"
 | |
|      ,"                  $1"
 | |
|      ]
 | |
| 
 | |
|     ,"accounts report with negative account pattern" ~:
 | |
|      defreportopts{patterns_=["not:assets"]} `gives`
 | |
|      ["                  $2  expenses"
 | |
|      ,"                  $1    food"
 | |
|      ,"                  $1    supplies"
 | |
|      ,"                 $-2  income"
 | |
|      ,"                 $-1    gifts"
 | |
|      ,"                 $-1    salary"
 | |
|      ,"                  $1  liabilities:debts"
 | |
|      ,"--------------------"
 | |
|      ,"                  $1"
 | |
|      ]
 | |
| 
 | |
|     ,"accounts report negative account pattern always matches full name" ~: 
 | |
|      defreportopts{patterns_=["not:e"]} `gives`
 | |
|      ["--------------------"
 | |
|      ,"                   0"
 | |
|      ]
 | |
| 
 | |
|     ,"accounts report negative patterns affect totals" ~: 
 | |
|      defreportopts{patterns_=["expenses","not:food"]} `gives`
 | |
|      ["                  $1  expenses:supplies"
 | |
|      ,"--------------------"
 | |
|      ,"                  $1"
 | |
|      ]
 | |
| 
 | |
|     ,"accounts report with -E shows zero-balance accounts" ~:
 | |
|      defreportopts{patterns_=["assets"],empty_=True} `gives`
 | |
|      ["                 $-1  assets"
 | |
|      ,"                  $1    bank"
 | |
|      ,"                   0      checking"
 | |
|      ,"                  $1      saving"
 | |
|      ,"                 $-2    cash"
 | |
|      ,"--------------------"
 | |
|      ,"                 $-1"
 | |
|      ]
 | |
| 
 | |
|     ,"accounts report with cost basis" ~: do
 | |
|        j <- (readJournal Nothing Nothing Nothing $ unlines
 | |
|               [""
 | |
|               ,"2008/1/1 test           "
 | |
|               ,"  a:b          10h @ $50"
 | |
|               ,"  c:d                   "
 | |
|               ]) >>= either error' return
 | |
|        let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment
 | |
|        accountsReportAsText defreportopts (accountsReport defreportopts Any j') `is`
 | |
|          ["                $500  a:b"
 | |
|          ,"               $-500  c:d"
 | |
|          ,"--------------------"
 | |
|          ,"                   0"
 | |
|          ]
 | |
| -}
 | |
|  ]
 | |
| 
 | |
| Right samplejournal2 = journalBalanceTransactions $ 
 | |
|          nulljournal
 | |
|          {jtxns = [
 | |
|            txnTieKnot $ Transaction {
 | |
|              tdate=parsedate "2008/01/01",
 | |
|              teffectivedate=Just $ parsedate "2009/01/01",
 | |
|              tstatus=False,
 | |
|              tcode="",
 | |
|              tdescription="income",
 | |
|              tcomment="",
 | |
|              ttags=[],
 | |
|              tpostings=
 | |
|                  [posting {paccount="assets:bank:checking", pamount=Mixed [usd 1]}
 | |
|                  ,posting {paccount="income:salary", pamount=missingmixedamt}
 | |
|                  ],
 | |
|              tpreceding_comment_lines=""
 | |
|            }
 | |
|           ]
 | |
|          }
 | |
|          
 | |
| -- tests_isInterestingIndented = [
 | |
| --   "isInterestingIndented" ~: do 
 | |
| --    let (opts, journal, acctname) `gives` r = isInterestingIndented opts l acctname `is` r
 | |
| --           where l = ledgerFromJournal (queryFromOpts nulldate opts) journal
 | |
|      
 | |
| --    (defreportopts, samplejournal, "expenses") `gives` True
 | |
| --  ]
 | |
| 
 | |
| tests_Hledger_Reports :: Test
 | |
| tests_Hledger_Reports = TestList $
 | |
|     tests_queryFromOpts
 | |
|  ++ tests_queryOptsFromOpts
 | |
|  ++ tests_entriesReport
 | |
|  ++ tests_summarisePostingsByInterval
 | |
|  ++ tests_postingsReport
 | |
|  -- ++ tests_isInterestingIndented
 | |
|  ++ tests_accountsReport
 | |
|  ++ [
 | |
|   -- ,"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 [usd 1]}
 | |
|   --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [usd 2]}
 | |
|   --           ,nullposting{lpdescription="desc",lpaccount="expenses:food",          lpamount=Mixed [usd 4]}
 | |
|   --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [usd 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 [usd 4]}
 | |
|   --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining",   lpamount=Mixed [usd 10]}
 | |
|   --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 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 [usd 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 [usd 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 [usd 15]}
 | |
|   --    ]
 | |
| 
 | |
|  ]
 |