hledger/hledger-lib/Hledger/Data/Journal.hs

569 lines
24 KiB
Haskell
Raw Normal View History

{-|
A 'Journal' is a set of transactions, plus optional related data. This is
hledger's primary data object. It is usually parsed from a journal file or
other data format (see "Hledger.Read").
-}
module Hledger.Data.Journal (
-- * Parsing helpers
addHistoricalPrice,
addModifierTransaction,
addPeriodicTransaction,
addTimeLogEntry,
addTransaction,
journalApplyAliases,
journalCanonicaliseAmounts,
journalConvertAmountsToCost,
journalFinalise,
journalSelectingDate,
-- * Filtering
filterJournalPostings,
filterJournalPostings2,
filterJournalTransactions,
filterJournalTransactions2,
filterJournalTransactionsByAccount,
-- * Querying
journalAccountInfo,
journalAccountNamesUsed,
journalAmountAndPriceCommodities,
journalAmounts,
journalCanonicalCommodities,
journalDateSpan,
journalFilePath,
journalFilePaths,
journalPostings,
-- * Standard account types
2012-05-16 11:37:24 +04:00
journalBalanceSheetAccountQuery,
journalProfitAndLossAccountQuery,
journalIncomeAccountQuery,
journalExpenseAccountQuery,
journalAssetAccountQuery,
journalLiabilityAccountQuery,
journalEquityAccountQuery,
-- * Misc
groupPostings,
matchpats,
nullctx,
nullfilterspec,
nulljournal,
-- * Tests
tests_Hledger_Data_Journal,
)
where
2011-05-28 08:11:44 +04:00
import Data.List
import Data.Map (findWithDefault, (!))
2011-05-28 08:11:44 +04:00
import Data.Ord
import Data.Time.Calendar
import Data.Time.LocalTime
import Data.Tree
import Safe (headDef)
import System.Time (ClockTime(TOD))
2011-05-28 08:11:44 +04:00
import Test.HUnit
import Text.Printf
import qualified Data.Map as Map
import Hledger.Utils
2010-05-20 03:08:53 +04:00
import Hledger.Data.Types
import Hledger.Data.AccountName
import Hledger.Data.Amount
2010-07-11 22:56:36 +04:00
import Hledger.Data.Commodity (canonicaliseCommodities)
import Hledger.Data.Dates (nulldatespan)
import Hledger.Data.Transaction (journalTransactionWithDate,balanceTransaction) -- nulltransaction,
2010-05-20 03:08:53 +04:00
import Hledger.Data.Posting
import Hledger.Data.TimeLog
import Hledger.Data.Query
2009-12-16 10:00:43 +03:00
instance Show Journal where
show j = printf "Journal %s with %d transactions, %d accounts: %s"
(journalFilePath j)
(length (jtxns j) +
length (jmodifiertxns j) +
length (jperiodictxns j))
2008-10-09 13:25:58 +04:00
(length accounts)
(show accounts)
2009-12-16 10:00:43 +03:00
-- ++ (show $ journalTransactions l)
where accounts = flatten $ journalAccountNameTree j
2008-10-03 16:10:05 +04:00
-- showJournalDebug j = unlines [
-- show j
-- ,show (jtxns j)
-- ,show (jmodifiertxns j)
-- ,show (jperiodictxns j)
-- ,show $ open_timelog_entries j
-- ,show $ historical_prices j
-- ,show $ final_comment_lines j
-- ,show $ jContext j
-- ,show $ map fst $ files j
-- ]
2011-08-03 03:27:41 +04:00
2009-12-20 18:50:54 +03:00
nulljournal :: Journal
nulljournal = Journal { jmodifiertxns = []
, jperiodictxns = []
, jtxns = []
, open_timelog_entries = []
, historical_prices = []
, final_comment_lines = []
, jContext = nullctx
, files = []
2009-12-20 18:50:54 +03:00
, filereadtime = TOD 0 0
}
nullctx :: JournalContext
nullctx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [], ctxAliases = [] }
2011-05-28 08:11:44 +04:00
nullfilterspec :: FilterSpec
nullfilterspec = FilterSpec {
datespan=nulldatespan
,cleared=Nothing
,real=False
,empty=False
,acctpats=[]
,descpats=[]
,depth=Nothing
2012-04-09 00:43:48 +04:00
,metadata=[]
}
journalFilePath :: Journal -> FilePath
journalFilePath = fst . mainfile
journalFilePaths :: Journal -> [FilePath]
journalFilePaths = map fst . files
mainfile :: Journal -> (FilePath, String)
mainfile = headDef ("", "") . files
addTransaction :: Transaction -> Journal -> Journal
addTransaction t l0 = l0 { jtxns = t : jtxns l0 }
2009-12-16 10:00:43 +03:00
addModifierTransaction :: ModifierTransaction -> Journal -> Journal
addModifierTransaction mt l0 = l0 { jmodifiertxns = mt : jmodifiertxns l0 }
2009-12-16 10:00:43 +03:00
addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction pt l0 = l0 { jperiodictxns = pt : jperiodictxns l0 }
2009-12-16 10:00:43 +03:00
addHistoricalPrice :: HistoricalPrice -> Journal -> Journal
2009-09-22 20:51:27 +04:00
addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 }
2009-12-16 10:00:43 +03:00
addTimeLogEntry :: TimeLogEntry -> Journal -> Journal
2009-09-22 20:51:27 +04:00
addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 }
journalPostings :: Journal -> [Posting]
journalPostings = concatMap tpostings . jtxns
2008-10-03 16:10:05 +04:00
-- | All account names used in this journal.
2009-12-16 10:00:43 +03:00
journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed = sort . accountNamesFromPostings . journalPostings
2008-10-03 16:10:05 +04:00
2009-12-16 10:00:43 +03:00
journalAccountNames :: Journal -> [AccountName]
journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed
2008-10-03 16:10:05 +04:00
2009-12-16 10:00:43 +03:00
journalAccountNameTree :: Journal -> Tree AccountName
journalAccountNameTree = accountNameTreeFrom . journalAccountNames
-- standard account types
-- | A query for Profit & Loss accounts in this journal.
-- Cf <http://en.wikipedia.org/wiki/Chart_of_accounts#Profit_.26_Loss_accounts>.
journalProfitAndLossAccountQuery :: Journal -> Query
journalProfitAndLossAccountQuery j = Or [journalIncomeAccountQuery j
,journalExpenseAccountQuery j
]
-- | A query for Income (Revenue) accounts in this journal.
-- This is currently hard-coded to the case-insensitive regex @^(income|revenue)s?(:|$)@.
journalIncomeAccountQuery :: Journal -> Query
journalIncomeAccountQuery _ = Acct "^(income|revenue)s?(:|$)"
-- | A query for Expense accounts in this journal.
-- This is currently hard-coded to the case-insensitive regex @^expenses?(:|$)@.
journalExpenseAccountQuery :: Journal -> Query
journalExpenseAccountQuery _ = Acct "^expenses?(:|$)"
2012-05-16 11:37:24 +04:00
-- | A query for Asset, Liability & Equity accounts in this journal.
-- Cf <http://en.wikipedia.org/wiki/Chart_of_accounts#Balance_Sheet_Accounts>.
journalBalanceSheetAccountQuery :: Journal -> Query
journalBalanceSheetAccountQuery j = Or [journalAssetAccountQuery j
,journalLiabilityAccountQuery j
,journalEquityAccountQuery j
]
-- | A query for Asset accounts in this journal.
-- This is currently hard-coded to the case-insensitive regex @^assets?(:|$)@.
journalAssetAccountQuery :: Journal -> Query
journalAssetAccountQuery _ = Acct "^assets?(:|$)"
-- | A query for Liability accounts in this journal.
-- This is currently hard-coded to the case-insensitive regex @^liabilit(y|ies)(:|$)@.
journalLiabilityAccountQuery :: Journal -> Query
journalLiabilityAccountQuery _ = Acct "^liabilit(y|ies)(:|$)"
-- | A query for Equity accounts in this journal.
-- This is currently hard-coded to the case-insensitive regex @^equity(:|$)@.
journalEquityAccountQuery :: Journal -> Query
journalEquityAccountQuery _ = Acct "^equity(:|$)"
-- Various kinds of filtering on journals. We do it differently depending
-- on the command.
-------------------------------------------------------------------------------
-- filtering V2
-- | Keep only postings matching the query expression.
-- This can leave unbalanced transactions.
filterJournalPostings2 :: Query -> Journal -> Journal
2011-06-05 22:36:32 +04:00
filterJournalPostings2 m j@Journal{jtxns=ts} = j{jtxns=map filtertransactionpostings ts}
where
filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}
-- | Keep only transactions matching the query expression.
filterJournalTransactions2 :: Query -> Journal -> Journal
2011-06-05 22:36:32 +04:00
filterJournalTransactions2 m j@Journal{jtxns=ts} = j{jtxns=filter (m `matchesTransaction`) ts}
-------------------------------------------------------------------------------
-- filtering V1
-- | Keep only transactions we are interested in, as described by the
-- filter specification.
filterJournalTransactions :: FilterSpec -> Journal -> Journal
filterJournalTransactions FilterSpec{datespan=datespan
,cleared=cleared
-- ,real=real
-- ,empty=empty
,acctpats=apats
,descpats=dpats
,depth=depth
2012-04-09 00:43:48 +04:00
,metadata=md
} =
filterJournalTransactionsByClearedStatus cleared .
filterJournalPostingsByDepth depth .
filterJournalTransactionsByAccount apats .
2012-04-09 00:43:48 +04:00
filterJournalTransactionsByMetadata md .
filterJournalTransactionsByDescription dpats .
filterJournalTransactionsByDate datespan
-- | Keep only postings we are interested in, as described by the filter
-- specification. This can leave unbalanced transactions.
filterJournalPostings :: FilterSpec -> Journal -> Journal
filterJournalPostings FilterSpec{datespan=datespan
,cleared=cleared
,real=real
,empty=empty
,acctpats=apats
,descpats=dpats
,depth=depth
2012-04-09 00:43:48 +04:00
,metadata=md
} =
filterJournalPostingsByRealness real .
filterJournalPostingsByClearedStatus cleared .
filterJournalPostingsByEmpty empty .
filterJournalPostingsByDepth depth .
filterJournalPostingsByAccount apats .
2012-04-09 00:43:48 +04:00
filterJournalTransactionsByMetadata md .
filterJournalTransactionsByDescription dpats .
filterJournalTransactionsByDate datespan
2012-04-09 00:43:48 +04:00
-- | Keep only transactions whose metadata matches all metadata specifications.
filterJournalTransactionsByMetadata :: [(String,String)] -> Journal -> Journal
filterJournalTransactionsByMetadata pats j@Journal{jtxns=ts} = j{jtxns=filter matchmd ts}
where matchmd t = all (`elem` tmetadata t) pats
-- | Keep only transactions whose description matches the description patterns.
filterJournalTransactionsByDescription :: [String] -> Journal -> Journal
filterJournalTransactionsByDescription pats j@Journal{jtxns=ts} = j{jtxns=filter matchdesc ts}
where matchdesc = matchpats pats . tdescription
-- | Keep only transactions which fall between begin and end dates.
-- We include transactions on the begin date and exclude transactions on the end
-- date, like ledger. An empty date string means no restriction.
filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal
filterJournalTransactionsByDate (DateSpan begin end) j@Journal{jtxns=ts} = j{jtxns=filter match ts}
where match t = maybe True (tdate t>=) begin && maybe True (tdate t<) end
-- | Keep only transactions which have the requested cleared/uncleared
-- status, if there is one.
filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal
filterJournalTransactionsByClearedStatus Nothing j = j
filterJournalTransactionsByClearedStatus (Just val) j@Journal{jtxns=ts} = j{jtxns=filter match ts}
where match = (==val).tstatus
-- | Keep only postings which have the requested cleared/uncleared status,
-- if there is one.
2009-12-16 10:58:06 +03:00
filterJournalPostingsByClearedStatus :: Maybe Bool -> Journal -> Journal
filterJournalPostingsByClearedStatus Nothing j = j
filterJournalPostingsByClearedStatus (Just c) j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter ((==c) . postingCleared) ps}
-- | Strip out any virtual postings, if the flag is true, otherwise do
2008-10-17 04:57:00 +04:00
-- no filtering.
2009-12-16 10:00:43 +03:00
filterJournalPostingsByRealness :: Bool -> Journal -> Journal
filterJournalPostingsByRealness False l = l
filterJournalPostingsByRealness True j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps}
-- | Strip out any postings with zero amount, unless the flag is true.
filterJournalPostingsByEmpty :: Bool -> Journal -> Journal
filterJournalPostingsByEmpty True l = l
filterJournalPostingsByEmpty False j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (not . isEmptyPosting) ps}
-- -- | Keep only transactions which affect accounts deeper than the specified depth.
-- filterJournalTransactionsByDepth :: Maybe Int -> Journal -> Journal
-- filterJournalTransactionsByDepth Nothing j = j
-- filterJournalTransactionsByDepth (Just d) j@Journal{jtxns=ts} =
-- j{jtxns=(filter (any ((<= d+1) . accountNameLevel . paccount) . tpostings) ts)}
-- | Strip out any postings to accounts deeper than the specified depth
-- (and any transactions which have no postings as a result).
filterJournalPostingsByDepth :: Maybe Int -> Journal -> Journal
filterJournalPostingsByDepth Nothing j = j
filterJournalPostingsByDepth (Just d) j@Journal{jtxns=ts} =
j{jtxns=filter (not . null . tpostings) $ map filtertxns ts}
where filtertxns t@Transaction{tpostings=ps} =
t{tpostings=filter ((<= d) . accountNameLevel . paccount) ps}
-- | Keep only transactions which affect accounts matched by the account patterns.
-- More precisely: each positive account pattern excludes transactions
-- which do not contain a posting to a matched account, and each negative
-- account pattern excludes transactions containing a posting to a matched
-- account.
filterJournalTransactionsByAccount :: [String] -> Journal -> Journal
filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter tmatch ts}
where
tmatch t = (null positives || any positivepmatch ps) && (null negatives || not (any negativepmatch ps)) where ps = tpostings t
positivepmatch p = any (`amatch` a) positives where a = paccount p
negativepmatch p = any (`amatch` a) negatives where a = paccount p
amatch pat a = regexMatchesCI (abspat pat) a
(negatives,positives) = partition isnegativepat apats
2008-11-22 09:35:10 +03:00
-- | Keep only postings which affect accounts matched by the account patterns.
-- This can leave transactions unbalanced.
filterJournalPostingsByAccount :: [String] -> Journal -> Journal
filterJournalPostingsByAccount apats j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (matchpats apats . paccount) ps}
-- | Convert this journal's transactions' primary date to either the
-- actual or effective date.
2009-12-16 10:00:43 +03:00
journalSelectingDate :: WhichDate -> Journal -> Journal
journalSelectingDate ActualDate j = j
journalSelectingDate EffectiveDate j =
j{jtxns=map (journalTransactionWithDate EffectiveDate) $ jtxns j}
2011-08-05 04:05:39 +04:00
-- | Apply additional account aliases (eg from the command-line) to all postings in a journal.
journalApplyAliases :: [(AccountName,AccountName)] -> Journal -> Journal
journalApplyAliases aliases j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
where
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
fixposting p@Posting{paccount=a} = p{paccount=accountNameApplyAliases aliases a}
-- | Do post-parse processing on a journal to make it ready for use: check
-- all transactions balance, canonicalise amount formats, close any open
-- timelog entries and so on.
journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Journal -> Either String Journal
journalFinalise tclock tlocal path txt ctx j@Journal{files=fs} =
journalBalanceTransactions $
journalCanonicaliseAmounts $
journalCloseTimeLogEntries tlocal
j{files=(path,txt):fs, filereadtime=tclock, jContext=ctx}
-- | Fill in any missing amounts and check that all journal transactions
-- balance, or return an error message. This is done after parsing all
-- amounts and working out the canonical commodities, since balancing
-- depends on display precision. Reports only the first error encountered.
journalBalanceTransactions :: Journal -> Either String Journal
journalBalanceTransactions j@Journal{jtxns=ts} =
case sequence $ map balance ts of Right ts' -> Right j{jtxns=ts'}
Left e -> Left e
where balance = balanceTransaction (Just $ journalCanonicalCommodities j)
-- | Convert all the journal's posting amounts (not price amounts) to
-- their canonical display settings. Ie, all amounts in a given
-- commodity will use (a) the display settings of the first, and (b)
-- the greatest precision, of the posting amounts in that commodity.
journalCanonicaliseAmounts :: Journal -> Journal
journalCanonicaliseAmounts j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
where
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
fixmixedamount (Mixed as) = Mixed $ map fixamount as
fixamount a@Amount{commodity=c} = a{commodity=fixcommodity c}
fixcommodity c@Commodity{symbol=s} = findWithDefault c s canonicalcommoditymap
canonicalcommoditymap = journalCanonicalCommodities j
2010-05-22 23:00:20 +04:00
-- -- | Apply this journal's historical price records to unpriced amounts where possible.
-- journalApplyHistoricalPrices :: Journal -> Journal
-- journalApplyHistoricalPrices j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
-- where
-- fixtransaction t@Transaction{tdate=d, tpostings=ps} = t{tpostings=map fixposting ps}
-- where
-- fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
-- fixmixedamount (Mixed as) = Mixed $ map fixamount as
-- fixamount = fixprice
-- fixprice a@Amount{price=Just _} = a
-- fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalHistoricalPriceFor j d c}
-- -- | Get the price for a commodity on the specified day from the price database, if known.
-- -- Does only one lookup step, ie will not look up the price of a price.
-- journalHistoricalPriceFor :: Journal -> Day -> Commodity -> Maybe MixedAmount
-- journalHistoricalPriceFor j d Commodity{symbol=s} = do
-- let ps = reverse $ filter ((<= d).hdate) $ filter ((s==).hsymbol) $ sortBy (comparing hdate) $ historical_prices j
-- case ps of (HistoricalPrice{hamount=a}:_) -> Just a
-- _ -> Nothing
-- | Close any open timelog sessions in this journal using the provided current time.
journalCloseTimeLogEntries :: LocalTime -> Journal -> Journal
journalCloseTimeLogEntries now j@Journal{jtxns=ts, open_timelog_entries=es} =
j{jtxns = ts ++ (timeLogEntriesToTransactions now es), open_timelog_entries = []}
-- | Convert all this journal's amounts to cost by applying their prices, if any.
journalConvertAmountsToCost :: Journal -> Journal
journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
where
-- similar to journalCanonicaliseAmounts
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
fixmixedamount (Mixed as) = Mixed $ map fixamount as
2011-08-30 17:16:30 +04:00
fixamount = canonicaliseAmountCommodity (Just $ journalCanonicalCommodities j) . costOfAmount
-- | Get this journal's unique, display-preference-canonicalised commodities, by symbol.
journalCanonicalCommodities :: Journal -> Map.Map String Commodity
journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountCommodities j
-- | Get all this journal's amounts' commodities, in the order parsed.
journalAmountCommodities :: Journal -> [Commodity]
journalAmountCommodities = map commodity . concatMap amounts . journalAmounts
-- | Get all this journal's amount and price commodities, in the order parsed.
journalAmountAndPriceCommodities :: Journal -> [Commodity]
journalAmountAndPriceCommodities = concatMap amountCommodities . concatMap amounts . journalAmounts
-- | Get this amount's commodity and any commodities referenced in its price.
amountCommodities :: Amount -> [Commodity]
amountCommodities Amount{commodity=c,price=p} =
case p of Nothing -> [c]
Just (UnitPrice ma) -> c:(concatMap amountCommodities $ amounts ma)
Just (TotalPrice ma) -> c:(concatMap amountCommodities $ amounts ma)
-- | Get all this journal's amounts, in the order parsed.
2009-12-16 10:00:43 +03:00
journalAmounts :: Journal -> [MixedAmount]
journalAmounts = map pamount . journalPostings
-- | The (fully specified) date span containing this journal's transactions,
2009-04-04 15:19:15 +04:00
-- or DateSpan Nothing Nothing if there are none.
2009-12-16 10:00:43 +03:00
journalDateSpan :: Journal -> DateSpan
journalDateSpan j
2009-04-04 15:19:15 +04:00
| null ts = DateSpan Nothing Nothing
| otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts)
2009-04-04 15:19:15 +04:00
where
ts = sortBy (comparing tdate) $ jtxns j
-- Misc helpers
-- | Check if a set of hledger account/description filter patterns matches the
-- given account name or entry description. Patterns are case-insensitive
2010-04-14 20:19:01 +04:00
-- regular expressions. Prefixed with not:, they become anti-patterns.
matchpats :: [String] -> String -> Bool
matchpats pats str =
(null positives || any match positives) && (null negatives || not (any match negatives))
where
(negatives,positives) = partition isnegativepat pats
match "" = True
match pat = regexMatchesCI (abspat pat) str
negateprefix = "not:"
isnegativepat = (negateprefix `isPrefixOf`)
abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat
-- | Calculate the account tree and all account balances from a journal's
-- postings, returning the results for efficient lookup.
2010-05-23 02:05:12 +04:00
journalAccountInfo :: Journal -> (Tree AccountName, Map.Map AccountName Account)
journalAccountInfo j = (ant, amap)
where
2010-05-23 02:05:12 +04:00
(ant, psof, _, inclbalof) = (groupPostings . journalPostings) j
amap = Map.fromList [(a, acctinfo a) | a <- flatten ant]
acctinfo a = Account a (psof a) (inclbalof a)
-- | Given a list of postings, return an account name tree and three query
-- functions that fetch postings, subaccount-excluding-balance and
-- subaccount-including-balance by account name.
groupPostings :: [Posting] -> (Tree AccountName,
(AccountName -> [Posting]),
(AccountName -> MixedAmount),
(AccountName -> MixedAmount))
2010-05-23 02:05:12 +04:00
groupPostings ps = (ant, psof, exclbalof, inclbalof)
where
anames = sort $ nub $ map paccount ps
ant = accountNameTreeFrom $ expandAccountNames anames
allanames = flatten ant
pmap = Map.union (postingsByAccount ps) (Map.fromList [(a,[]) | a <- allanames])
psof = (pmap !)
balmap = Map.fromList $ flatten $ calculateBalances ant psof
exclbalof = fst . (balmap !)
inclbalof = snd . (balmap !)
-- | Add subaccount-excluding and subaccount-including balances to a tree
-- of account names somewhat efficiently, given a function that looks up
-- transactions by account name.
calculateBalances :: Tree AccountName -> (AccountName -> [Posting]) -> Tree (AccountName, (MixedAmount, MixedAmount))
calculateBalances ant psof = addbalances ant
where
addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs'
where
bal = sumPostings $ psof a
subsbal = sum $ map (snd . snd . root) subs'
subs' = map addbalances subs
-- | Convert a list of postings to a map from account name to that
-- account's postings.
postingsByAccount :: [Posting] -> Map.Map AccountName [Posting]
postingsByAccount ps = m'
where
sortedps = sortBy (comparing paccount) ps
groupedps = groupBy (\p1 p2 -> paccount p1 == paccount p2) sortedps
m' = Map.fromList [(paccount $ head g, g) | g <- groupedps]
2010-12-27 23:26:22 +03:00
-- debug helpers
-- traceAmountPrecision a = trace (show $ map (precision . commodity) $ amounts a) a
-- tracePostingsCommodities ps = trace (show $ map ((map (precision . commodity) . amounts) . pamount) ps) ps
-- tests
2010-12-27 23:26:22 +03:00
tests_Hledger_Data_Journal = TestList [
-- "query standard account types" ~:
-- do
-- let j = journal1
-- journalBalanceSheetAccountNames j `is` ["assets","assets:a","equity","equity:q","equity:q:qq","liabilities","liabilities:l"]
-- journalProfitAndLossAccountNames j `is` ["expenses","expenses:e","income","income:i"]
2010-12-27 23:26:22 +03:00
]
-- journal1 =
-- Journal
-- []
-- []
-- [
-- nulltransaction{
-- tpostings=[
-- nullposting{paccount="liabilities:l"}
-- ,nullposting{paccount="expenses:e"}
-- ]
-- }
-- ,nulltransaction{
-- tpostings=[
-- nullposting{paccount="income:i"}
-- ,nullposting{paccount="assets:a"}
-- ,nullposting{paccount="equity:q:qq"}
-- ]
-- }
-- ]
-- []
-- []
-- ""
-- nullctx
-- []
-- (TOD 0 0)