2008-10-03 06:04:15 +04:00
|
|
|
{-|
|
|
|
|
|
2010-05-23 21:41:25 +04:00
|
|
|
A 'Ledger' is derived from a 'Journal' by applying a filter specification
|
|
|
|
to select 'Transaction's and 'Posting's of interest. It contains the
|
|
|
|
filtered journal and knows the resulting chart of accounts, account
|
|
|
|
balances, and postings in each account.
|
2009-04-05 02:38:18 +04:00
|
|
|
|
2008-10-03 06:04:15 +04:00
|
|
|
-}
|
|
|
|
|
2010-05-20 03:08:53 +04:00
|
|
|
module Hledger.Data.Ledger
|
2007-02-16 12:00:17 +03:00
|
|
|
where
|
2012-10-21 21:18:18 +04:00
|
|
|
import qualified Data.Map as M
|
|
|
|
import Safe (headDef)
|
2011-05-28 08:11:44 +04:00
|
|
|
import Test.HUnit
|
|
|
|
import Text.Printf
|
|
|
|
|
2010-05-20 03:08:53 +04:00
|
|
|
import Hledger.Data.Types
|
2012-10-21 21:18:18 +04:00
|
|
|
import Hledger.Data.Account
|
2010-05-20 03:08:53 +04:00
|
|
|
import Hledger.Data.Journal
|
|
|
|
import Hledger.Data.Posting
|
2012-05-16 11:57:10 +04:00
|
|
|
import Hledger.Query
|
2007-07-02 23:15:39 +04:00
|
|
|
|
2007-02-16 12:00:17 +03:00
|
|
|
|
2007-07-03 21:25:16 +04:00
|
|
|
instance Show Ledger where
|
2012-10-21 21:18:18 +04:00
|
|
|
show l = printf "Ledger with %d transactions, %d accounts\n" --"%s"
|
|
|
|
(length (jtxns $ ljournal l) +
|
|
|
|
length (jmodifiertxns $ ljournal l) +
|
|
|
|
length (jperiodictxns $ ljournal l))
|
2012-05-09 19:34:05 +04:00
|
|
|
(length $ ledgerAccountNames l)
|
2012-10-21 21:18:18 +04:00
|
|
|
-- (showtree $ ledgerAccountNameTree l)
|
2007-07-03 21:25:16 +04:00
|
|
|
|
2009-12-21 08:23:07 +03:00
|
|
|
nullledger :: Ledger
|
2012-10-21 21:18:18 +04:00
|
|
|
nullledger = Ledger {
|
|
|
|
ljournal = nulljournal,
|
|
|
|
laccounts = []
|
|
|
|
}
|
|
|
|
|
2014-02-28 05:47:47 +04:00
|
|
|
-- | Filter a journal's transactions with the given query, then derive
|
|
|
|
-- a ledger containing the chart of accounts and balances. If the
|
|
|
|
-- query includes a depth limit, that will affect the this ledger's
|
|
|
|
-- journal but not the ledger's account tree.
|
2012-10-21 21:18:18 +04:00
|
|
|
ledgerFromJournal :: Query -> Journal -> Ledger
|
|
|
|
ledgerFromJournal q j = nullledger{ljournal=j'', laccounts=as}
|
|
|
|
where
|
|
|
|
(q',depthq) = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q)
|
2014-05-24 00:10:36 +04:00
|
|
|
j' = filterJournalAmounts (filterQuery queryIsSym q) $ -- remove amount parts which the query's sym: terms would exclude
|
2014-04-04 02:21:06 +04:00
|
|
|
filterJournalPostings q' j
|
2014-02-28 05:47:47 +04:00
|
|
|
as = accountsFromPostings $ journalPostings j'
|
2012-10-21 21:18:18 +04:00
|
|
|
j'' = filterJournalPostings depthq j'
|
2012-05-27 22:14:20 +04:00
|
|
|
|
2008-10-18 04:52:49 +04:00
|
|
|
-- | List a ledger's account names.
|
2009-04-05 02:38:18 +04:00
|
|
|
ledgerAccountNames :: Ledger -> [AccountName]
|
2012-10-21 21:18:18 +04:00
|
|
|
ledgerAccountNames = drop 1 . map aname . laccounts
|
2007-07-03 12:46:39 +04:00
|
|
|
|
2010-05-23 21:41:25 +04:00
|
|
|
-- | Get the named account from a ledger.
|
2012-10-21 21:18:18 +04:00
|
|
|
ledgerAccount :: Ledger -> AccountName -> Maybe Account
|
|
|
|
ledgerAccount l a = lookupAccount a $ laccounts l
|
2007-02-16 12:00:17 +03:00
|
|
|
|
2012-10-21 21:18:18 +04:00
|
|
|
-- | Get this ledger's root account, which is a dummy "root" account
|
|
|
|
-- above all others. This should always be first in the account list,
|
|
|
|
-- if somehow not this returns a null account.
|
|
|
|
ledgerRootAccount :: Ledger -> Account
|
|
|
|
ledgerRootAccount = headDef nullacct . laccounts
|
2008-10-11 08:17:52 +04:00
|
|
|
|
2012-10-21 21:18:18 +04:00
|
|
|
-- | List a ledger's top-level accounts (the ones below the root), in tree order.
|
2009-04-05 02:38:18 +04:00
|
|
|
ledgerTopAccounts :: Ledger -> [Account]
|
2012-10-21 21:18:18 +04:00
|
|
|
ledgerTopAccounts = asubs . head . laccounts
|
2008-10-11 08:17:52 +04:00
|
|
|
|
2012-10-21 21:18:18 +04:00
|
|
|
-- | List a ledger's bottom-level (subaccount-less) accounts, in tree order.
|
2011-08-07 19:31:36 +04:00
|
|
|
ledgerLeafAccounts :: Ledger -> [Account]
|
2012-10-21 21:18:18 +04:00
|
|
|
ledgerLeafAccounts = filter (null.asubs) . laccounts
|
2011-08-07 19:31:36 +04:00
|
|
|
|
2008-10-15 10:32:42 +04:00
|
|
|
-- | Accounts in ledger whose name matches the pattern, in tree order.
|
2009-04-05 02:38:18 +04:00
|
|
|
ledgerAccountsMatching :: [String] -> Ledger -> [Account]
|
2012-10-21 21:18:18 +04:00
|
|
|
ledgerAccountsMatching pats = filter (matchpats pats . aname) . laccounts
|
2008-10-11 08:17:52 +04:00
|
|
|
|
2009-12-19 08:57:54 +03:00
|
|
|
-- | List a ledger's postings, in the order parsed.
|
|
|
|
ledgerPostings :: Ledger -> [Posting]
|
2012-10-21 21:18:18 +04:00
|
|
|
ledgerPostings = journalPostings . ljournal
|
2008-12-04 02:20:38 +03:00
|
|
|
|
2009-05-29 14:02:14 +04:00
|
|
|
-- | The (fully specified) date span containing all the ledger's (filtered) transactions,
|
2009-04-04 15:19:15 +04:00
|
|
|
-- or DateSpan Nothing Nothing if there are none.
|
|
|
|
ledgerDateSpan :: Ledger -> DateSpan
|
2009-12-21 09:03:34 +03:00
|
|
|
ledgerDateSpan = postingsDateSpan . ledgerPostings
|
2009-04-05 02:38:18 +04:00
|
|
|
|
2012-11-20 01:20:10 +04:00
|
|
|
-- | All commodities used in this ledger.
|
|
|
|
ledgerCommodities :: Ledger -> [Commodity]
|
|
|
|
ledgerCommodities = M.keys . jcommoditystyles . ljournal
|
2010-12-27 23:26:22 +03:00
|
|
|
|
|
|
|
|
2012-10-21 21:18:18 +04:00
|
|
|
tests_ledgerFromJournal = [
|
|
|
|
"ledgerFromJournal" ~: do
|
|
|
|
assertEqual "" (0) (length $ ledgerPostings $ ledgerFromJournal Any nulljournal)
|
|
|
|
assertEqual "" (11) (length $ ledgerPostings $ ledgerFromJournal Any samplejournal)
|
|
|
|
assertEqual "" (6) (length $ ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal)
|
|
|
|
]
|
|
|
|
|
|
|
|
tests_Hledger_Data_Ledger = TestList $
|
|
|
|
tests_ledgerFromJournal
|