hledger/Account.hs
2007-02-16 09:00:17 +00:00

103 lines
3.3 KiB
Haskell

module Account
where
import Debug.Trace
import Text.Printf
import Text.Regex
import Data.List
import Utils
-- AccountNames are strings like "assets:cash:petty"; from these we build
-- the chart of accounts, which should be a simple hierarchy. We could
-- almost get by with just these, but see below.
type AccountName = String
accountNameComponents :: AccountName -> [String]
accountNameComponents = splitAtElement ':'
accountNameFromComponents :: [String] -> AccountName
accountNameFromComponents = concat . intersperse ":"
accountLeafName :: AccountName -> String
accountLeafName = rhead . accountNameComponents
accountNameLevel :: AccountName -> Int
accountNameLevel = length . accountNameComponents
-- ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"]
expandAccountNames :: [AccountName] -> [AccountName]
expandAccountNames as = nub $ concat $ map expand as
where expand as = map accountNameFromComponents (tail $ inits $ accountNameComponents as)
-- ["a:b:c","d:e"] -> ["a","d"]
topAccountNames :: [AccountName] -> [AccountName]
topAccountNames as = [a | a <- expandAccountNames as, accountNameLevel a == 1]
parentAccountName :: AccountName -> Maybe AccountName
parentAccountName a =
case accountNameLevel a > 1 of
True -> Just $ accountNameFromComponents $ rtail $ accountNameComponents a
False -> Nothing
s `isSubAccountNameOf` p =
((p ++ ":") `isPrefixOf` s) && (accountNameLevel s == (accountNameLevel p + 1))
subAccountNamesFrom :: [AccountName] -> AccountName -> [AccountName]
subAccountNamesFrom accts a = filter (`isSubAccountNameOf` a) accts
matchAccountName :: String -> AccountName -> Bool
matchAccountName s a =
case matchRegex (mkRegex s) a of
Nothing -> False
otherwise -> True
-- We need structures smart enough to eg display the account tree with
-- boring accounts elided.
-- simple polymorphic tree. each node is a tuple of the node type and a
-- list of subtrees
newtype Tree a = Tree { unTree :: (a, [Tree a]) } deriving (Show,Eq)
-- an Account has a name and a list of sub-accounts - ie a tree of
-- AccountNames.
type Account = Tree AccountName
atacct = fst . unTree
atsubs = snd . unTree
nullacct = Tree ("", [])
accountFrom :: [AccountName] -> Account
accountFrom_props =
[
accountFrom [] == nullacct,
accountFrom ["a"] == Tree ("", [Tree ("a",[])]),
accountFrom ["a","b"] == Tree ("", [Tree ("a", []), Tree ("b", [])]),
accountFrom ["a","a:b"] == Tree ("", [Tree ("a", [Tree ("a:b", [])])]),
accountFrom ["a:b"] == Tree ("", [Tree ("a", [Tree ("a:b", [])])])
]
accountFrom accts =
Tree ("top", accountsFrom (topAccountNames accts))
where
accountsFrom :: [AccountName] -> [Account]
accountsFrom [] = []
accountsFrom as = [Tree (a, accountsFrom $ subs a) | a <- as]
subs = (subAccountNamesFrom accts)
showAccount :: Account -> String
showAccount at = showAccounts $ atsubs at
showAccounts :: [Account] -> String
showAccounts ats =
concatMap showAccountBranch ats
where
showAccountBranch at = topacct ++ "\n" ++ subs
where
topacct = indentAccountName $ atacct at
subs = showAccounts $ atsubs at
indentAccountName :: AccountName -> String
indentAccountName a = replicate (((accountNameLevel a) - 1) * 2) ' ' ++ (accountLeafName a)