{-|

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.

-}

{-# 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 Hledger.Utils.Test
import Hledger.Data.Types
import Hledger.Data.Account
import Hledger.Data.Dates (daysSpan)
import Hledger.Data.Journal
import Hledger.Data.Posting (postingDate)
import Hledger.Query


instance Show Ledger where
    show :: Ledger -> String
show Ledger
l = String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Ledger with %d transactions, %d accounts\n" --"%s"
             ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Journal -> [Transaction]
jtxns (Journal -> [Transaction]) -> Journal -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Ledger -> Journal
ljournal Ledger
l) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
              [TransactionModifier] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Journal -> [TransactionModifier]
jtxnmodifiers (Journal -> [TransactionModifier])
-> Journal -> [TransactionModifier]
forall a b. (a -> b) -> a -> b
$ Ledger -> Journal
ljournal Ledger
l) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
              [PeriodicTransaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Journal -> [PeriodicTransaction]
jperiodictxns (Journal -> [PeriodicTransaction])
-> Journal -> [PeriodicTransaction]
forall a b. (a -> b) -> a -> b
$ Ledger -> Journal
ljournal Ledger
l))
             ([AccountName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([AccountName] -> Int) -> [AccountName] -> Int
forall a b. (a -> b) -> a -> b
$ Ledger -> [AccountName]
ledgerAccountNames Ledger
l)
             -- (showtree $ ledgerAccountNameTree l)

nullledger :: Ledger
nullledger :: Ledger
nullledger = Ledger :: Journal -> [Account] -> Ledger
Ledger {
  ljournal :: Journal
ljournal = Journal
nulljournal,
  laccounts :: [Account]
laccounts = []
  }

-- | Filter a journal's transactions with the given query, then build
-- a "Ledger", containing the journal plus the tree of all its
-- accounts with their subaccount-inclusive and subaccount-exclusive
-- balances. If the query includes a depth limit, the ledger's journal
-- will be depth limited, but the ledger's account tree will not.
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 (Bool -> Bool) -> (Query -> Bool) -> Query -> Bool
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) (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$ -- remove amount parts which the query's sym: terms would exclude
          Query -> Journal -> Journal
filterJournalPostings Query
q' Journal
j
    as :: [Account]
as  = [Posting] -> [Account]
accountsFromPostings ([Posting] -> [Account]) -> [Posting] -> [Account]
forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j'
    j'' :: Journal
j'' = Query -> Journal -> Journal
filterJournalPostings Query
depthq Journal
j'

-- | List a ledger's account names.
ledgerAccountNames :: Ledger -> [AccountName]
ledgerAccountNames :: Ledger -> [AccountName]
ledgerAccountNames = Int -> [AccountName] -> [AccountName]
forall a. Int -> [a] -> [a]
drop Int
1 ([AccountName] -> [AccountName])
-> (Ledger -> [AccountName]) -> Ledger -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Account -> AccountName) -> [Account] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map Account -> AccountName
aname ([Account] -> [AccountName])
-> (Ledger -> [Account]) -> Ledger -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> [Account]
laccounts

-- | Get the named account from a ledger.
ledgerAccount :: Ledger -> AccountName -> Maybe Account
ledgerAccount :: Ledger -> AccountName -> Maybe Account
ledgerAccount Ledger
l AccountName
a = AccountName -> [Account] -> Maybe Account
lookupAccount AccountName
a ([Account] -> Maybe Account) -> [Account] -> Maybe Account
forall a b. (a -> b) -> a -> b
$ Ledger -> [Account]
laccounts Ledger
l

-- | 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 :: Ledger -> Account
ledgerRootAccount = Account -> [Account] -> Account
forall a. a -> [a] -> a
headDef Account
nullacct ([Account] -> Account)
-> (Ledger -> [Account]) -> Ledger -> Account
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> [Account]
laccounts

-- | List a ledger's top-level accounts (the ones below the root), in tree order.
ledgerTopAccounts :: Ledger -> [Account]
ledgerTopAccounts :: Ledger -> [Account]
ledgerTopAccounts = Account -> [Account]
asubs (Account -> [Account])
-> (Ledger -> Account) -> Ledger -> [Account]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Account] -> Account
forall a. [a] -> a
head ([Account] -> Account)
-> (Ledger -> [Account]) -> Ledger -> Account
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> [Account]
laccounts

-- | List a ledger's bottom-level (subaccount-less) accounts, in tree order.
ledgerLeafAccounts :: Ledger -> [Account]
ledgerLeafAccounts :: Ledger -> [Account]
ledgerLeafAccounts = (Account -> Bool) -> [Account] -> [Account]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Account] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([Account] -> Bool) -> (Account -> [Account]) -> Account -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Account -> [Account]
asubs) ([Account] -> [Account])
-> (Ledger -> [Account]) -> Ledger -> [Account]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> [Account]
laccounts

-- | List a ledger's postings, in the order parsed.
ledgerPostings :: Ledger -> [Posting]
ledgerPostings :: Ledger -> [Posting]
ledgerPostings = Journal -> [Posting]
journalPostings (Journal -> [Posting])
-> (Ledger -> Journal) -> Ledger -> [Posting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> Journal
ljournal

-- | The (fully specified) date span containing all the ledger's (filtered) transactions,
-- or DateSpan Nothing Nothing if there are none.
ledgerDateSpan :: Ledger -> DateSpan
ledgerDateSpan :: Ledger -> DateSpan
ledgerDateSpan = [Day] -> DateSpan
daysSpan ([Day] -> DateSpan) -> (Ledger -> [Day]) -> Ledger -> DateSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> Day) -> [Posting] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Day
postingDate ([Posting] -> [Day]) -> (Ledger -> [Posting]) -> Ledger -> [Day]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> [Posting]
ledgerPostings

-- | All commodities used in this ledger.
ledgerCommodities :: Ledger -> [CommoditySymbol]
ledgerCommodities :: Ledger -> [AccountName]
ledgerCommodities = Map AccountName AmountStyle -> [AccountName]
forall k a. Map k a -> [k]
M.keys (Map AccountName AmountStyle -> [AccountName])
-> (Ledger -> Map AccountName AmountStyle)
-> Ledger
-> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Map AccountName AmountStyle
jinferredcommodities (Journal -> Map AccountName AmountStyle)
-> (Ledger -> Journal) -> Ledger -> Map AccountName AmountStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ledger -> Journal
ljournal

-- tests

tests_Ledger :: TestTree
tests_Ledger =
  String -> [TestTree] -> TestTree
tests String
"Ledger" [
    String -> Assertion -> TestTree
test String
"ledgerFromJournal" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        [Posting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Ledger -> [Posting]
ledgerPostings (Ledger -> [Posting]) -> Ledger -> [Posting]
forall a b. (a -> b) -> a -> b
$ Query -> Journal -> Ledger
ledgerFromJournal Query
Any Journal
nulljournal) Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
0
        [Posting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Ledger -> [Posting]
ledgerPostings (Ledger -> [Posting]) -> Ledger -> [Posting]
forall a b. (a -> b) -> a -> b
$ Query -> Journal -> Ledger
ledgerFromJournal Query
Any Journal
samplejournal) Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
13
        [Posting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Ledger -> [Posting]
ledgerPostings (Ledger -> [Posting]) -> Ledger -> [Posting]
forall a b. (a -> b) -> a -> b
$ Query -> Journal -> Ledger
ledgerFromJournal (Int -> Query
Depth Int
2) Journal
samplejournal) Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
7
  ]