mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-08 07:09:28 +03:00
switch to Data.Tree
This commit is contained in:
parent
93fa427e08
commit
8236f3f988
20
Account.hs
20
Account.hs
@ -43,13 +43,11 @@ aggregateTransactionsInAccountNamed l a =
|
|||||||
|
|
||||||
-- a tree of Accounts
|
-- a tree of Accounts
|
||||||
|
|
||||||
atacct = fst . node
|
|
||||||
|
|
||||||
addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
|
addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
|
||||||
addDataToAccountNameTree l ant =
|
addDataToAccountNameTree l ant =
|
||||||
Tree (mkAccount l aname, map (addDataToAccountNameTree l) (branches ant))
|
Node
|
||||||
where
|
(mkAccount l $ rootLabel ant)
|
||||||
aname = antacctname ant
|
(map (addDataToAccountNameTree l) $ subForest ant)
|
||||||
|
|
||||||
-- would be straightforward except we want to elide boring accounts when
|
-- would be straightforward except we want to elide boring accounts when
|
||||||
-- displaying account trees:
|
-- displaying account trees:
|
||||||
@ -74,24 +72,24 @@ showAccountTree l maxdepth indentlevel t
|
|||||||
where
|
where
|
||||||
boringacct = isBoringAccount2 l name
|
boringacct = isBoringAccount2 l name
|
||||||
boringparents = takeWhile (isBoringAccount2 l) $ parentAccountNames 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) ' '
|
indent = replicate (indentlevel * 2) ' '
|
||||||
parentnames = concatMap (++ ":") $ map accountLeafName boringparents
|
parentnames = concatMap (++ ":") $ map accountLeafName boringparents
|
||||||
leafname = accountLeafName name
|
leafname = accountLeafName name
|
||||||
name = aname $ atacct t
|
name = aname $ rootLabel t
|
||||||
subacctsindented i =
|
subacctsindented i =
|
||||||
case maxdepth > 1 of
|
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 -> ""
|
False -> ""
|
||||||
|
|
||||||
isBoringAccount :: Tree Account -> Bool
|
isBoringAccount :: Tree Account -> Bool
|
||||||
isBoringAccount at =
|
isBoringAccount at =
|
||||||
(length txns == 0) && ((length subaccts) == 1) && (not $ name == "top")
|
(length txns == 0) && ((length subaccts) == 1) && (not $ name == "top")
|
||||||
where
|
where
|
||||||
a = atacct at
|
a = rootLabel at
|
||||||
name = aname a
|
name = aname a
|
||||||
txns = atransactions a
|
txns = atransactions a
|
||||||
subaccts = branches at
|
subaccts = subForest at
|
||||||
|
|
||||||
isBoringAccount2 :: Ledger -> AccountName -> Bool
|
isBoringAccount2 :: Ledger -> AccountName -> Bool
|
||||||
isBoringAccount2 l a
|
isBoringAccount2 l a
|
||||||
@ -113,4 +111,4 @@ ledgerAccountsMatching l acctpats = undefined
|
|||||||
|
|
||||||
showLedgerAccounts :: Ledger -> Int -> String
|
showLedgerAccounts :: Ledger -> Int -> String
|
||||||
showLedgerAccounts l maxdepth =
|
showLedgerAccounts l maxdepth =
|
||||||
concatMap (showAccountTree l maxdepth 0) (branches (ledgerAccountTree l))
|
concatMap (showAccountTree l maxdepth 0) (subForest (ledgerAccountTree l))
|
||||||
|
@ -1,4 +1,3 @@
|
|||||||
|
|
||||||
module AccountName
|
module AccountName
|
||||||
where
|
where
|
||||||
import Utils
|
import Utils
|
||||||
@ -62,27 +61,25 @@ indentAccountName indentcorrection a =
|
|||||||
-- first, here is a tree of AccountNames; Account and Account tree are
|
-- first, here is a tree of AccountNames; Account and Account tree are
|
||||||
-- defined later.
|
-- defined later.
|
||||||
|
|
||||||
antacctname = fst . node
|
|
||||||
|
|
||||||
accountNameTreeFrom_props =
|
accountNameTreeFrom_props =
|
||||||
[
|
[
|
||||||
accountNameTreeFrom ["a"] == Tree ("top", [Tree ("a",[])]),
|
accountNameTreeFrom ["a"] == Node "top" [Node "a" []],
|
||||||
accountNameTreeFrom ["a","b"] == Tree ("top", [Tree ("a", []), Tree ("b", [])]),
|
accountNameTreeFrom ["a","b"] == Node "top" [Node "a" [], Node "b" []],
|
||||||
accountNameTreeFrom ["a","a:b"] == Tree ("top", [Tree ("a", [Tree ("a:b", [])])]),
|
accountNameTreeFrom ["a","a:b"] == Node "top" [Node "a" [Node "a:b" []]],
|
||||||
accountNameTreeFrom ["a:b"] == Tree ("top", [Tree ("a", [Tree ("a:b", [])])])
|
accountNameTreeFrom ["a:b"] == Node "top" [Node "a" [Node "a:b" []]]
|
||||||
]
|
]
|
||||||
accountNameTreeFrom :: [AccountName] -> Tree AccountName
|
accountNameTreeFrom :: [AccountName] -> Tree AccountName
|
||||||
accountNameTreeFrom accts =
|
accountNameTreeFrom accts =
|
||||||
Tree ("top", accountsFrom (topAccountNames accts))
|
Node "top" (accountsFrom (topAccountNames accts))
|
||||||
where
|
where
|
||||||
accountsFrom :: [AccountName] -> [Tree AccountName]
|
accountsFrom :: [AccountName] -> [Tree AccountName]
|
||||||
accountsFrom [] = []
|
accountsFrom [] = []
|
||||||
accountsFrom as = [Tree (a, accountsFrom $ subs a) | a <- as]
|
accountsFrom as = [Node a (accountsFrom $ subs a) | a <- as]
|
||||||
subs = (subAccountNamesFrom accts)
|
subs = (subAccountNamesFrom accts)
|
||||||
|
|
||||||
showAccountNameTree :: Tree AccountName -> String
|
showAccountNameTree :: Tree AccountName -> String
|
||||||
showAccountNameTree t =
|
showAccountNameTree t =
|
||||||
topacct ++ "\n" ++ concatMap showAccountNameTree (branches t)
|
topacct ++ "\n" ++ concatMap showAccountNameTree (subForest t)
|
||||||
where
|
where
|
||||||
topacct = indentAccountName 0 $ antacctname t
|
topacct = indentAccountName 0 $ rootLabel t
|
||||||
|
|
||||||
|
@ -1,16 +1,10 @@
|
|||||||
|
module BasicTypes
|
||||||
module BasicTypes
|
|
||||||
where
|
where
|
||||||
import Utils
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
type Date = String
|
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
|
-- amounts
|
||||||
{- a simple amount is a currency, quantity pair:
|
{- a simple amount is a currency, quantity pair:
|
||||||
0
|
0
|
||||||
|
2
Utils.hs
2
Utils.hs
@ -1,6 +1,7 @@
|
|||||||
module Utils (
|
module Utils (
|
||||||
module Utils,
|
module Utils,
|
||||||
module Data.List,
|
module Data.List,
|
||||||
|
module Data.Tree,
|
||||||
module Debug.Trace,
|
module Debug.Trace,
|
||||||
module Text.Printf,
|
module Text.Printf,
|
||||||
module Text.Regex,
|
module Text.Regex,
|
||||||
@ -9,6 +10,7 @@ module Utils (
|
|||||||
where
|
where
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Data.List
|
import Data.List
|
||||||
|
import Data.Tree
|
||||||
import Debug.Trace
|
import Debug.Trace
|
||||||
import Test.QuickCheck (quickCheck)
|
import Test.QuickCheck (quickCheck)
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
|
Loading…
Reference in New Issue
Block a user