{-# LANGUAGE CPP                 #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|


An 'Account' has a name, a list of subaccounts, an optional parent
account, and subaccounting-excluding and -including balances.

-}

module Hledger.Data.Account
( nullacct
, accountFromBalances
, accountFromPostings
, accountsFromPostings
, accountTree
, accountTreeFromBalanceAndNames
, showAccounts
, showAccountsBoringFlag
, printAccounts
, lookupAccount
, parentAccounts
, accountsLevels
, mapAccounts
, mapPeriodData
, anyAccounts
, filterAccounts
, sumAccounts
, clipAccounts
, clipAccountsAndAggregate
, pruneAccounts
, flattenAccounts
, mergeAccounts
, accountSetDeclarationInfo
, sortAccountNamesByDeclaration
, sortAccountTreeByDeclaration
, sortAccountTreeOn
-- -- * Tests
, tests_Account
) where

import Control.Applicative ((<|>))
import qualified Data.HashSet as HS
import qualified Data.HashMap.Strict as HM
import qualified Data.IntMap as IM
import Data.List (find, sortOn)
#if !MIN_VERSION_base(4,20,0)
import Data.List (foldl')
#endif
import Data.List.NonEmpty (NonEmpty(..), groupWith)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.These (These(..))
import Data.Time (Day(..), fromGregorian)
import Safe (headMay)
import Text.Printf (printf)

import Hledger.Data.BalanceData ()
import Hledger.Data.PeriodData
import Hledger.Data.AccountName
import Hledger.Data.Amount
import Hledger.Data.Types
import Hledger.Utils


-- deriving instance Show Account
instance Show a => Show (Account a) where
  showsPrec :: Int -> Account a -> ShowS
showsPrec Int
d Account a
acct =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
       String -> ShowS
showString String
"Account "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (AccountName -> String
T.unpack (AccountName -> String) -> AccountName -> String
forall a b. (a -> b) -> a -> b
$ Account a -> AccountName
forall a. Account a -> AccountName
aname Account a
acct)
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" (boring:"
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (if Account a -> Bool
forall a. Account a -> Bool
aboring Account a
acct then String
"y" else String
"n")
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", adata:"
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodData a -> ShowS
forall a. Show a => a -> ShowS
shows (Account a -> PeriodData a
forall a. Account a -> PeriodData a
adata Account a
acct)
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'

instance Eq (Account a) where
  == :: Account a -> Account a -> Bool
(==) Account a
a Account a
b = Account a -> AccountName
forall a. Account a -> AccountName
aname Account a
a AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== Account a -> AccountName
forall a. Account a -> AccountName
aname Account a
b -- quick equality test for speed
             -- and
             -- [ aname a == aname b
             -- -- , aparent a == aparent b  -- avoid infinite recursion
             -- , asubs a == asubs b
             -- , aebalance a == aebalance b
             -- , aibalance a == aibalance b
             -- ]

nullacct :: Account BalanceData
nullacct :: Account BalanceData
nullacct = AccountName -> PeriodData BalanceData -> Account BalanceData
forall a. AccountName -> PeriodData a -> Account a
accountFromBalances AccountName
"" PeriodData BalanceData
forall a. Monoid a => a
mempty

-- | Construct an 'Account" from an account name and balances. Other fields are
-- left blank.
accountFromBalances :: AccountName -> PeriodData a -> Account a
accountFromBalances :: forall a. AccountName -> PeriodData a -> Account a
accountFromBalances AccountName
name PeriodData a
bal = Account
  { aname :: AccountName
aname            = AccountName
name
  , adeclarationinfo :: Maybe AccountDeclarationInfo
adeclarationinfo = Maybe AccountDeclarationInfo
forall a. Maybe a
Nothing
  , asubs :: [Account a]
asubs            = []
  , aparent :: Maybe (Account a)
aparent          = Maybe (Account a)
forall a. Maybe a
Nothing
  , aboring :: Bool
aboring          = Bool
False
  , adata :: PeriodData a
adata            = PeriodData a
bal
  }

-- | Derive 1. an account tree and 2. each account's total exclusive and
-- inclusive changes associated with dates from a list of postings and a
-- function for associating a date to each posting (usually representing the
-- start dates of report subperiods).
-- This is the core of the balance command (and of *ledger).
-- The accounts are returned as a list in flattened tree order,
-- and also reference each other as a tree.
-- (The first account is the root of the tree.)
accountsFromPostings :: (Posting -> Maybe Day) -> [Posting] -> [Account BalanceData]
accountsFromPostings :: (Posting -> Maybe Day) -> [Posting] -> [Account BalanceData]
accountsFromPostings Posting -> Maybe Day
getPostingDate = Account BalanceData -> [Account BalanceData]
forall a. Account a -> [Account a]
flattenAccounts (Account BalanceData -> [Account BalanceData])
-> ([Posting] -> Account BalanceData)
-> [Posting]
-> [Account BalanceData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> Maybe Day) -> [Posting] -> Account BalanceData
accountFromPostings Posting -> Maybe Day
getPostingDate

-- | Derive 1. an account tree and 2. each account's total exclusive
-- and inclusive changes associated with dates from a list of postings and a
-- function for associating a date to each posting (usually representing the
-- start dates of report subperiods).
-- This is the core of the balance command (and of *ledger).
-- The accounts are returned as a tree.
accountFromPostings :: (Posting -> Maybe Day) -> [Posting] -> Account BalanceData
accountFromPostings :: (Posting -> Maybe Day) -> [Posting] -> Account BalanceData
accountFromPostings Posting -> Maybe Day
getPostingDate [Posting]
ps =
    Account BalanceData -> Account BalanceData
forall a. Account a -> Account a
tieAccountParents (Account BalanceData -> Account BalanceData)
-> (Account BalanceData -> Account BalanceData)
-> Account BalanceData
-> Account BalanceData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account BalanceData -> Account BalanceData
sumAccounts (Account BalanceData -> Account BalanceData)
-> Account BalanceData -> Account BalanceData
forall a b. (a -> b) -> a -> b
$ (Account BalanceData -> Account BalanceData)
-> Account BalanceData -> Account BalanceData
forall a. (Account a -> Account a) -> Account a -> Account a
mapAccounts Account BalanceData -> Account BalanceData
setBalance Account BalanceData
acctTree
  where
    -- The special name "..." is stored in the root of the tree
    acctTree :: Account BalanceData
acctTree     = AccountName -> [AccountName] -> Account BalanceData
forall a. Monoid a => AccountName -> [AccountName] -> Account a
accountTree AccountName
"root" ([AccountName] -> Account BalanceData)
-> (HashMap AccountName (PeriodData BalanceData) -> [AccountName])
-> HashMap AccountName (PeriodData BalanceData)
-> Account BalanceData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap AccountName (PeriodData BalanceData) -> [AccountName]
forall k v. HashMap k v -> [k]
HM.keys (HashMap AccountName (PeriodData BalanceData)
 -> Account BalanceData)
-> HashMap AccountName (PeriodData BalanceData)
-> Account BalanceData
forall a b. (a -> b) -> a -> b
$ AccountName
-> HashMap AccountName (PeriodData BalanceData)
-> HashMap AccountName (PeriodData BalanceData)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete AccountName
"..." HashMap AccountName (PeriodData BalanceData)
accountMap
    setBalance :: Account BalanceData -> Account BalanceData
setBalance Account BalanceData
a = Account BalanceData
a{adata = HM.lookupDefault mempty name accountMap}
      where name :: AccountName
name = if Account BalanceData -> AccountName
forall a. Account a -> AccountName
aname Account BalanceData
a AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== AccountName
"root" then AccountName
"..." else Account BalanceData -> AccountName
forall a. Account a -> AccountName
aname Account BalanceData
a
    accountMap :: HashMap AccountName (PeriodData BalanceData)
accountMap   = [Posting] -> HashMap AccountName (PeriodData BalanceData)
processPostings [Posting]
ps

    processPostings :: [Posting] -> HM.HashMap AccountName (PeriodData BalanceData)
    processPostings :: [Posting] -> HashMap AccountName (PeriodData BalanceData)
processPostings = (HashMap AccountName (PeriodData BalanceData)
 -> Posting -> HashMap AccountName (PeriodData BalanceData))
-> HashMap AccountName (PeriodData BalanceData)
-> [Posting]
-> HashMap AccountName (PeriodData BalanceData)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Posting
 -> HashMap AccountName (PeriodData BalanceData)
 -> HashMap AccountName (PeriodData BalanceData))
-> HashMap AccountName (PeriodData BalanceData)
-> Posting
-> HashMap AccountName (PeriodData BalanceData)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Posting
-> HashMap AccountName (PeriodData BalanceData)
-> HashMap AccountName (PeriodData BalanceData)
processAccountName) HashMap AccountName (PeriodData BalanceData)
forall a. Monoid a => a
mempty
      where
        processAccountName :: Posting
-> HashMap AccountName (PeriodData BalanceData)
-> HashMap AccountName (PeriodData BalanceData)
processAccountName Posting
p = (Maybe (PeriodData BalanceData) -> Maybe (PeriodData BalanceData))
-> AccountName
-> HashMap AccountName (PeriodData BalanceData)
-> HashMap AccountName (PeriodData BalanceData)
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter (Posting
-> Maybe (PeriodData BalanceData) -> Maybe (PeriodData BalanceData)
updateBalanceData Posting
p) (Posting -> AccountName
paccount Posting
p)
        updateBalanceData :: Posting
-> Maybe (PeriodData BalanceData) -> Maybe (PeriodData BalanceData)
updateBalanceData Posting
p = PeriodData BalanceData -> Maybe (PeriodData BalanceData)
forall a. a -> Maybe a
Just
                            (PeriodData BalanceData -> Maybe (PeriodData BalanceData))
-> (Maybe (PeriodData BalanceData) -> PeriodData BalanceData)
-> Maybe (PeriodData BalanceData)
-> Maybe (PeriodData BalanceData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Day
-> BalanceData -> PeriodData BalanceData -> PeriodData BalanceData
forall a.
Semigroup a =>
Maybe Day -> a -> PeriodData a -> PeriodData a
insertPeriodData (Posting -> Maybe Day
getPostingDate Posting
p) (MixedAmount -> MixedAmount -> Int -> BalanceData
BalanceData (Posting -> MixedAmount
pamount Posting
p) MixedAmount
nullmixedamt Int
1)
                            (PeriodData BalanceData -> PeriodData BalanceData)
-> (Maybe (PeriodData BalanceData) -> PeriodData BalanceData)
-> Maybe (PeriodData BalanceData)
-> PeriodData BalanceData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodData BalanceData
-> Maybe (PeriodData BalanceData) -> PeriodData BalanceData
forall a. a -> Maybe a -> a
fromMaybe PeriodData BalanceData
forall a. Monoid a => a
mempty

-- | Convert a list of account names to a tree of Account objects,
-- with just the account names filled in and an empty balance.
-- A single root account with the given name is added.
accountTree :: Monoid a => AccountName -> [AccountName] -> Account a
accountTree :: forall a. Monoid a => AccountName -> [AccountName] -> Account a
accountTree AccountName
rootname = AccountName -> PeriodData a -> [AccountName] -> Account a
forall a. AccountName -> PeriodData a -> [AccountName] -> Account a
accountTreeFromBalanceAndNames AccountName
rootname PeriodData a
forall a. Monoid a => a
mempty

-- | Convert a list of account names to a tree of Account objects,
-- with just the account names filled in. Each account is given the same
-- supplied balance.
-- A single root account with the given name is added.
accountTreeFromBalanceAndNames :: AccountName -> PeriodData a -> [AccountName] -> Account a
accountTreeFromBalanceAndNames :: forall a. AccountName -> PeriodData a -> [AccountName] -> Account a
accountTreeFromBalanceAndNames AccountName
rootname PeriodData a
bals [AccountName]
as =
    (AccountName -> PeriodData a -> Account a
forall a. AccountName -> PeriodData a -> Account a
accountFromBalances AccountName
rootname PeriodData a
bals){ asubs=map (uncurry accountTree') $ M.assocs m }
  where
    T Map AccountName (FastTree AccountName)
m = [[AccountName]] -> FastTree AccountName
forall a. Ord a => [[a]] -> FastTree a
treeFromPaths ([[AccountName]] -> FastTree AccountName)
-> [[AccountName]] -> FastTree AccountName
forall a b. (a -> b) -> a -> b
$ (AccountName -> [AccountName]) -> [AccountName] -> [[AccountName]]
forall a b. (a -> b) -> [a] -> [b]
map AccountName -> [AccountName]
expandAccountName [AccountName]
as :: FastTree AccountName
    accountTree' :: AccountName -> FastTree AccountName -> Account a
accountTree' AccountName
a (T Map AccountName (FastTree AccountName)
m') =
      (AccountName -> PeriodData a -> Account a
forall a. AccountName -> PeriodData a -> Account a
accountFromBalances AccountName
a PeriodData a
bals){ asubs=map (uncurry accountTree') $ M.assocs m' }

-- | An efficient-to-build tree suggested by Cale Gibbard, probably
-- better than accountNameTreeFrom.
newtype FastTree a = T (M.Map a (FastTree a))
  deriving (Int -> FastTree a -> ShowS
[FastTree a] -> ShowS
FastTree a -> String
(Int -> FastTree a -> ShowS)
-> (FastTree a -> String)
-> ([FastTree a] -> ShowS)
-> Show (FastTree a)
forall a. Show a => Int -> FastTree a -> ShowS
forall a. Show a => [FastTree a] -> ShowS
forall a. Show a => FastTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> FastTree a -> ShowS
showsPrec :: Int -> FastTree a -> ShowS
$cshow :: forall a. Show a => FastTree a -> String
show :: FastTree a -> String
$cshowList :: forall a. Show a => [FastTree a] -> ShowS
showList :: [FastTree a] -> ShowS
Show, FastTree a -> FastTree a -> Bool
(FastTree a -> FastTree a -> Bool)
-> (FastTree a -> FastTree a -> Bool) -> Eq (FastTree a)
forall a. Eq a => FastTree a -> FastTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => FastTree a -> FastTree a -> Bool
== :: FastTree a -> FastTree a -> Bool
$c/= :: forall a. Eq a => FastTree a -> FastTree a -> Bool
/= :: FastTree a -> FastTree a -> Bool
Eq, Eq (FastTree a)
Eq (FastTree a) =>
(FastTree a -> FastTree a -> Ordering)
-> (FastTree a -> FastTree a -> Bool)
-> (FastTree a -> FastTree a -> Bool)
-> (FastTree a -> FastTree a -> Bool)
-> (FastTree a -> FastTree a -> Bool)
-> (FastTree a -> FastTree a -> FastTree a)
-> (FastTree a -> FastTree a -> FastTree a)
-> Ord (FastTree a)
FastTree a -> FastTree a -> Bool
FastTree a -> FastTree a -> Ordering
FastTree a -> FastTree a -> FastTree a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (FastTree a)
forall a. Ord a => FastTree a -> FastTree a -> Bool
forall a. Ord a => FastTree a -> FastTree a -> Ordering
forall a. Ord a => FastTree a -> FastTree a -> FastTree a
$ccompare :: forall a. Ord a => FastTree a -> FastTree a -> Ordering
compare :: FastTree a -> FastTree a -> Ordering
$c< :: forall a. Ord a => FastTree a -> FastTree a -> Bool
< :: FastTree a -> FastTree a -> Bool
$c<= :: forall a. Ord a => FastTree a -> FastTree a -> Bool
<= :: FastTree a -> FastTree a -> Bool
$c> :: forall a. Ord a => FastTree a -> FastTree a -> Bool
> :: FastTree a -> FastTree a -> Bool
$c>= :: forall a. Ord a => FastTree a -> FastTree a -> Bool
>= :: FastTree a -> FastTree a -> Bool
$cmax :: forall a. Ord a => FastTree a -> FastTree a -> FastTree a
max :: FastTree a -> FastTree a -> FastTree a
$cmin :: forall a. Ord a => FastTree a -> FastTree a -> FastTree a
min :: FastTree a -> FastTree a -> FastTree a
Ord)

mergeTrees :: (Ord a) => FastTree a -> FastTree a -> FastTree a
mergeTrees :: forall a. Ord a => FastTree a -> FastTree a -> FastTree a
mergeTrees (T Map a (FastTree a)
m) (T Map a (FastTree a)
m') = Map a (FastTree a) -> FastTree a
forall a. Map a (FastTree a) -> FastTree a
T ((FastTree a -> FastTree a -> FastTree a)
-> Map a (FastTree a) -> Map a (FastTree a) -> Map a (FastTree a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith FastTree a -> FastTree a -> FastTree a
forall a. Ord a => FastTree a -> FastTree a -> FastTree a
mergeTrees Map a (FastTree a)
m Map a (FastTree a)
m')

treeFromPath :: [a] -> FastTree a
treeFromPath :: forall a. [a] -> FastTree a
treeFromPath []     = Map a (FastTree a) -> FastTree a
forall a. Map a (FastTree a) -> FastTree a
T Map a (FastTree a)
forall k a. Map k a
M.empty
treeFromPath (a
x:[a]
xs) = Map a (FastTree a) -> FastTree a
forall a. Map a (FastTree a) -> FastTree a
T (a -> FastTree a -> Map a (FastTree a)
forall k a. k -> a -> Map k a
M.singleton a
x ([a] -> FastTree a
forall a. [a] -> FastTree a
treeFromPath [a]
xs))

treeFromPaths :: (Ord a) => [[a]] -> FastTree a
treeFromPaths :: forall a. Ord a => [[a]] -> FastTree a
treeFromPaths = (FastTree a -> FastTree a -> FastTree a)
-> FastTree a -> [FastTree a] -> FastTree a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' FastTree a -> FastTree a -> FastTree a
forall a. Ord a => FastTree a -> FastTree a -> FastTree a
mergeTrees (Map a (FastTree a) -> FastTree a
forall a. Map a (FastTree a) -> FastTree a
T Map a (FastTree a)
forall k a. Map k a
M.empty) ([FastTree a] -> FastTree a)
-> ([[a]] -> [FastTree a]) -> [[a]] -> FastTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> FastTree a) -> [[a]] -> [FastTree a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> FastTree a
forall a. [a] -> FastTree a
treeFromPath


-- | Tie the knot so all subaccounts' parents are set correctly.
tieAccountParents :: Account a -> Account a
tieAccountParents :: forall a. Account a -> Account a
tieAccountParents = Maybe (Account a) -> Account a -> Account a
forall {a}. Maybe (Account a) -> Account a -> Account a
tie Maybe (Account a)
forall a. Maybe a
Nothing
  where
    tie :: Maybe (Account a) -> Account a -> Account a
tie Maybe (Account a)
parent a :: Account a
a@Account{Bool
[Account a]
Maybe (Account a)
Maybe AccountDeclarationInfo
AccountName
PeriodData a
aname :: forall a. Account a -> AccountName
aboring :: forall a. Account a -> Bool
adata :: forall a. Account a -> PeriodData a
adeclarationinfo :: forall a. Account a -> Maybe AccountDeclarationInfo
asubs :: forall a. Account a -> [Account a]
aparent :: forall a. Account a -> Maybe (Account a)
aname :: AccountName
adeclarationinfo :: Maybe AccountDeclarationInfo
asubs :: [Account a]
aparent :: Maybe (Account a)
aboring :: Bool
adata :: PeriodData a
..} = Account a
a'
      where
        a' :: Account a
a' = Account a
a{aparent=parent, asubs=map (tie (Just a')) asubs}

-- | Get this account's parent accounts, from the nearest up to the root.
parentAccounts :: Account a -> [Account a]
parentAccounts :: forall a. Account a -> [Account a]
parentAccounts Account{aparent :: forall a. Account a -> Maybe (Account a)
aparent=Maybe (Account a)
Nothing} = []
parentAccounts Account{aparent :: forall a. Account a -> Maybe (Account a)
aparent=Just Account a
a} = Account a
aAccount a -> [Account a] -> [Account a]
forall a. a -> [a] -> [a]
:Account a -> [Account a]
forall a. Account a -> [Account a]
parentAccounts Account a
a

-- | List the accounts at each level of the account tree.
accountsLevels :: Account a -> [[Account a]]
accountsLevels :: forall a. Account a -> [[Account a]]
accountsLevels = ([Account a] -> Bool) -> [[Account a]] -> [[Account a]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> ([Account a] -> Bool) -> [Account a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Account a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Account a]] -> [[Account a]])
-> (Account a -> [[Account a]]) -> Account a -> [[Account a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Account a] -> [Account a]) -> [Account a] -> [[Account a]]
forall a. (a -> a) -> a -> [a]
iterate ((Account a -> [Account a]) -> [Account a] -> [Account a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Account a -> [Account a]
forall a. Account a -> [Account a]
asubs) ([Account a] -> [[Account a]])
-> (Account a -> [Account a]) -> Account a -> [[Account a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Account a -> [Account a] -> [Account a]
forall a. a -> [a] -> [a]
:[])

-- | Map a (non-tree-structure-modifying) function over this and sub accounts.
mapAccounts :: (Account a -> Account a) -> Account a -> Account a
mapAccounts :: forall a. (Account a -> Account a) -> Account a -> Account a
mapAccounts Account a -> Account a
f Account a
a = Account a -> Account a
f Account a
a{asubs = map (mapAccounts f) $ asubs a}

-- | Apply a function to all 'PeriodData' within this and sub accounts.
mapPeriodData :: (PeriodData a -> PeriodData a) -> Account a -> Account a
mapPeriodData :: forall a. (PeriodData a -> PeriodData a) -> Account a -> Account a
mapPeriodData PeriodData a -> PeriodData a
f = (Account a -> Account a) -> Account a -> Account a
forall a. (Account a -> Account a) -> Account a -> Account a
mapAccounts (\Account a
a -> Account a
a{adata = f $ adata a})

-- | Is the predicate true on any of this account or its subaccounts ?
anyAccounts :: (Account a -> Bool) -> Account a -> Bool
anyAccounts :: forall a. (Account a -> Bool) -> Account a -> Bool
anyAccounts Account a -> Bool
p Account a
a
    | Account a -> Bool
p Account a
a = Bool
True
    | Bool
otherwise = (Account a -> Bool) -> [Account a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Account a -> Bool) -> Account a -> Bool
forall a. (Account a -> Bool) -> Account a -> Bool
anyAccounts Account a -> Bool
p) ([Account a] -> Bool) -> [Account a] -> Bool
forall a b. (a -> b) -> a -> b
$ Account a -> [Account a]
forall a. Account a -> [Account a]
asubs Account a
a

-- | Is the predicate true on all of this account and its subaccounts ?
allAccounts :: (Account a -> Bool) -> Account a -> Bool
allAccounts :: forall a. (Account a -> Bool) -> Account a -> Bool
allAccounts Account a -> Bool
p Account a
a
    | Bool -> Bool
not (Account a -> Bool
p Account a
a) = Bool
False
    | Bool
otherwise = (Account a -> Bool) -> [Account a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Account a -> Bool) -> Account a -> Bool
forall a. (Account a -> Bool) -> Account a -> Bool
allAccounts Account a -> Bool
p) ([Account a] -> Bool) -> [Account a] -> Bool
forall a b. (a -> b) -> a -> b
$ Account a -> [Account a]
forall a. Account a -> [Account a]
asubs Account a
a

-- | Recalculate all the subaccount-inclusive balances in this tree.
sumAccounts :: Account BalanceData -> Account BalanceData
sumAccounts :: Account BalanceData -> Account BalanceData
sumAccounts Account BalanceData
a = Account BalanceData
a{asubs = subs, adata = setInclusiveBalances $ adata a}
  where
    subs :: [Account BalanceData]
subs = (Account BalanceData -> Account BalanceData)
-> [Account BalanceData] -> [Account BalanceData]
forall a b. (a -> b) -> [a] -> [b]
map Account BalanceData -> Account BalanceData
sumAccounts ([Account BalanceData] -> [Account BalanceData])
-> [Account BalanceData] -> [Account BalanceData]
forall a b. (a -> b) -> a -> b
$ Account BalanceData -> [Account BalanceData]
forall a. Account a -> [Account a]
asubs Account BalanceData
a
    subtotals :: PeriodData BalanceData
subtotals = (Account BalanceData -> PeriodData BalanceData)
-> [Account BalanceData] -> PeriodData BalanceData
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Account BalanceData -> PeriodData BalanceData
forall a. Account a -> PeriodData a
adata [Account BalanceData]
subs

    setInclusiveBalances :: PeriodData BalanceData -> PeriodData BalanceData
    setInclusiveBalances :: PeriodData BalanceData -> PeriodData BalanceData
setInclusiveBalances = (BalanceData -> BalanceData)
-> (BalanceData -> BalanceData)
-> (BalanceData -> BalanceData -> BalanceData)
-> PeriodData BalanceData
-> PeriodData BalanceData
-> PeriodData BalanceData
forall a c b.
(a -> c)
-> (b -> c)
-> (a -> b -> c)
-> PeriodData a
-> PeriodData b
-> PeriodData c
mergePeriodData BalanceData -> BalanceData
onlyChildren BalanceData -> BalanceData
noChildren BalanceData -> BalanceData -> BalanceData
combineChildren PeriodData BalanceData
subtotals

    combineChildren :: BalanceData -> BalanceData -> BalanceData
combineChildren BalanceData
children BalanceData
this = BalanceData
this  {bdincludingsubs = bdexcludingsubs this <> bdincludingsubs children}
    onlyChildren :: BalanceData -> BalanceData
onlyChildren    BalanceData
children      = BalanceData
forall a. Monoid a => a
mempty{bdincludingsubs = bdincludingsubs children}
    noChildren :: BalanceData -> BalanceData
noChildren               BalanceData
this = BalanceData
this  {bdincludingsubs = bdexcludingsubs this}

-- | Remove all subaccounts below a certain depth.
clipAccounts :: Int -> Account a -> Account a
clipAccounts :: forall a. Int -> Account a -> Account a
clipAccounts Int
0 Account a
a = Account a
a{asubs=[]}
clipAccounts Int
d Account a
a = Account a
a{asubs=subs}
    where
      subs :: [Account a]
subs = (Account a -> Account a) -> [Account a] -> [Account a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Account a -> Account a
forall a. Int -> Account a -> Account a
clipAccounts (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) ([Account a] -> [Account a]) -> [Account a] -> [Account a]
forall a b. (a -> b) -> a -> b
$ Account a -> [Account a]
forall a. Account a -> [Account a]
asubs Account a
a

-- | Remove subaccounts below the specified depth, aggregating their balance at the depth limit
-- (accounts at the depth limit will have any sub-balances merged into their exclusive balance).
-- If the depth is Nothing, return the original accounts
clipAccountsAndAggregate :: Monoid a => DepthSpec -> [Account a] -> [Account a]
clipAccountsAndAggregate :: forall a. Monoid a => DepthSpec -> [Account a] -> [Account a]
clipAccountsAndAggregate (DepthSpec Maybe Int
Nothing []) [Account a]
as = [Account a]
as
clipAccountsAndAggregate DepthSpec
depthSpec              [Account a]
as = [Account a]
combined
    where
      clipped :: [Account a]
clipped  = [Account a
a{aname=clipOrEllipsifyAccountName depthSpec $ aname a} | Account a
a <- [Account a]
as]
      combined :: [Account a]
combined = [Account a
a{adata=foldMap adata same}
                 | same :: NonEmpty (Account a)
same@(Account a
a:|[Account a]
_) <- (Account a -> AccountName) -> [Account a] -> [NonEmpty (Account a)]
forall (f :: * -> *) b a.
(Foldable f, Eq b) =>
(a -> b) -> f a -> [NonEmpty a]
groupWith Account a -> AccountName
forall a. Account a -> AccountName
aname [Account a]
clipped]

{-
test cases, assuming d=1:

assets:cash 1 1
assets:checking 1 1
->
as:       [assets:cash 1 1, assets:checking 1 1]
clipped:  [assets 1 1, assets 1 1]
combined: [assets 2 2]

assets 0 2
 assets:cash 1 1
 assets:checking 1 1
->
as:       [assets 0 2, assets:cash 1 1, assets:checking 1 1]
clipped:  [assets 0 2, assets 1 1, assets 1 1]
combined: [assets 2 2]

assets 0 2
 assets:bank 1 2
  assets:bank:checking 1 1
->
as:       [assets 0 2, assets:bank 1 2, assets:bank:checking 1 1]
clipped:  [assets 0 2, assets 1 2, assets 1 1]
combined: [assets 2 2]

-}

-- | Remove all leaf accounts and subtrees matching a predicate.
pruneAccounts :: (Account a -> Bool) -> Account a -> Maybe (Account a)
pruneAccounts :: forall a. (Account a -> Bool) -> Account a -> Maybe (Account a)
pruneAccounts Account a -> Bool
p = [Account a] -> Maybe (Account a)
forall a. [a] -> Maybe a
headMay ([Account a] -> Maybe (Account a))
-> (Account a -> [Account a]) -> Account a -> Maybe (Account a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account a -> [Account a]
prune
  where
    prune :: Account a -> [Account a]
prune Account a
a
      | [Account a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Account a]
prunedsubs = if Account a -> Bool
p Account a
a then [] else [Account a
a']
      | Bool
otherwise       = [Account a
a']
      where
        prunedsubs :: [Account a]
prunedsubs = (Account a -> [Account a]) -> [Account a] -> [Account a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Account a -> [Account a]
prune ([Account a] -> [Account a]) -> [Account a] -> [Account a]
forall a b. (a -> b) -> a -> b
$ Account a -> [Account a]
forall a. Account a -> [Account a]
asubs Account a
a
        a' :: Account a
a' = Account a
a{asubs=prunedsubs}

-- | Flatten an account tree into a list, which is sometimes
-- convenient. Note since accounts link to their parents/subs, the
-- tree's structure remains intact and can still be used. It's a tree/list!
flattenAccounts :: Account a -> [Account a]
flattenAccounts :: forall a. Account a -> [Account a]
flattenAccounts Account a
a = Account a -> [Account a] -> [Account a]
forall {a}. Account a -> [Account a] -> [Account a]
squish Account a
a []
  where squish :: Account a -> [Account a] -> [Account a]
squish Account a
a' [Account a]
as = Account a
a' Account a -> [Account a] -> [Account a]
forall a. a -> [a] -> [a]
: (Account a -> [Account a] -> [Account a])
-> [Account a] -> [Account a] -> [Account a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr Account a -> [Account a] -> [Account a]
squish [Account a]
as (Account a -> [Account a]
forall a. Account a -> [Account a]
asubs Account a
a')

-- | Filter an account tree (to a list).
filterAccounts :: (Account a -> Bool) -> Account a -> [Account a]
filterAccounts :: forall a. (Account a -> Bool) -> Account a -> [Account a]
filterAccounts Account a -> Bool
p Account a
a
    | Account a -> Bool
p Account a
a       = Account a
a Account a -> [Account a] -> [Account a]
forall a. a -> [a] -> [a]
: (Account a -> [Account a]) -> [Account a] -> [Account a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Account a -> Bool) -> Account a -> [Account a]
forall a. (Account a -> Bool) -> Account a -> [Account a]
filterAccounts Account a -> Bool
p) (Account a -> [Account a]
forall a. Account a -> [Account a]
asubs Account a
a)
    | Bool
otherwise = (Account a -> [Account a]) -> [Account a] -> [Account a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Account a -> Bool) -> Account a -> [Account a]
forall a. (Account a -> Bool) -> Account a -> [Account a]
filterAccounts Account a -> Bool
p) (Account a -> [Account a]
forall a. Account a -> [Account a]
asubs Account a
a)

-- | Merge two account trees and their subaccounts.
--
-- This assumes that the top-level 'Account's have the same name.
mergeAccounts :: Account a -> Account b -> Account (These a b)
mergeAccounts :: forall a b. Account a -> Account b -> Account (These a b)
mergeAccounts Account a
a = Account (These a b) -> Account (These a b)
forall a. Account a -> Account a
tieAccountParents (Account (These a b) -> Account (These a b))
-> (Account b -> Account (These a b))
-> Account b
-> Account (These a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account a -> Account b -> Account (These a b)
forall a b. Account a -> Account b -> Account (These a b)
merge Account a
a
  where
    merge :: Account a -> Account a -> Account (These a a)
merge Account a
acct1 Account a
acct2 = Account a
acct1
       { adeclarationinfo = adeclarationinfo acct1 <|> adeclarationinfo acct2
       , aparent = Nothing
       , aboring = aboring acct1 && aboring acct2
       , adata = mergeBalances (adata acct1) (adata acct2)
       , asubs = mergeSubs (sortOn aname $ asubs acct1) (sortOn aname $ asubs acct2)
       }

    mergeSubs :: [Account a] -> [Account a] -> [Account (These a a)]
mergeSubs (Account a
x:[Account a]
xs) (Account a
y:[Account a]
ys) = case AccountName -> AccountName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Account a -> AccountName
forall a. Account a -> AccountName
aname Account a
x) (Account a -> AccountName
forall a. Account a -> AccountName
aname Account a
y) of
      Ordering
EQ -> Account a -> Account a -> Account (These a a)
merge Account a
x Account a
y Account (These a a)
-> [Account (These a a)] -> [Account (These a a)]
forall a. a -> [a] -> [a]
: [Account a] -> [Account a] -> [Account (These a a)]
mergeSubs [Account a]
xs [Account a]
ys
      Ordering
LT -> (a -> These a a) -> Account a -> Account (These a a)
forall a b. (a -> b) -> Account a -> Account b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> These a a
forall a b. a -> These a b
This Account a
x Account (These a a)
-> [Account (These a a)] -> [Account (These a a)]
forall a. a -> [a] -> [a]
: [Account a] -> [Account a] -> [Account (These a a)]
mergeSubs [Account a]
xs (Account a
yAccount a -> [Account a] -> [Account a]
forall a. a -> [a] -> [a]
:[Account a]
ys)
      Ordering
GT -> (a -> These a a) -> Account a -> Account (These a a)
forall a b. (a -> b) -> Account a -> Account b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> These a a
forall a b. b -> These a b
That Account a
y Account (These a a)
-> [Account (These a a)] -> [Account (These a a)]
forall a. a -> [a] -> [a]
: [Account a] -> [Account a] -> [Account (These a a)]
mergeSubs (Account a
xAccount a -> [Account a] -> [Account a]
forall a. a -> [a] -> [a]
:[Account a]
xs) [Account a]
ys
    mergeSubs [Account a]
xs [] = (Account a -> Account (These a a))
-> [Account a] -> [Account (These a a)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> These a a) -> Account a -> Account (These a a)
forall a b. (a -> b) -> Account a -> Account b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> These a a
forall a b. a -> These a b
This) [Account a]
xs
    mergeSubs [] [Account a]
ys = (Account a -> Account (These a a))
-> [Account a] -> [Account (These a a)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> These a a) -> Account a -> Account (These a a)
forall a b. (a -> b) -> Account a -> Account b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> These a a
forall a b. b -> These a b
That) [Account a]
ys

    mergeBalances :: PeriodData a -> PeriodData b -> PeriodData (These a b)
mergeBalances = (a -> These a b)
-> (b -> These a b)
-> (a -> b -> These a b)
-> PeriodData a
-> PeriodData b
-> PeriodData (These a b)
forall a c b.
(a -> c)
-> (b -> c)
-> (a -> b -> c)
-> PeriodData a
-> PeriodData b
-> PeriodData c
mergePeriodData a -> These a b
forall a b. a -> These a b
This b -> These a b
forall a b. b -> These a b
That a -> b -> These a b
forall a b. a -> b -> These a b
These

-- | Sort each group of siblings in an account tree by projecting through
-- a provided function.
sortAccountTreeOn :: Ord b => (Account a -> b) -> Account a -> Account a
sortAccountTreeOn :: forall b a. Ord b => (Account a -> b) -> Account a -> Account a
sortAccountTreeOn Account a -> b
f = (Account a -> Account a) -> Account a -> Account a
forall a. (Account a -> Account a) -> Account a -> Account a
mapAccounts ((Account a -> Account a) -> Account a -> Account a)
-> (Account a -> Account a) -> Account a -> Account a
forall a b. (a -> b) -> a -> b
$ \Account a
a -> Account a
a{asubs=sortOn f $ asubs a}

-- | Add extra info for this account derived from the Journal's
-- account directives, if any (comment, tags, declaration order..).
accountSetDeclarationInfo :: Journal -> Account a -> Account a
accountSetDeclarationInfo :: forall a. Journal -> Account a -> Account a
accountSetDeclarationInfo Journal
j a :: Account a
a@Account{Bool
[Account a]
Maybe (Account a)
Maybe AccountDeclarationInfo
AccountName
PeriodData a
aname :: forall a. Account a -> AccountName
aboring :: forall a. Account a -> Bool
adata :: forall a. Account a -> PeriodData a
adeclarationinfo :: forall a. Account a -> Maybe AccountDeclarationInfo
asubs :: forall a. Account a -> [Account a]
aparent :: forall a. Account a -> Maybe (Account a)
aname :: AccountName
adeclarationinfo :: Maybe AccountDeclarationInfo
asubs :: [Account a]
aparent :: Maybe (Account a)
aboring :: Bool
adata :: PeriodData a
..} =
  Account a
a{ adeclarationinfo=lookup aname $ jdeclaredaccounts j }

-- | Sort account names by the order in which they were declared in
-- the journal, at each level of the account tree (ie within each
-- group of siblings). Undeclared accounts are sorted last and
-- alphabetically.
-- This is hledger's default sort for reports organised by account.
-- The account list is converted to a tree temporarily, adding any
-- missing parents; these can be kept (suitable for a tree-mode report)
-- or removed (suitable for a flat-mode report).
--
sortAccountNamesByDeclaration :: Journal -> Bool -> [AccountName] -> [AccountName]
sortAccountNamesByDeclaration :: Journal -> Bool -> [AccountName] -> [AccountName]
sortAccountNamesByDeclaration Journal
j Bool
keepparents [AccountName]
as =
    (if Bool
keepparents then [AccountName] -> [AccountName]
forall a. a -> a
id else (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
filter (AccountName -> HashSet AccountName -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` [AccountName] -> HashSet AccountName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [AccountName]
as)) ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$  -- maybe discard missing parents that were added
    (Account () -> AccountName) -> [Account ()] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map Account () -> AccountName
forall a. Account a -> AccountName
aname ([Account ()] -> [AccountName]) -> [Account ()] -> [AccountName]
forall a b. (a -> b) -> a -> b
$                                         -- keep just the names
    Int -> [Account ()] -> [Account ()]
forall a. Int -> [a] -> [a]
drop Int
1 ([Account ()] -> [Account ()]) -> [Account ()] -> [Account ()]
forall a b. (a -> b) -> a -> b
$                                            -- drop the root node that was added
    Account () -> [Account ()]
forall a. Account a -> [Account a]
flattenAccounts (Account () -> [Account ()]) -> Account () -> [Account ()]
forall a b. (a -> b) -> a -> b
$                                   -- convert to an account list
    Account () -> Account ()
forall a. Account a -> Account a
sortAccountTreeByDeclaration (Account () -> Account ()) -> Account () -> Account ()
forall a b. (a -> b) -> a -> b
$                      -- sort by declaration order (and name)
    (Account () -> Account ()) -> Account () -> Account ()
forall a. (Account a -> Account a) -> Account a -> Account a
mapAccounts (Journal -> Account () -> Account ()
forall a. Journal -> Account a -> Account a
accountSetDeclarationInfo Journal
j) (Account () -> Account ()) -> Account () -> Account ()
forall a b. (a -> b) -> a -> b
$         -- add declaration order info
    (AccountName -> [AccountName] -> Account ()
forall a. Monoid a => AccountName -> [AccountName] -> Account a
accountTree AccountName
"root" [AccountName]
as :: Account ())               -- convert to an account tree

-- | Sort each group of siblings in an account tree by declaration order, then account name.
-- So each group will contain first the declared accounts,
-- in the same order as their account directives were parsed,
-- and then the undeclared accounts, sorted by account name.
sortAccountTreeByDeclaration :: Account a -> Account a
sortAccountTreeByDeclaration :: forall a. Account a -> Account a
sortAccountTreeByDeclaration Account a
a
  | [Account a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Account a] -> Bool) -> [Account a] -> Bool
forall a b. (a -> b) -> a -> b
$ Account a -> [Account a]
forall a. Account a -> [Account a]
asubs Account a
a = Account a
a
  | Bool
otherwise      = Account a
a{asubs=
      sortOn accountDeclarationOrderAndName $
      map sortAccountTreeByDeclaration $ asubs a
      }

accountDeclarationOrderAndName :: Account a -> (Int, AccountName)
accountDeclarationOrderAndName :: forall a. Account a -> (Int, AccountName)
accountDeclarationOrderAndName Account a
a = (Int
adeclarationorder', Account a -> AccountName
forall a. Account a -> AccountName
aname Account a
a)
  where
    adeclarationorder' :: Int
adeclarationorder' = Int
-> (AccountDeclarationInfo -> Int)
-> Maybe AccountDeclarationInfo
-> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
forall a. Bounded a => a
maxBound AccountDeclarationInfo -> Int
adideclarationorder (Maybe AccountDeclarationInfo -> Int)
-> Maybe AccountDeclarationInfo -> Int
forall a b. (a -> b) -> a -> b
$ Account a -> Maybe AccountDeclarationInfo
forall a. Account a -> Maybe AccountDeclarationInfo
adeclarationinfo Account a
a

-- | Search an account list by name.
lookupAccount :: AccountName -> [Account a] -> Maybe (Account a)
lookupAccount :: forall a. AccountName -> [Account a] -> Maybe (Account a)
lookupAccount AccountName
a = (Account a -> Bool) -> [Account a] -> Maybe (Account a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
==AccountName
a)(AccountName -> Bool)
-> (Account a -> AccountName) -> Account a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Account a -> AccountName
forall a. Account a -> AccountName
aname)

-- debug helpers

printAccounts :: Show a => Account a -> IO ()
printAccounts :: forall a. Show a => Account a -> IO ()
printAccounts = String -> IO ()
putStrLn (String -> IO ()) -> (Account a -> String) -> Account a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account a -> String
forall a. Show a => Account a -> String
showAccounts

showAccounts :: Show a => Account a -> String
showAccounts :: forall a. Show a => Account a -> String
showAccounts = [String] -> String
unlines ([String] -> String)
-> (Account a -> [String]) -> Account a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Account a -> String) -> [Account a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Account a -> String
forall {t} {a}. (PrintfType t, Show a) => Account a -> t
showAccountDebug ([Account a] -> [String])
-> (Account a -> [Account a]) -> Account a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account a -> [Account a]
forall a. Account a -> [Account a]
flattenAccounts

showAccountsBoringFlag :: Account a -> String
showAccountsBoringFlag = [String] -> String
unlines ([String] -> String)
-> (Account a -> [String]) -> Account a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Account a -> String) -> [Account a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String
forall a. Show a => a -> String
show (Bool -> String) -> (Account a -> Bool) -> Account a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account a -> Bool
forall a. Account a -> Bool
aboring) ([Account a] -> [String])
-> (Account a -> [Account a]) -> Account a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account a -> [Account a]
forall a. Account a -> [Account a]
flattenAccounts

showAccountDebug :: Account a -> t
showAccountDebug Account a
a = String -> AccountName -> String -> String -> t
forall r. PrintfType r => String -> r
printf String
"%-25s %s %4s"
                     (Account a -> AccountName
forall a. Account a -> AccountName
aname Account a
a)
                     (if Account a -> Bool
forall a. Account a -> Bool
aboring Account a
a then String
"b" else String
" " :: String)
                     (PeriodData a -> String
forall a. Show a => a -> String
show (PeriodData a -> String) -> PeriodData a -> String
forall a b. (a -> b) -> a -> b
$ Account a -> PeriodData a
forall a. Account a -> PeriodData a
adata Account a
a)


tests_Account :: TestTree
tests_Account = String -> [TestTree] -> TestTree
testGroup String
"Account" [
    String -> [TestTree] -> TestTree
testGroup String
"accountFromPostings" [
      String -> IO () -> TestTree
testCase String
"no postings, no days" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
        (Posting -> Maybe Day) -> [Posting] -> Account BalanceData
accountFromPostings Posting -> Maybe Day
forall a. HasCallStack => a
undefined [] Account BalanceData -> Account BalanceData -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= AccountName -> [AccountName] -> Account BalanceData
forall a. Monoid a => AccountName -> [AccountName] -> Account a
accountTree AccountName
"root" []
     ,String -> IO () -> TestTree
testCase String
"no postings, only 2000-01-01" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
         (Account BalanceData -> Bool) -> Account BalanceData -> Bool
forall a. (Account a -> Bool) -> Account a -> Bool
allAccounts ((Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
d -> (Integer -> Day
ModifiedJulianDay (Integer -> Day) -> Integer -> Day
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
d) Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Int -> Int -> Day
fromGregorian Integer
2000 Int
01 Int
01) ([Int] -> Bool)
-> (Account BalanceData -> [Int]) -> Account BalanceData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap BalanceData -> [Int]
forall a. IntMap a -> [Int]
IM.keys (IntMap BalanceData -> [Int])
-> (Account BalanceData -> IntMap BalanceData)
-> Account BalanceData
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodData BalanceData -> IntMap BalanceData
forall a. PeriodData a -> IntMap a
pdperiods (PeriodData BalanceData -> IntMap BalanceData)
-> (Account BalanceData -> PeriodData BalanceData)
-> Account BalanceData
-> IntMap BalanceData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account BalanceData -> PeriodData BalanceData
forall a. Account a -> PeriodData a
adata)
                     ((Posting -> Maybe Day) -> [Posting] -> Account BalanceData
accountFromPostings Posting -> Maybe Day
forall a. HasCallStack => a
undefined []) Bool -> String -> IO ()
forall t.
(AssertionPredicable t, HasCallStack) =>
t -> String -> IO ()
@? String
"Not all adata have exactly 2000-01-01"
    ]
  ]