From 90bf3545667bf96f7568dba2208ab3b37f320a2d Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 14 Jan 2019 03:44:51 -0800 Subject: [PATCH] lib: allow more account directive info in Account records --- hledger-lib/Hledger/Data/Account.hs | 44 ++++++++++++++++++----------- hledger-lib/Hledger/Data/Types.hs | 37 ++++++++++++++++-------- 2 files changed, 53 insertions(+), 28 deletions(-) diff --git a/hledger-lib/Hledger/Data/Account.hs b/hledger-lib/Hledger/Data/Account.hs index f7d13c5d3..8910d2500 100644 --- a/hledger-lib/Hledger/Data/Account.hs +++ b/hledger-lib/Hledger/Data/Account.hs @@ -45,14 +45,14 @@ instance Eq Account where -- ] nullacct = Account - { aname = "" - , adeclarationorder = Nothing - , aparent = Nothing - , asubs = [] - , anumpostings = 0 - , aebalance = nullmixedamt - , aibalance = nullmixedamt - , aboring = False + { aname = "" + , adeclarationinfo = Nothing + , asubs = [] + , aparent = Nothing + , aboring = False + , anumpostings = 0 + , aebalance = nullmixedamt + , aibalance = nullmixedamt } -- | Derive 1. an account tree and 2. each account's total exclusive @@ -83,7 +83,11 @@ accountTree :: AccountName -> [AccountName] -> Account accountTree rootname as = nullacct{aname=rootname, asubs=map (uncurry accountTree') $ M.assocs m } where T m = treeFromPaths $ map expandAccountName as :: FastTree AccountName - accountTree' a (T m) = nullacct{aname=a, asubs=map (uncurry accountTree') $ M.assocs m} + accountTree' a (T m) = + nullacct{ + aname=a + ,asubs=map (uncurry accountTree') $ M.assocs m + } -- | Tie the knot so all subaccounts' parents are set correctly. tieAccountParents :: Account -> Account @@ -204,12 +208,17 @@ sortAccountTreeByAmount normalsign a maybeflip | normalsign==NormallyNegative = id | otherwise = flip --- | Look up an account's declaration order, if any, from the Journal and set it. --- This is the relative position of its account directive --- among the other account directives. -accountSetDeclarationOrder :: Journal -> Account -> Account -accountSetDeclarationOrder j a@Account{..} = - a{adeclarationorder = findIndex (==aname) (jdeclaredaccounts j)} +-- | Add extra info for this account derived from the Journal's +-- account directives, if any (comment, tags, declaration order..). +-- Currently only sets declaration order. +-- Expects that this account is among the Journal's jdeclaredaccounts +-- (otherwise sets declaration order to 0). +accountSetDeclarationInfo :: Journal -> Account -> Account +accountSetDeclarationInfo j a@Account{..} = + a{adeclarationinfo=Just nullaccountdeclarationinfo{ + adideclarationorder = fromMaybe 0 $ findIndex (==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 @@ -227,7 +236,7 @@ sortAccountNamesByDeclaration j keepparents as = drop 1 $ -- drop the root node that was added flattenAccounts $ -- convert to an account list sortAccountTreeByDeclaration $ -- sort by declaration order (and name) - mapAccounts (accountSetDeclarationOrder j) $ -- add declaration order info + mapAccounts (accountSetDeclarationInfo j) $ -- add declaration order info accountTree "root" -- convert to an account tree as @@ -243,9 +252,10 @@ sortAccountTreeByDeclaration a map sortAccountTreeByDeclaration $ asubs a } +accountDeclarationOrderAndName :: Account -> (Int, AccountName) accountDeclarationOrderAndName a = (adeclarationorder', aname a) where - adeclarationorder' = fromMaybe maxBound (adeclarationorder a) + adeclarationorder' = maybe maxBound adideclarationorder $ adeclarationinfo a -- | Search an account list by name. lookupAccount :: AccountName -> [Account] -> Maybe Account diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 986896411..7355bc857 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -439,18 +439,33 @@ type ParsedJournal = Journal -- The --output-format option selects one of these for output. type StorageFormat = String --- | An account, with name, balances and links to parent/subaccounts --- which let you walk up or down the account tree. +-- | Extra information about an account that can be derived from +-- its account directive (and the other account directives). +data AccountDeclarationInfo = AccountDeclarationInfo { + adicomment :: Text -- ^ any comment lines following an account directive for this account + ,aditags :: [Tag] -- ^ tags extracted from the account comment, if any + ,adideclarationorder :: Int -- ^ the relative position of this account's account directive, if any. Normally a natural number. +} deriving (Data) + +nullaccountdeclarationinfo = AccountDeclarationInfo { + adicomment = "" + ,aditags = [] + ,adideclarationorder = 0 +} + +-- | An account, with its balances, parent/subaccount relationships, etc. +-- Only the name is required; the other fields are added when needed. data Account = Account { - aname :: AccountName, -- ^ this account's full name - adeclarationorder :: Maybe Int , -- ^ the relative position of this account's account directive, if any. Normally a natural number. - aebalance :: MixedAmount, -- ^ this account's balance, excluding subaccounts - asubs :: [Account], -- ^ sub-accounts - anumpostings :: Int, -- ^ number of postings to this account - -- derived from the above : - aibalance :: MixedAmount, -- ^ this account's balance, including subaccounts - aparent :: Maybe Account, -- ^ parent account - aboring :: Bool -- ^ used in the accounts report to label elidable parents + aname :: AccountName -- ^ this account's full name + ,adeclarationinfo :: Maybe AccountDeclarationInfo -- ^ optional extra info from account directives + -- relationships in the tree + ,asubs :: [Account] -- ^ this account's sub-accounts + ,aparent :: Maybe Account -- ^ parent account + ,aboring :: Bool -- ^ used in the accounts report to label elidable parents + -- balance information + ,anumpostings :: Int -- ^ the number of postings to this account + ,aebalance :: MixedAmount -- ^ this account's balance, excluding subaccounts + ,aibalance :: MixedAmount -- ^ this account's balance, including subaccounts } deriving (Typeable, Data, Generic) -- | Whether an account's balance is normally a positive number (in