From 1524dffbe28fc4d24191e5fa3d41c5c627dad4a0 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 18 Feb 2007 18:12:02 +0000 Subject: [PATCH] rename old Account module to AccountName, extract new Account module from Models --- Account.hs | 168 ++++++++++++++++++++++++-------------------- AccountName.hs | 88 +++++++++++++++++++++++ EntryTransaction.hs | 8 +-- Ledger.hs | 2 +- Models.hs | 99 ++------------------------ Options.hs | 32 +++++++++ TODO | 15 +--- Transaction.hs | 11 +-- hledger.hs | 25 ++++++- 9 files changed, 243 insertions(+), 205 deletions(-) create mode 100644 AccountName.hs diff --git a/Account.hs b/Account.hs index 7d58fe33d..1b9e50582 100644 --- a/Account.hs +++ b/Account.hs @@ -1,89 +1,101 @@ - module Account where import Utils import BasicTypes - --- AccountNames are strings like "assets:cash:petty"; from these we build --- the chart of accounts, which should be a simple hierarchy. -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 - -indentAccountName :: AccountName -> String -indentAccountName a = replicate (((accountNameLevel a) - 1) * 2) ' ' ++ (accountLeafName a) +import AccountName +import Entry +import Transaction +import EntryTransaction +import Ledger --- We could almost get by with just the above, but we need smarter --- structures to eg display the account tree with boring accounts elided. --- first, here is a tree of AccountNames; Account and Account tree are --- defined later. +-- an Account caches an account's name, balance and transactions for convenience +type Account = (AccountName,[EntryTransaction],Amount) -antacctname = fst . node -antsubs = snd . node +aname (a,_,_) = a +atransactions (_,ts,_) = ts +abalance (_,_,b) = b -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 :: [AccountName] -> Tree AccountName -accountNameTreeFrom accts = - Tree ("top", accountsFrom (topAccountNames accts)) +mkAccount :: Ledger -> AccountName -> Account +mkAccount l a = (a, accountNameTransactionsNoSubs l a, accountNameBalance l a) + +accountNameBalance :: Ledger -> AccountName -> Amount +accountNameBalance l a = sumEntryTransactions (accountNameTransactions l a) + +accountNameTransactions :: Ledger -> AccountName -> [EntryTransaction] +accountNameTransactions l a = ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l + +accountNameBalanceNoSubs :: Ledger -> AccountName -> Amount +accountNameBalanceNoSubs l a = sumEntryTransactions (accountNameTransactionsNoSubs l a) + +accountNameTransactionsNoSubs :: Ledger -> AccountName -> [EntryTransaction] +accountNameTransactionsNoSubs l a = ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l + +-- showAccountNamesWithBalances :: [(AccountName,String)] -> Ledger -> String +-- showAccountNamesWithBalances as l = +-- unlines $ map (showAccountNameAndBalance l) as + +-- showAccountNameAndBalance :: Ledger -> (AccountName, String) -> String +-- showAccountNameAndBalance l (a, adisplay) = +-- printf "%20s %s" (showBalance $ accountBalance l a) adisplay + + +-- 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 + +showAccountTreeWithBalances :: Ledger -> Int -> Tree Account -> String +showAccountTreeWithBalances l depth at = (showAccountTreesWithBalances l depth) (branches at) + +showAccountTreesWithBalances :: Ledger -> Int -> [Tree Account] -> String +showAccountTreesWithBalances _ 0 _ = "" +showAccountTreesWithBalances l depth ats = + concatMap showAccountBranch ats where - accountsFrom :: [AccountName] -> [Tree AccountName] - accountsFrom [] = [] - accountsFrom as = [Tree (a, accountsFrom $ subs a) | a <- as] - subs = (subAccountNamesFrom accts) - -showAccountNameTree :: Tree AccountName -> String -showAccountNameTree at = showAccountNameTrees $ antsubs at - -showAccountNameTrees :: [Tree AccountName] -> String -showAccountNameTrees ats = - concatMap showAccountNameBranch ats - where - showAccountNameBranch at = topacct ++ "\n" ++ subs + showAccountBranch :: Tree Account -> String + showAccountBranch at = + topacct ++ "\n" ++ subaccts +-- case boring of +-- True -> +-- False -> where - topacct = indentAccountName $ antacctname at - subs = showAccountNameTrees $ antsubs at + topacct = (showAmount bal) ++ " " ++ (indentAccountName name) + showAmount amt = printf "%20s" (show amt) + name = aname $ atacct at + txns = atransactions $ atacct at + bal = abalance $ atacct at + subaccts = (showAccountTreesWithBalances l (depth - 1)) $ branches at + boring = (length txns == 0) && ((length subaccts) == 1) + +-- we want to elide boring accounts in the account tree +-- +-- a (2 txns) +-- b (boring acct - 0 txns, exactly 1 sub) +-- c (5 txns) +-- d +-- to: +-- a (2 txns) +-- b:c (5 txns) +-- d + +-- elideAccountTree at = at + +elideAccountTree :: Tree Account -> Tree Account +elideAccountTree = id + +ledgerAccountTree :: Ledger -> Tree Account +ledgerAccountTree l = elideAccountTree $ addDataToAccountNameTree l (ledgerAccountNameTree l) + +ledgerAccountsMatching :: Ledger -> [String] -> [Account] +ledgerAccountsMatching l acctpats = undefined + +showLedgerAccounts :: Ledger -> Int -> String +showLedgerAccounts l depth = + showAccountTreeWithBalances l depth (ledgerAccountTree l) diff --git a/AccountName.hs b/AccountName.hs new file mode 100644 index 000000000..fa456ab7f --- /dev/null +++ b/AccountName.hs @@ -0,0 +1,88 @@ + +module AccountName +where +import Utils +import BasicTypes + +-- AccountNames are strings like "assets:cash:petty"; from these we build +-- the chart of accounts, which should be a simple hierarchy. +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 + +indentAccountName :: AccountName -> String +indentAccountName a = replicate (((accountNameLevel a) - 1) * 2) ' ' ++ (accountLeafName a) + + +-- We could almost get by with just the above, but we need smarter +-- structures to eg display the account tree with boring accounts elided. +-- 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 :: [AccountName] -> Tree AccountName +accountNameTreeFrom accts = + Tree ("top", accountsFrom (topAccountNames accts)) + where + accountsFrom :: [AccountName] -> [Tree AccountName] + accountsFrom [] = [] + accountsFrom as = [Tree (a, accountsFrom $ subs a) | a <- as] + subs = (subAccountNamesFrom accts) + +showAccountNameTree :: Tree AccountName -> String +showAccountNameTree at = showAccountNameTrees $ branches at + +showAccountNameTrees :: [Tree AccountName] -> String +showAccountNameTrees ats = + concatMap showAccountNameBranch ats + where + showAccountNameBranch at = topacct ++ "\n" ++ subaccts + where + topacct = indentAccountName $ antacctname at + subaccts = showAccountNameTrees $ branches at + diff --git a/EntryTransaction.hs b/EntryTransaction.hs index 3f90b4c40..53248538c 100644 --- a/EntryTransaction.hs +++ b/EntryTransaction.hs @@ -7,10 +7,10 @@ import Entry import Transaction --- We parse Entries containing Transactions and flatten them into --- (entry,transaction) pairs (entrytransactions, hereafter referred to as --- "transactions") for easier processing. (So far, these types have --- morphed through E->T; (T,E); ET; E<->T; (E,T)). +-- We convert Transactions into EntryTransactions, which are (entry, +-- transaction) pairs, since I couldn't easily just have transactions +-- reference their entry like in OO. These are referred to as just +-- "transactions" hereafter. type EntryTransaction = (Entry,Transaction) diff --git a/Ledger.hs b/Ledger.hs index f6ab053fe..8b98df566 100644 --- a/Ledger.hs +++ b/Ledger.hs @@ -1,7 +1,7 @@ module Ledger where import Utils -import Account +import AccountName import BasicTypes import Entry import EntryTransaction diff --git a/Models.hs b/Models.hs index db0c64c03..fb12bd372 100644 --- a/Models.hs +++ b/Models.hs @@ -1,112 +1,21 @@ -- data types & behaviours module Models ( module Models, + module Account, module Ledger, module EntryTransaction, module Transaction, module Entry, - module Account, + module AccountName, module BasicTypes, ) where import Utils import BasicTypes -import Account +import AccountName import Entry import Transaction import EntryTransaction import Ledger - - --- top-level stuff that mixes types - - --- an Account caches an account's name, balance and transactions for convenience -type Account = (AccountName,[EntryTransaction],Amount) -aname (a,_,_) = a -atxns (_,ts,_) = ts -abal (_,_,b) = b - -mkAccount :: Ledger -> AccountName -> Account -mkAccount l a = (a, accountNameTransactionsNoSubs l a, accountNameBalance l a) - -accountNameBalance :: Ledger -> AccountName -> Amount -accountNameBalance l a = sumEntryTransactions (accountNameTransactions l a) - -accountNameTransactions :: Ledger -> AccountName -> [EntryTransaction] -accountNameTransactions l a = ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l - -accountNameBalanceNoSubs :: Ledger -> AccountName -> Amount -accountNameBalanceNoSubs l a = sumEntryTransactions (accountNameTransactionsNoSubs l a) - -accountNameTransactionsNoSubs :: Ledger -> AccountName -> [EntryTransaction] -accountNameTransactionsNoSubs l a = ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l - --- showAccountNamesWithBalances :: [(AccountName,String)] -> Ledger -> String --- showAccountNamesWithBalances as l = --- unlines $ map (showAccountNameAndBalance l) as - --- showAccountNameAndBalance :: Ledger -> (AccountName, String) -> String --- showAccountNameAndBalance l (a, adisplay) = --- printf "%20s %s" (showBalance $ accountBalance l a) adisplay - - --- a tree of Accounts - -atacct = fst . node - -addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account -addDataToAccountNameTree l ant = - Tree (mkAccount l aname, map (addDataToAccountNameTree l) (antsubs ant)) - where - aname = antacctname ant - -showAccountTreeWithBalances :: Ledger -> Int -> Tree Account -> String -showAccountTreeWithBalances l depth at = (showAccountTreesWithBalances l depth) (branches at) - -showAccountTreesWithBalances :: Ledger -> Int -> [Tree Account] -> String -showAccountTreesWithBalances _ 0 _ = "" -showAccountTreesWithBalances l depth ats = - concatMap showAccountBranch ats - where - showAccountBranch :: Tree Account -> String - showAccountBranch at = - topacct ++ "\n" ++ subaccts --- case boring of --- True -> --- False -> - where - topacct = (showAmount bal) ++ " " ++ (indentAccountName name) - showAmount amt = printf "%20s" (show amt) - name = aname $ atacct at - txns = atxns $ atacct at - bal = abal $ atacct at - subaccts = (showAccountTreesWithBalances l (depth - 1)) $ branches at - boring = (length txns == 0) && ((length subaccts) == 1) - --- we want to elide boring accounts in the account tree --- --- a (2 txns) --- b (boring acct - 0 txns, exactly 1 sub) --- c (5 txns) --- d --- to: --- a (2 txns) --- b:c (5 txns) --- d - --- elideAccountTree at = at - -elideAccountTree :: Tree Account -> Tree Account -elideAccountTree = id - -ledgerAccountTree :: Ledger -> Tree Account -ledgerAccountTree l = elideAccountTree $ addDataToAccountNameTree l (ledgerAccountNameTree l) - -ledgerAccountsMatching :: Ledger -> [String] -> [Account] -ledgerAccountsMatching l acctpats = undefined - -showLedgerAccounts :: Ledger -> Int -> String -showLedgerAccounts l depth = - showAccountTreeWithBalances l depth (ledgerAccountTree l) +import Account diff --git a/Options.hs b/Options.hs index 0c3e629ad..675e88214 100644 --- a/Options.hs +++ b/Options.hs @@ -51,3 +51,35 @@ getDepth opts = maximum $ [1] ++ map depthval opts where depthval (ShowSubs) = 9999 depthval _ = 1 + + +-- example: +-- module Opts where + +-- import System.Console.GetOpt +-- import Data.Maybe ( fromMaybe ) + +-- data Flag +-- = Verbose | Version +-- | Input String | Output String | LibDir String +-- deriving Show + +-- options :: [OptDescr Flag] +-- options = +-- [ Option ['v'] ["verbose"] (NoArg Verbose) "chatty output on stderr" +-- , Option ['V','?'] ["version"] (NoArg Version) "show version number" +-- , Option ['o'] ["output"] (OptArg outp "FILE") "output FILE" +-- , Option ['c'] [] (OptArg inp "FILE") "input FILE" +-- , Option ['L'] ["libdir"] (ReqArg LibDir "DIR") "library directory" +-- ] + +-- inp,outp :: Maybe String -> Flag +-- outp = Output . fromMaybe "stdout" +-- inp = Input . fromMaybe "stdin" + +-- compilerOpts :: [String] -> IO ([Flag], [String]) +-- compilerOpts argv = +-- case getOpt Permute options argv of +-- (o,n,[] ) -> return (o,n) +-- (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options)) +-- where header = "Usage: ic [OPTION...] files..." diff --git a/TODO b/TODO index 0c7b061ef..2223cf79b 100644 --- a/TODO +++ b/TODO @@ -1,23 +1,10 @@ cleanup/reorganize Entry/Transaction/EntryTransaction -hledger - Options - Tests - Parse - Models - Ledger - EntryTransaction - Entry - Transaction - Account - BasicTypes - Utils - basic features + handle mixed amounts and currencies balance elide boring accounts - handle mixed amounts and currencies print entry -j and -J graph data output diff --git a/Transaction.hs b/Transaction.hs index bf0148718..9a143c80e 100644 --- a/Transaction.hs +++ b/Transaction.hs @@ -3,7 +3,7 @@ module Transaction where import Utils import BasicTypes -import Account +import AccountName data Transaction = Transaction { @@ -22,15 +22,6 @@ elideRight width s = True -> take (width - 2) s ++ ".." False -> s --- elideAccountRight width abbrevlen a = --- case length a > width of --- False -> a --- True -> abbreviateAccountComponent abbrevlen a - --- abbreviateAccountComponent abbrevlen a = --- let components = splitAtElement ':' a in --- case - autofillTransactions :: [Transaction] -> [Transaction] autofillTransactions ts = let (ns, as) = partition isNormal ts diff --git a/hledger.hs b/hledger.hs index e2118d2ee..a598e9264 100644 --- a/hledger.hs +++ b/hledger.hs @@ -1,7 +1,26 @@ #!/usr/bin/env runhaskell --- hledger - ledger-compatible money management utilities (& haskell study) --- GPLv3, (c) Simon Michael & contributors, --- John Wiegley's ledger is at http://newartisans.com/ledger.html +{- +hledger - ledger-compatible money management utilities (& haskell study) +GPLv3, (c) Simon Michael & contributors, +John Wiegley's ledger is at http://newartisans.com/ledger.html + +The model/type/class hierarchy is roughly like this: + +hledger + Options + Tests + Parse + Models + Account + Ledger + EntryTransaction + Entry + Transaction + AccountName + BasicTypes + Utils + +-} -- application logic & most IO module Main