{-# LANGUAGE OverloadedStrings #-}
module Hledger.Data.Ledger (
nullledger
,ledgerFromJournal
,ledgerAccountNames
,ledgerAccount
,ledgerRootAccount
,ledgerTopAccounts
,ledgerLeafAccounts
,ledgerPostings
,ledgerDateSpan
,ledgerCommodities
,tests_Ledger
)
where
import qualified Data.Map as M
import Safe (headDef)
import Text.Printf
import Test.Tasty (testGroup)
import Test.Tasty.HUnit ((@?=), testCase)
import Hledger.Data.Types
import Hledger.Data.Account
import Hledger.Data.Journal
import Hledger.Query
instance Show Ledger where
show :: Ledger -> String
show Ledger
l = forall r. PrintfType r => String -> r
printf String
"Ledger with %d transactions, %d accounts\n"
(forall (t :: * -> *) a. Foldable t => t a -> Int
length (Journal -> [Transaction]
jtxns forall a b. (a -> b) -> a -> b
$ Ledger -> Journal
ljournal Ledger
l) forall a. Num a => a -> a -> a
+
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Journal -> [TransactionModifier]
jtxnmodifiers forall a b. (a -> b) -> a -> b
$ Ledger -> Journal
ljournal Ledger
l) forall a. Num a => a -> a -> a
+
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Journal -> [PeriodicTransaction]
jperiodictxns forall a b. (a -> b) -> a -> b
$ Ledger -> Journal
ljournal Ledger
l))
(forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Ledger -> [AccountName]
ledgerAccountNames Ledger
l)
nullledger :: Ledger
nullledger :: Ledger
nullledger = Ledger {
ljournal :: Journal
ljournal = Journal
nulljournal,
laccounts :: [Account]
laccounts = []
}
ledgerFromJournal :: Query -> Journal -> Ledger
ledgerFromJournal :: Query -> Journal -> Ledger
ledgerFromJournal Query
q Journal
j = Ledger
nullledger{ljournal :: Journal
ljournal=Journal
j'', laccounts :: [Account]
laccounts=[Account]
as}
where
(Query
q',Query
depthq) = ((Query -> Bool) -> Query -> Query
filterQuery (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Bool
queryIsDepth) Query
q, (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsDepth Query
q)
j' :: Journal
j' = Query -> Journal -> Journal
filterJournalAmounts ((Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsSym Query
q) forall a b. (a -> b) -> a -> b
$
Query -> Journal -> Journal
filterJournalPostings Query
q' Journal
j
as :: [Account]
as = [Posting] -> [Account]
accountsFromPostings forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j'
j'' :: Journal
j'' = Query -> Journal -> Journal
filterJournalPostings Query
depthq Journal
j'
ledgerAccountNames :: Ledger -> [AccountName]
ledgerAccountNames :: Ledger -> [AccountName]
ledgerAccountNames = forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Account -> AccountName
aname forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> [Account]
laccounts
ledgerAccount :: Ledger -> AccountName -> Maybe Account
ledgerAccount :: Ledger -> AccountName -> Maybe Account
ledgerAccount Ledger
l AccountName
a = AccountName -> [Account] -> Maybe Account
lookupAccount AccountName
a forall a b. (a -> b) -> a -> b
$ Ledger -> [Account]
laccounts Ledger
l
ledgerRootAccount :: Ledger -> Account
ledgerRootAccount :: Ledger -> Account
ledgerRootAccount = forall a. a -> [a] -> a
headDef Account
nullacct forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> [Account]
laccounts
ledgerTopAccounts :: Ledger -> [Account]
ledgerTopAccounts :: Ledger -> [Account]
ledgerTopAccounts = Account -> [Account]
asubs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> [Account]
laccounts
ledgerLeafAccounts :: Ledger -> [Account]
ledgerLeafAccounts :: Ledger -> [Account]
ledgerLeafAccounts = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => t a -> Bool
nullforall b c a. (b -> c) -> (a -> b) -> a -> c
.Account -> [Account]
asubs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> [Account]
laccounts
ledgerPostings :: Ledger -> [Posting]
ledgerPostings :: Ledger -> [Posting]
ledgerPostings = Journal -> [Posting]
journalPostings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> Journal
ljournal
ledgerDateSpan :: Ledger -> DateSpan
ledgerDateSpan :: Ledger -> DateSpan
ledgerDateSpan = Journal -> DateSpan
journalDateSpanBothDates forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> Journal
ljournal
ledgerCommodities :: Ledger -> [CommoditySymbol]
ledgerCommodities :: Ledger -> [AccountName]
ledgerCommodities = forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Map AccountName AmountStyle
jinferredcommodities forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> Journal
ljournal
tests_Ledger :: TestTree
tests_Ledger =
String -> [TestTree] -> TestTree
testGroup String
"Ledger" [
String -> Assertion -> TestTree
testCase String
"ledgerFromJournal" forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Ledger -> [Posting]
ledgerPostings forall a b. (a -> b) -> a -> b
$ Query -> Journal -> Ledger
ledgerFromJournal Query
Any Journal
nulljournal) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
0
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Ledger -> [Posting]
ledgerPostings forall a b. (a -> b) -> a -> b
$ Query -> Journal -> Ledger
ledgerFromJournal Query
Any Journal
samplejournal) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
13
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Ledger -> [Posting]
ledgerPostings forall a b. (a -> b) -> a -> b
$ Query -> Journal -> Ledger
ledgerFromJournal (Int -> Query
Depth Int
2) Journal
samplejournal) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
7
]