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


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

-}

module Hledger.Data.Account
where
import Data.List (find, sortOn)
import Data.List.Extra (groupSort, groupOn)
import Data.Maybe (fromMaybe)
import Data.Ord (Down(..))
import qualified Data.Map as M
import Safe (headMay, lookupJustDef)
import Text.Printf

import Hledger.Data.AccountName
import Hledger.Data.Amount
import Hledger.Data.Posting ()
import Hledger.Data.Types
import Hledger.Utils


-- deriving instance Show Account
instance Show Account where
    show :: Account -> String
show Account{Bool
Int
[Account]
Maybe Account
Maybe AccountDeclarationInfo
AccountName
MixedAmount
aibalance :: Account -> MixedAmount
aebalance :: Account -> MixedAmount
anumpostings :: Account -> Int
aboring :: Account -> Bool
aparent :: Account -> Maybe Account
asubs :: Account -> [Account]
adeclarationinfo :: Account -> Maybe AccountDeclarationInfo
aname :: Account -> AccountName
aibalance :: MixedAmount
aebalance :: MixedAmount
anumpostings :: Int
aboring :: Bool
aparent :: Maybe Account
asubs :: [Account]
adeclarationinfo :: Maybe AccountDeclarationInfo
aname :: AccountName
..} = 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
$ AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noColour MixedAmount
aebalance)
                       (WideBuilder -> String
wbUnpack (WideBuilder -> String) -> WideBuilder -> String
forall a b. (a -> b) -> a -> b
$ AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noColour 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 :: AccountName
-> Maybe AccountDeclarationInfo
-> [Account]
-> Maybe Account
-> Bool
-> Int
-> MixedAmount
-> MixedAmount
-> Account
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
    grouped :: [(AccountName, [MixedAmount])]
grouped = [(AccountName, MixedAmount)] -> [(AccountName, [MixedAmount])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort [(Posting -> AccountName
paccount Posting
p,Posting -> MixedAmount
pamount Posting
p) | Posting
p <- [Posting]
ps]
    counted :: [(AccountName, Int)]
counted = [(AccountName
aname, [MixedAmount] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MixedAmount]
amts) | (AccountName
aname, [MixedAmount]
amts) <- [(AccountName, [MixedAmount])]
grouped]
    summed :: [(AccountName, MixedAmount)]
summed =  [(AccountName
aname, [MixedAmount] -> MixedAmount
forall a. Num a => [a] -> a
sumStrict [MixedAmount]
amts) | (AccountName
aname, [MixedAmount]
amts) <- [(AccountName, [MixedAmount])]
grouped]  -- always non-empty
    acctstree :: Account
acctstree      = AccountName -> [AccountName] -> Account
accountTree AccountName
"root" ([AccountName] -> Account) -> [AccountName] -> Account
forall a b. (a -> b) -> a -> b
$ ((AccountName, MixedAmount) -> AccountName)
-> [(AccountName, MixedAmount)] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, MixedAmount) -> AccountName
forall a b. (a, b) -> a
fst [(AccountName, MixedAmount)]
summed
    acctswithnumps :: Account
acctswithnumps = (Account -> Account) -> Account -> Account
mapAccounts Account -> Account
setnumps    Account
acctstree      where setnumps :: Account -> Account
setnumps    Account
a = Account
a{anumpostings :: Int
anumpostings=Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ AccountName -> [(AccountName, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Account -> AccountName
aname Account
a) [(AccountName, Int)]
counted}
    acctswithebals :: Account
acctswithebals = (Account -> Account) -> Account -> Account
mapAccounts Account -> Account
setebalance Account
acctswithnumps where setebalance :: Account -> Account
setebalance Account
a = Account
a{aebalance :: MixedAmount
aebalance=MixedAmount
-> AccountName -> [(AccountName, MixedAmount)] -> MixedAmount
forall a b. Eq a => b -> a -> [(a, b)] -> b
lookupJustDef MixedAmount
nullmixedamt (Account -> AccountName
aname Account
a) [(AccountName, 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 :: AccountName
aname=AccountName
rootname, asubs :: [Account]
asubs=((AccountName, FastTree AccountName) -> Account)
-> [(AccountName, FastTree AccountName)] -> [Account]
forall a b. (a -> b) -> [a] -> [b]
map ((AccountName -> FastTree AccountName -> Account)
-> (AccountName, FastTree AccountName) -> Account
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AccountName -> FastTree AccountName -> Account
accountTree') ([(AccountName, FastTree AccountName)] -> [Account])
-> [(AccountName, FastTree AccountName)] -> [Account]
forall a b. (a -> b) -> a -> b
$ Map AccountName (FastTree AccountName)
-> [(AccountName, FastTree AccountName)]
forall k a. Map k a -> [(k, a)]
M.assocs Map AccountName (FastTree AccountName)
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 :: AccountName
aname=AccountName
a
       ,asubs :: [Account]
asubs=((AccountName, FastTree AccountName) -> Account)
-> [(AccountName, FastTree AccountName)] -> [Account]
forall a b. (a -> b) -> [a] -> [b]
map ((AccountName -> FastTree AccountName -> Account)
-> (AccountName, FastTree AccountName) -> Account
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AccountName -> FastTree AccountName -> Account
accountTree') ([(AccountName, FastTree AccountName)] -> [Account])
-> [(AccountName, FastTree AccountName)] -> [Account]
forall a b. (a -> b) -> a -> b
$ Map AccountName (FastTree AccountName)
-> [(AccountName, FastTree AccountName)]
forall k a. Map k a -> [(k, a)]
M.assocs Map AccountName (FastTree AccountName)
m
       }

-- | 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
aibalance :: MixedAmount
aebalance :: MixedAmount
anumpostings :: Int
aboring :: Bool
aparent :: Maybe Account
asubs :: [Account]
adeclarationinfo :: Maybe AccountDeclarationInfo
aname :: AccountName
aibalance :: Account -> MixedAmount
aebalance :: Account -> MixedAmount
anumpostings :: Account -> Int
aboring :: Account -> Bool
aparent :: Account -> Maybe Account
asubs :: Account -> [Account]
adeclarationinfo :: Account -> Maybe AccountDeclarationInfo
aname :: Account -> AccountName
..} = Account
a'
      where
        a' :: Account
a' = Account
a{aparent :: Maybe Account
aparent=Maybe Account
parent, asubs :: [Account]
asubs=(Account -> Account) -> [Account] -> [Account]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Account -> Account -> Account
tie (Account -> Maybe Account
forall a. a -> Maybe a
Just Account
a')) [Account]
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 (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 :: [Account]
asubs = (Account -> Account) -> [Account] -> [Account]
forall a b. (a -> b) -> [a] -> [b]
map ((Account -> Account) -> Account -> Account
mapAccounts Account -> Account
f) ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$ Account -> [Account]
asubs Account
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 (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 :: MixedAmount
aibalance=Account -> MixedAmount
aebalance Account
a}
  | Bool
otherwise      = Account
a{aibalance :: MixedAmount
aibalance=MixedAmount
ibal, asubs :: [Account]
asubs=[Account]
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 :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([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 :: [Account]
asubs=[]}
clipAccounts Int
d Account
a = Account
a{asubs :: [Account]
asubs=[Account]
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 :: AccountName
aname=Maybe Int -> AccountName -> AccountName
clipOrEllipsifyAccountName (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
d) (AccountName -> AccountName) -> AccountName -> AccountName
forall a b. (a -> b) -> a -> b
$ Account -> AccountName
aname Account
a} | Account
a <- [Account]
as]
      combined :: [Account]
combined = [Account
a{aebalance :: MixedAmount
aebalance=[MixedAmount] -> MixedAmount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([MixedAmount] -> MixedAmount) -> [MixedAmount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Account -> MixedAmount) -> [Account] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Account -> MixedAmount
aebalance [Account]
same}
                 | same :: [Account]
same@(Account
a:[Account]
_) <- (Account -> AccountName) -> [Account] -> [[Account]]
forall b a. Eq b => (a -> b) -> [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 (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 :: [Account]
asubs=[Account]
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 (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 :: [Account]
asubs=[Account] -> [Account]
sortSubs ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$ Account -> [Account]
asubs Account
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
normaliseMixedAmountSquashPricesForDisplay (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
aibalance :: MixedAmount
aebalance :: MixedAmount
anumpostings :: Int
aboring :: Bool
aparent :: Maybe Account
asubs :: [Account]
adeclarationinfo :: Maybe AccountDeclarationInfo
aname :: AccountName
aibalance :: Account -> MixedAmount
aebalance :: Account -> MixedAmount
anumpostings :: Account -> Int
aboring :: Account -> Bool
aparent :: Account -> Maybe Account
asubs :: Account -> [Account]
adeclarationinfo :: Account -> Maybe AccountDeclarationInfo
aname :: Account -> AccountName
..} =
  Account
a{ adeclarationinfo :: Maybe AccountDeclarationInfo
adeclarationinfo=AccountName
-> [(AccountName, AccountDeclarationInfo)]
-> Maybe AccountDeclarationInfo
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup AccountName
aname ([(AccountName, AccountDeclarationInfo)]
 -> Maybe AccountDeclarationInfo)
-> [(AccountName, AccountDeclarationInfo)]
-> Maybe AccountDeclarationInfo
forall a b. (a -> b) -> a -> b
$ Journal -> [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts Journal
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 -> [AccountName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [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 (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 :: [Account]
asubs=
      (Account -> (Int, AccountName)) -> [Account] -> [Account]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Account -> (Int, AccountName)
accountDeclarationOrderAndName ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$
      (Account -> Account) -> [Account] -> [Account]
forall a b. (a -> b) -> [a] -> [b]
map Account -> Account
sortAccountTreeByDeclaration ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$ Account -> [Account]
asubs Account
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
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noColour (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
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
noColour (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)