{-# 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 (MixedAmount -> String showMixedAmount MixedAmount aebalance) (MixedAmount -> String showMixedAmount 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) (MixedAmount -> String showMixedAmount (MixedAmount -> String) -> MixedAmount -> String forall a b. (a -> b) -> a -> b $ Account -> MixedAmount aebalance Account a) (MixedAmount -> String showMixedAmount (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)