From 8236f3f988ea0553397b94b6c52a59167edb0551 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Sat, 10 Mar 2007 03:16:19 +0000
Subject: [PATCH] switch to Data.Tree

---
 Account.hs     | 20 +++++++++-----------
 AccountName.hs | 19 ++++++++-----------
 BasicTypes.hs  |  8 +-------
 Utils.hs       |  2 ++
 4 files changed, 20 insertions(+), 29 deletions(-)

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