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


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

-}

module Hledger.Data.Account
( nullacct
, accountsFromPostings
, accountTree
, showAccounts
, showAccountsBoringFlag
, printAccounts
, lookupAccount
, parentAccounts
, accountsLevels
, mapAccounts
, anyAccounts
, filterAccounts
, sumAccounts
, clipAccounts
, clipAccountsAndAggregate
, pruneAccounts
, flattenAccounts
, accountSetDeclarationInfo
, sortAccountNamesByDeclaration
, sortAccountTreeByAmount
) where

import qualified Data.HashSet as HS
import qualified Data.HashMap.Strict as HM
import Data.List (find, foldl', sortOn)
import Data.List.Extra (groupOn)
import qualified Data.Map as M
import Data.Ord (Down(..))
import Safe (headMay)
import Text.Printf (printf)

import Hledger.Data.AccountName (expandAccountName, clipOrEllipsifyAccountName)
import Hledger.Data.Amount
import Hledger.Data.Types


-- deriving instance Show Account
instance Show Account where
    show :: Account -> String
show Account{Bool
Int
[Account]
Maybe Account
Maybe AccountDeclarationInfo
AccountName
MixedAmount
aname :: AccountName
adeclarationinfo :: Maybe AccountDeclarationInfo
asubs :: [Account]
aparent :: Maybe Account
aboring :: Bool
anumpostings :: Int
aebalance :: MixedAmount
aibalance :: MixedAmount
aname :: Account -> AccountName
adeclarationinfo :: Account -> Maybe AccountDeclarationInfo
asubs :: Account -> [Account]
aparent :: Account -> Maybe Account
aboring :: Account -> Bool
anumpostings :: Account -> Int
aebalance :: Account -> MixedAmount
aibalance :: Account -> MixedAmount
..} = String -> AccountName -> String -> Int -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Account %s (boring:%s, postings:%d, ebalance:%s, ibalance:%s)"
                       AccountName
aname
                       (if Bool
aboring then String
"y" else String
"n" :: String)
                       Int
anumpostings
                       (WideBuilder -> String
wbUnpack (WideBuilder -> String) -> WideBuilder -> String
forall a b. (a -> b) -> a -> b
$ AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
defaultFmt MixedAmount
aebalance)
                       (WideBuilder -> String
wbUnpack (WideBuilder -> String) -> WideBuilder -> String
forall a b. (a -> b) -> a -> b
$ AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
defaultFmt MixedAmount
aibalance)

instance Eq Account where
  == :: Account -> Account -> Bool
(==) Account
a Account
b = Account -> AccountName
aname Account
a AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== Account -> AccountName
aname Account
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
nullacct = Account
  { aname :: AccountName
aname            = AccountName
""
  , adeclarationinfo :: Maybe AccountDeclarationInfo
adeclarationinfo = Maybe AccountDeclarationInfo
forall a. Maybe a
Nothing
  , asubs :: [Account]
asubs            = []
  , aparent :: Maybe Account
aparent          = Maybe Account
forall a. Maybe a
Nothing
  , aboring :: Bool
aboring          = Bool
False
  , anumpostings :: Int
anumpostings     = Int
0
  , aebalance :: MixedAmount
aebalance        = MixedAmount
nullmixedamt
  , aibalance :: MixedAmount
aibalance        = MixedAmount
nullmixedamt
  }

-- | Derive 1. an account tree and 2. each account's total exclusive
-- and inclusive changes from a list of postings.
-- 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] -> [Account]
accountsFromPostings :: [Posting] -> [Account]
accountsFromPostings [Posting]
ps =
  let
    summed :: HashMap AccountName (Int, MixedAmount)
summed = (Posting
 -> HashMap AccountName (Int, MixedAmount)
 -> HashMap AccountName (Int, MixedAmount))
-> HashMap AccountName (Int, MixedAmount)
-> [Posting]
-> HashMap AccountName (Int, MixedAmount)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Posting
p -> ((Int, MixedAmount) -> (Int, MixedAmount) -> (Int, MixedAmount))
-> AccountName
-> (Int, MixedAmount)
-> HashMap AccountName (Int, MixedAmount)
-> HashMap AccountName (Int, MixedAmount)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith (Int, MixedAmount) -> (Int, MixedAmount) -> (Int, MixedAmount)
forall {a}.
Num a =>
(a, MixedAmount) -> (a, MixedAmount) -> (a, MixedAmount)
addAndIncrement (Posting -> AccountName
paccount Posting
p) (Int
1, Posting -> MixedAmount
pamount Posting
p)) HashMap AccountName (Int, MixedAmount)
forall a. Monoid a => a
mempty [Posting]
ps
      where addAndIncrement :: (a, MixedAmount) -> (a, MixedAmount) -> (a, MixedAmount)
addAndIncrement (a
n, MixedAmount
a) (a
m, MixedAmount
b) = (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
m, MixedAmount
a MixedAmount -> MixedAmount -> MixedAmount
`maPlus` MixedAmount
b)
    acctstree :: Account
acctstree      = AccountName -> [AccountName] -> Account
accountTree AccountName
"root" ([AccountName] -> Account) -> [AccountName] -> Account
forall a b. (a -> b) -> a -> b
$ HashMap AccountName (Int, MixedAmount) -> [AccountName]
forall k v. HashMap k v -> [k]
HM.keys HashMap AccountName (Int, MixedAmount)
summed
    acctswithebals :: Account
acctswithebals = (Account -> Account) -> Account -> Account
mapAccounts Account -> Account
setnumpsebalance Account
acctstree
      where setnumpsebalance :: Account -> Account
setnumpsebalance Account
a = Account
a{anumpostings=numps, aebalance=total}
              where (Int
numps, MixedAmount
total) = (Int, MixedAmount)
-> AccountName
-> HashMap AccountName (Int, MixedAmount)
-> (Int, MixedAmount)
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HM.lookupDefault (Int
0, MixedAmount
nullmixedamt) (Account -> AccountName
aname Account
a) HashMap AccountName (Int, MixedAmount)
summed
    acctswithibals :: Account
acctswithibals = Account -> Account
sumAccounts Account
acctswithebals
    acctswithparents :: Account
acctswithparents = Account -> Account
tieAccountParents Account
acctswithibals
    acctsflattened :: [Account]
acctsflattened = Account -> [Account]
flattenAccounts Account
acctswithparents
  in
    [Account]
acctsflattened

-- | Convert a list of account names to a tree of Account objects,
-- with just the account names filled in.
-- A single root account with the given name is added.
accountTree :: AccountName -> [AccountName] -> Account
accountTree :: AccountName -> [AccountName] -> Account
accountTree AccountName
rootname [AccountName]
as = Account
nullacct{aname=rootname, 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
accountTree' AccountName
a (T Map AccountName (FastTree AccountName)
m') =
      Account
nullacct{
        aname=a
       ,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 -> Account
tieAccountParents :: Account -> Account
tieAccountParents = Maybe Account -> Account -> Account
tie Maybe Account
forall a. Maybe a
Nothing
  where
    tie :: Maybe Account -> Account -> Account
tie Maybe Account
parent a :: Account
a@Account{Bool
Int
[Account]
Maybe Account
Maybe AccountDeclarationInfo
AccountName
MixedAmount
aname :: Account -> AccountName
adeclarationinfo :: Account -> Maybe AccountDeclarationInfo
asubs :: Account -> [Account]
aparent :: Account -> Maybe Account
aboring :: Account -> Bool
anumpostings :: Account -> Int
aebalance :: Account -> MixedAmount
aibalance :: Account -> MixedAmount
aname :: AccountName
adeclarationinfo :: Maybe AccountDeclarationInfo
asubs :: [Account]
aparent :: Maybe Account
aboring :: Bool
anumpostings :: Int
aebalance :: MixedAmount
aibalance :: MixedAmount
..} = Account
a'
      where
        a' :: Account
a' = Account
a{aparent=parent, asubs=map (tie (Just a')) asubs}

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

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

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

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

-- | Add subaccount-inclusive balances to an account tree.
sumAccounts :: Account -> Account
sumAccounts :: Account -> Account
sumAccounts Account
a
  | [Account] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Account] -> Bool) -> [Account] -> Bool
forall a b. (a -> b) -> a -> b
$ Account -> [Account]
asubs Account
a = Account
a{aibalance=aebalance a}
  | Bool
otherwise      = Account
a{aibalance=ibal, asubs=subs}
  where
    subs :: [Account]
subs = (Account -> Account) -> [Account] -> [Account]
forall a b. (a -> b) -> [a] -> [b]
map Account -> Account
sumAccounts ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$ Account -> [Account]
asubs Account
a
    ibal :: MixedAmount
ibal = [MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum ([MixedAmount] -> MixedAmount) -> [MixedAmount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Account -> MixedAmount
aebalance Account
a MixedAmount -> [MixedAmount] -> [MixedAmount]
forall a. a -> [a] -> [a]
: (Account -> MixedAmount) -> [Account] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Account -> MixedAmount
aibalance [Account]
subs

-- | Remove all subaccounts below a certain depth.
clipAccounts :: Int -> Account -> Account
clipAccounts :: Int -> Account -> Account
clipAccounts Int
0 Account
a = Account
a{asubs=[]}
clipAccounts Int
d Account
a = Account
a{asubs=subs}
    where
      subs :: [Account]
subs = (Account -> Account) -> [Account] -> [Account]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Account -> Account
clipAccounts (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$ Account -> [Account]
asubs Account
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 :: Maybe Int -> [Account] -> [Account]
clipAccountsAndAggregate :: Maybe Int -> [Account] -> [Account]
clipAccountsAndAggregate Maybe Int
Nothing  [Account]
as = [Account]
as
clipAccountsAndAggregate (Just Int
d) [Account]
as = [Account]
combined
    where
      clipped :: [Account]
clipped  = [Account
a{aname=clipOrEllipsifyAccountName (Just d) $ aname a} | Account
a <- [Account]
as]
      combined :: [Account]
combined = [Account
a{aebalance=maSum $ map aebalance same}
                 | same :: [Account]
same@(Account
a:[Account]
_) <- (Account -> AccountName) -> [Account] -> [[Account]]
forall k a. Eq k => (a -> k) -> [a] -> [[a]]
groupOn Account -> AccountName
aname [Account]
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 -> Bool) -> Account -> Maybe Account
pruneAccounts :: (Account -> Bool) -> Account -> Maybe Account
pruneAccounts Account -> Bool
p = [Account] -> Maybe Account
forall a. [a] -> Maybe a
headMay ([Account] -> Maybe Account)
-> (Account -> [Account]) -> Account -> Maybe Account
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account -> [Account]
prune
  where
    prune :: Account -> [Account]
prune Account
a
      | [Account] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Account]
prunedsubs = if Account -> Bool
p Account
a then [] else [Account
a']
      | Bool
otherwise       = [Account
a']
      where
        prunedsubs :: [Account]
prunedsubs = (Account -> [Account]) -> [Account] -> [Account]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Account -> [Account]
prune ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$ Account -> [Account]
asubs Account
a
        a' :: Account
a' = Account
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 -> [Account]
flattenAccounts :: Account -> [Account]
flattenAccounts Account
a = Account -> [Account] -> [Account]
squish Account
a []
  where squish :: Account -> [Account] -> [Account]
squish Account
a' [Account]
as = Account
a' Account -> [Account] -> [Account]
forall a. a -> [a] -> [a]
: (Account -> [Account] -> [Account])
-> [Account] -> [Account] -> [Account]
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 -> [Account] -> [Account]
squish [Account]
as (Account -> [Account]
asubs Account
a')

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

-- | Sort each group of siblings in an account tree by inclusive amount,
-- so that the accounts with largest normal balances are listed first.
-- The provided normal balance sign determines whether normal balances
-- are negative or positive, affecting the sort order. Ie,
-- if balances are normally negative, then the most negative balances
-- sort first, and vice versa.
sortAccountTreeByAmount :: NormalSign -> Account -> Account
sortAccountTreeByAmount :: NormalSign -> Account -> Account
sortAccountTreeByAmount NormalSign
normalsign = (Account -> Account) -> Account -> Account
mapAccounts ((Account -> Account) -> Account -> Account)
-> (Account -> Account) -> Account -> Account
forall a b. (a -> b) -> a -> b
$ \Account
a -> Account
a{asubs=sortSubs $ asubs a}
  where
    sortSubs :: [Account] -> [Account]
sortSubs = case NormalSign
normalsign of
        NormalSign
NormallyPositive -> (Account -> (Down MixedAmount, AccountName))
-> [Account] -> [Account]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\Account
a -> (MixedAmount -> Down MixedAmount
forall a. a -> Down a
Down (MixedAmount -> Down MixedAmount)
-> MixedAmount -> Down MixedAmount
forall a b. (a -> b) -> a -> b
$ Account -> MixedAmount
amt Account
a, Account -> AccountName
aname Account
a))
        NormalSign
NormallyNegative -> (Account -> (MixedAmount, AccountName)) -> [Account] -> [Account]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\Account
a -> (Account -> MixedAmount
amt Account
a, Account -> AccountName
aname Account
a))
    amt :: Account -> MixedAmount
amt = MixedAmount -> MixedAmount
mixedAmountStripCosts (MixedAmount -> MixedAmount)
-> (Account -> MixedAmount) -> Account -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account -> MixedAmount
aibalance

-- | Add extra info for this account derived from the Journal's
-- account directives, if any (comment, tags, declaration order..).
accountSetDeclarationInfo :: Journal -> Account -> Account
accountSetDeclarationInfo :: Journal -> Account -> Account
accountSetDeclarationInfo Journal
j a :: Account
a@Account{Bool
Int
[Account]
Maybe Account
Maybe AccountDeclarationInfo
AccountName
MixedAmount
aname :: Account -> AccountName
adeclarationinfo :: Account -> Maybe AccountDeclarationInfo
asubs :: Account -> [Account]
aparent :: Account -> Maybe Account
aboring :: Account -> Bool
anumpostings :: Account -> Int
aebalance :: Account -> MixedAmount
aibalance :: Account -> MixedAmount
aname :: AccountName
adeclarationinfo :: Maybe AccountDeclarationInfo
asubs :: [Account]
aparent :: Maybe Account
aboring :: Bool
anumpostings :: Int
aebalance :: MixedAmount
aibalance :: MixedAmount
..} =
  Account
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
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]
flattenAccounts (Account -> [Account]) -> Account -> [Account]
forall a b. (a -> b) -> a -> b
$                                   -- convert to an account list
    Account -> Account
sortAccountTreeByDeclaration (Account -> Account) -> Account -> Account
forall a b. (a -> b) -> a -> b
$                      -- sort by declaration order (and name)
    (Account -> Account) -> Account -> Account
mapAccounts (Journal -> Account -> Account
accountSetDeclarationInfo Journal
j) (Account -> Account) -> Account -> Account
forall a b. (a -> b) -> a -> b
$         -- add declaration order info
    AccountName -> [AccountName] -> Account
accountTree AccountName
"root"                                  -- convert to an account tree
    [AccountName]
as

-- | 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 -> Account
sortAccountTreeByDeclaration :: Account -> Account
sortAccountTreeByDeclaration Account
a
  | [Account] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Account] -> Bool) -> [Account] -> Bool
forall a b. (a -> b) -> a -> b
$ Account -> [Account]
asubs Account
a = Account
a
  | Bool
otherwise      = Account
a{asubs=
      sortOn accountDeclarationOrderAndName $
      map sortAccountTreeByDeclaration $ asubs a
      }

accountDeclarationOrderAndName :: Account -> (Int, AccountName)
accountDeclarationOrderAndName :: Account -> (Int, AccountName)
accountDeclarationOrderAndName Account
a = (Int
adeclarationorder', Account -> AccountName
aname Account
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 -> Maybe AccountDeclarationInfo
adeclarationinfo Account
a

-- | Search an account list by name.
lookupAccount :: AccountName -> [Account] -> Maybe Account
lookupAccount :: AccountName -> [Account] -> Maybe Account
lookupAccount AccountName
a = (Account -> Bool) -> [Account] -> Maybe Account
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 -> AccountName) -> Account -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Account -> AccountName
aname)

-- debug helpers

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

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

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

showAccountDebug :: Account -> t
showAccountDebug Account
a = String -> AccountName -> String -> String -> String -> t
forall r. PrintfType r => String -> r
printf String
"%-25s %4s %4s %s"
                     (Account -> AccountName
aname Account
a)
                     (WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
defaultFmt (MixedAmount -> String) -> MixedAmount -> String
forall a b. (a -> b) -> a -> b
$ Account -> MixedAmount
aebalance Account
a)
                     (WideBuilder -> String
wbUnpack (WideBuilder -> String)
-> (MixedAmount -> WideBuilder) -> MixedAmount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
defaultFmt (MixedAmount -> String) -> MixedAmount -> String
forall a b. (a -> b) -> a -> b
$ Account -> MixedAmount
aibalance Account
a)
                     (if Account -> Bool
aboring Account
a then String
"b" else String
" " :: String)