    {-|

    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 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 = String -> Int -> Int -> String
    forall r. PrintfType r => String -> r
    printf String
    "Ledger with %d transactions, %d accounts\n" --"%s"
                 ([Transaction] -> Int
    forall a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 {
      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. HasCallStack => [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 a. [a] -> 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 = Journal -> DateSpan
    journalDateSpanBothDates (Journal -> DateSpan) -> (Ledger -> Journal) -> Ledger -> DateSpan
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ledger -> Journal
    ljournal

    -- | 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
    testGroup String
    "Ledger" [
        String -> Assertion -> TestTree
    testCase String
    "ledgerFromJournal" (Assertion -> TestTree) -> Assertion -> TestTree
    forall a b. (a -> b) -> a -> b
    $ do
            [Posting] -> Int
    forall a. [a] -> 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 a. [a] -> 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 a. [a] -> 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
      ]