rename old Account module to AccountName, extract new Account module from Models

Account.hs

@@ -1,89 +1,101 @@
-
 module Account
 where
 import Utils
 import BasicTypes
-
+import AccountName
--- AccountNames are strings like "assets:cash:petty"; from these we build
+import Entry
--- the chart of accounts, which should be a simple hierarchy. 
+import Transaction
-type AccountName = String
+import EntryTransaction
-
+import Ledger
-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
+-- an Account caches an account's name, balance and transactions for convenience
--- structures to eg display the account tree with boring accounts elided.
+type Account = (AccountName,[EntryTransaction],Amount)
--- first, here is a tree of AccountNames; Account and Account tree are
--- defined later.
 
-antacctname = fst . node
+aname (a,_,_) = a
-antsubs = snd . node
+atransactions (_,ts,_) = ts
+abalance (_,_,b) = b
 
-accountNameTreeFrom_props =
+mkAccount :: Ledger -> AccountName -> Account
-    [
+mkAccount l a = (a, accountNameTransactionsNoSubs l a, accountNameBalance l a)
-     accountNameTreeFrom ["a"] == Tree ("top", [Tree ("a",[])]),
+
-     accountNameTreeFrom ["a","b"] == Tree ("top", [Tree ("a", []), Tree ("b", [])]),
+accountNameBalance :: Ledger -> AccountName -> Amount
-     accountNameTreeFrom ["a","a:b"] == Tree ("top", [Tree ("a", [Tree ("a:b", [])])]),
+accountNameBalance l a = sumEntryTransactions (accountNameTransactions l a)
-     accountNameTreeFrom ["a:b"] == Tree ("top", [Tree ("a", [Tree ("a:b", [])])])
+
-    ]
+accountNameTransactions :: Ledger -> AccountName -> [EntryTransaction]
-accountNameTreeFrom :: [AccountName] -> Tree AccountName
+accountNameTransactions l a = ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l
-accountNameTreeFrom accts = 
+
-    Tree ("top", accountsFrom (topAccountNames accts))
+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]
+          showAccountBranch :: Tree Account -> String
-          accountsFrom [] = []
+          showAccountBranch at = 
-          accountsFrom as = [Tree (a, accountsFrom $ subs a) | a <- as]
+              topacct ++ "\n" ++ subaccts
-          subs = (subAccountNamesFrom accts)
+--               case boring of
-
+--                 True  -> 
-showAccountNameTree :: Tree AccountName -> String
+--                 False -> 
-showAccountNameTree at = showAccountNameTrees $ antsubs at
-
-showAccountNameTrees :: [Tree AccountName] -> String
-showAccountNameTrees ats =
-    concatMap showAccountNameBranch ats
-        where
-          showAccountNameBranch at = topacct ++ "\n" ++ subs
               where
-                topacct = indentAccountName $ antacctname at
+                topacct = (showAmount bal) ++ "  " ++ (indentAccountName name)
-                subs = showAccountNameTrees $ antsubs at
+                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)
 

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
+

EntryTransaction.hs

@@ -7,10 +7,10 @@ import Entry
 import Transaction
 
 
--- We parse Entries containing Transactions and flatten them into
+-- We convert Transactions into EntryTransactions, which are (entry,
--- (entry,transaction) pairs (entrytransactions, hereafter referred to as
+-- transaction) pairs, since I couldn't easily just have transactions
--- "transactions") for easier processing. (So far, these types have
+-- reference their entry like in OO.  These are referred to as just
--- morphed through E->T; (T,E); ET; E<->T; (E,T)).
+-- "transactions" hereafter.
 
 type EntryTransaction = (Entry,Transaction)
 

Ledger.hs

@@ -1,7 +1,7 @@
 module Ledger
 where
 import Utils
-import Account
+import AccountName
 import BasicTypes
 import Entry
 import EntryTransaction

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
-
+import Account
-
--- 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)
 

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..."

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

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

hledger.hs

@@ -1,7 +1,26 @@
 #!/usr/bin/env runhaskell
--- hledger - ledger-compatible money management utilities (& haskell study)
+{-
--- GPLv3, (c) Simon Michael & contributors, 
+hledger - ledger-compatible money management utilities (& haskell study)
--- John Wiegley's ledger is at http://newartisans.com/ledger.html
+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