{-# LANGUAGE OverloadedStrings #-}
module Hledger.Data.Ledger (
nullledger
,ledgerFromJournal
,ledgerAccountNames
,ledgerAccount
,ledgerRootAccount
,ledgerTopAccounts
,ledgerLeafAccounts
,ledgerAccountsMatching
,ledgerPostings
,ledgerDateSpan
,ledgerCommodities
,tests_Ledger
)
where
import qualified Data.Map as M
import qualified Data.Text as T
import Safe (headDef)
import Text.Printf
import Hledger.Utils.Test
import Hledger.Data.Types
import Hledger.Data.Account
import Hledger.Data.Journal
import Hledger.Data.Posting
import Hledger.Query
instance Show Ledger where
show l = printf "Ledger with %d transactions, %d accounts\n"
(length (jtxns $ ljournal l) +
length (jtxnmodifiers $ ljournal l) +
length (jperiodictxns $ ljournal l))
(length $ ledgerAccountNames l)
nullledger :: Ledger
nullledger = Ledger {
ljournal = nulljournal,
laccounts = []
}
ledgerFromJournal :: Query -> Journal -> Ledger
ledgerFromJournal q j = nullledger{ljournal=j'', laccounts=as}
where
(q',depthq) = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q)
j' = filterJournalAmounts (filterQuery queryIsSym q) $
filterJournalPostings q' j
as = accountsFromPostings $ journalPostings j'
j'' = filterJournalPostings depthq j'
ledgerAccountNames :: Ledger -> [AccountName]
ledgerAccountNames = drop 1 . map aname . laccounts
ledgerAccount :: Ledger -> AccountName -> Maybe Account
ledgerAccount l a = lookupAccount a $ laccounts l
ledgerRootAccount :: Ledger -> Account
ledgerRootAccount = headDef nullacct . laccounts
ledgerTopAccounts :: Ledger -> [Account]
ledgerTopAccounts = asubs . head . laccounts
ledgerLeafAccounts :: Ledger -> [Account]
ledgerLeafAccounts = filter (null.asubs) . laccounts
ledgerAccountsMatching :: [String] -> Ledger -> [Account]
ledgerAccountsMatching pats = filter (matchpats pats . T.unpack . aname) . laccounts
ledgerPostings :: Ledger -> [Posting]
ledgerPostings = journalPostings . ljournal
ledgerDateSpan :: Ledger -> DateSpan
ledgerDateSpan = postingsDateSpan . ledgerPostings
ledgerCommodities :: Ledger -> [CommoditySymbol]
ledgerCommodities = M.keys . jinferredcommodities . ljournal
tests_Ledger = tests "Ledger" [
tests "ledgerFromJournal" [
(length $ ledgerPostings $ ledgerFromJournal Any nulljournal) `is` 0
,(length $ ledgerPostings $ ledgerFromJournal Any samplejournal) `is` 13
,(length $ ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) `is` 7
]
]