diff --git a/Account.hs b/Account.hs index c1b3b287d..36c7951cf 100644 --- a/Account.hs +++ b/Account.hs @@ -43,13 +43,11 @@ aggregateTransactionsInAccountNamed l a = -- a tree of Accounts -atacct = fst . node - addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account addDataToAccountNameTree l ant = - Tree (mkAccount l aname, map (addDataToAccountNameTree l) (branches ant)) - where - aname = antacctname ant + Node + (mkAccount l $ rootLabel ant) + (map (addDataToAccountNameTree l) $ subForest ant) -- would be straightforward except we want to elide boring accounts when -- displaying account trees: @@ -74,24 +72,24 @@ showAccountTree l maxdepth indentlevel t where boringacct = isBoringAccount2 l name boringparents = takeWhile (isBoringAccount2 l) $ parentAccountNames name - bal = printf "%20s" $ show $ abalance $ atacct t + bal = printf "%20s" $ show $ abalance $ rootLabel t indent = replicate (indentlevel * 2) ' ' parentnames = concatMap (++ ":") $ map accountLeafName boringparents leafname = accountLeafName name - name = aname $ atacct t + name = aname $ rootLabel t subacctsindented i = case maxdepth > 1 of - True -> concatMap (showAccountTree l (maxdepth-1) (indentlevel+i)) $ branches t + True -> concatMap (showAccountTree l (maxdepth-1) (indentlevel+i)) $ subForest t False -> "" isBoringAccount :: Tree Account -> Bool isBoringAccount at = (length txns == 0) && ((length subaccts) == 1) && (not $ name == "top") where - a = atacct at + a = rootLabel at name = aname a txns = atransactions a - subaccts = branches at + subaccts = subForest at isBoringAccount2 :: Ledger -> AccountName -> Bool isBoringAccount2 l a @@ -113,4 +111,4 @@ ledgerAccountsMatching l acctpats = undefined showLedgerAccounts :: Ledger -> Int -> String showLedgerAccounts l maxdepth = - concatMap (showAccountTree l maxdepth 0) (branches (ledgerAccountTree l)) + concatMap (showAccountTree l maxdepth 0) (subForest (ledgerAccountTree l)) diff --git a/AccountName.hs b/AccountName.hs index 36ee5c0d2..70f4e4de0 100644 --- a/AccountName.hs +++ b/AccountName.hs @@ -1,4 +1,3 @@ - module AccountName where import Utils @@ -62,27 +61,25 @@ indentAccountName indentcorrection a = -- first, here is a tree of AccountNames; Account and Account tree are -- defined later. -antacctname = fst . node - accountNameTreeFrom_props = [ - accountNameTreeFrom ["a"] == Tree ("top", [Tree ("a",[])]), - accountNameTreeFrom ["a","b"] == Tree ("top", [Tree ("a", []), Tree ("b", [])]), - accountNameTreeFrom ["a","a:b"] == Tree ("top", [Tree ("a", [Tree ("a:b", [])])]), - accountNameTreeFrom ["a:b"] == Tree ("top", [Tree ("a", [Tree ("a:b", [])])]) + accountNameTreeFrom ["a"] == Node "top" [Node "a" []], + accountNameTreeFrom ["a","b"] == Node "top" [Node "a" [], Node "b" []], + accountNameTreeFrom ["a","a:b"] == Node "top" [Node "a" [Node "a:b" []]], + accountNameTreeFrom ["a:b"] == Node "top" [Node "a" [Node "a:b" []]] ] accountNameTreeFrom :: [AccountName] -> Tree AccountName accountNameTreeFrom accts = - Tree ("top", accountsFrom (topAccountNames accts)) + Node "top" (accountsFrom (topAccountNames accts)) where accountsFrom :: [AccountName] -> [Tree AccountName] accountsFrom [] = [] - accountsFrom as = [Tree (a, accountsFrom $ subs a) | a <- as] + accountsFrom as = [Node a (accountsFrom $ subs a) | a <- as] subs = (subAccountNamesFrom accts) showAccountNameTree :: Tree AccountName -> String showAccountNameTree t = - topacct ++ "\n" ++ concatMap showAccountNameTree (branches t) + topacct ++ "\n" ++ concatMap showAccountNameTree (subForest t) where - topacct = indentAccountName 0 $ antacctname t + topacct = indentAccountName 0 $ rootLabel t diff --git a/BasicTypes.hs b/BasicTypes.hs index cadb6e43e..dd212a002 100644 --- a/BasicTypes.hs +++ b/BasicTypes.hs @@ -1,16 +1,10 @@ - -module BasicTypes +module BasicTypes where import Utils type Date = String --- generic tree. each node is a tuple of the node type and a --- list of subtrees -newtype Tree a = Tree { node :: (a, [Tree a]) } deriving (Show,Eq) -branches = snd . node - -- amounts {- a simple amount is a currency, quantity pair: 0 diff --git a/Utils.hs b/Utils.hs index 50405c018..8cc03747a 100644 --- a/Utils.hs +++ b/Utils.hs @@ -1,6 +1,7 @@ module Utils ( module Utils, module Data.List, + module Data.Tree, module Debug.Trace, module Text.Printf, module Text.Regex, @@ -9,6 +10,7 @@ module Utils ( where import System.Directory import Data.List +import Data.Tree import Debug.Trace import Test.QuickCheck (quickCheck) import Text.Printf