reorg, split types into separate modules

Account.hs

@@ -1,5 +1,5 @@
 
-module Account -- 
+module Account
 where
 
 import Debug.Trace

BasicTypes.hs

@@ -0,0 +1,44 @@
+
+module BasicTypes
+where
+
+import Debug.Trace
+import Text.Printf
+import Text.Regex
+import Data.List
+
+import Utils
+
+
+type Date = String
+type Status = Bool
+
+-- amounts
+-- amount arithmetic currently ignores currency conversion
+
+data Amount = Amount {
+                      currency :: String,
+                      quantity :: Double
+                     } deriving (Eq,Ord)
+
+instance Num Amount where
+    abs (Amount c q) = Amount c (abs q)
+    signum (Amount c q) = Amount c (signum q)
+    fromInteger i = Amount "$" (fromInteger i)
+    (+) = amountAdd
+    (-) = amountSub
+    (*) = amountMult
+Amount ca qa `amountAdd` Amount cb qb = Amount ca (qa + qb)
+Amount ca qa `amountSub` Amount cb qb = Amount ca (qa - qb)
+Amount ca qa `amountMult` Amount cb qb = Amount ca (qa * qb)
+
+instance Show Amount where show = amountRoundedOrZero
+
+amountRoundedOrZero :: Amount -> String
+amountRoundedOrZero (Amount cur qty) =
+    let rounded = printf "%.2f" qty in
+    case rounded of
+      "0.00"    -> "0"
+      "-0.00"   -> "0"
+      otherwise -> cur ++ rounded
+

Entry.hs

@@ -0,0 +1,65 @@
+
+module Entry
+where
+
+import Debug.Trace
+import Text.Printf
+import Text.Regex
+import Data.List
+
+import Utils
+import BasicTypes
+import Transaction
+
+
+-- a register entry is displayed as two or more lines like this:
+-- date       description          account                 amount       balance
+-- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
+--                                 aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
+--                                 ...                     ...         ...
+-- dateWidth = 10
+-- descWidth = 20
+-- acctWidth = 22
+-- amtWidth  = 11
+-- balWidth  = 12
+
+data Entry = Entry {
+                    edate :: Date,
+                    estatus :: Status,
+                    ecode :: String,
+                    edescription :: String,
+                    etransactions :: [Transaction]
+                   } deriving (Eq,Ord)
+
+instance Show Entry where show = showEntry
+
+showEntry e = (showDate $ edate e) ++ " " ++ (showDescription $ edescription e) ++ " "
+showDate d = printf "%-10s" d
+showDescription s = printf "%-20s" (elideRight 20 s)
+
+isEntryBalanced :: Entry -> Bool
+isEntryBalanced e = (sumTransactions . etransactions) e == 0
+
+autofillEntry :: Entry -> Entry
+autofillEntry e = 
+    Entry (edate e) (estatus e) (ecode e) (edescription e)
+              (autofillTransactions (etransactions e))
+
+-- modifier & periodic entries
+
+data ModifierEntry = ModifierEntry { -- aka "automated entry"
+                    valueexpr :: String,
+                    m_transactions :: [Transaction]
+                   } deriving (Eq)
+
+instance Show ModifierEntry where 
+    show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e))
+
+data PeriodicEntry = PeriodicEntry {
+                    periodexpr :: String,
+                    p_transactions :: [Transaction]
+                   } deriving (Eq)
+
+instance Show PeriodicEntry where 
+    show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e))
+

EntryTransaction.hs

@@ -0,0 +1,82 @@
+
+module EntryTransaction
+where
+
+import Debug.Trace
+import Text.Printf
+import Text.Regex
+import Data.List
+
+import Utils
+import BasicTypes
+import Account
+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)).
+
+type EntryTransaction = (Entry,Transaction)
+
+entry       (e,t) = e
+transaction (e,t) = t
+date        (e,t) = edate e
+status      (e,t) = estatus e
+code        (e,t) = ecode e
+description (e,t) = edescription e
+account     (e,t) = taccount t
+amount      (e,t) = tamount t
+                                         
+flattenEntry :: Entry -> [EntryTransaction]
+flattenEntry e = [(e,t) | t <- etransactions e]
+
+entryTransactionsFrom :: [Entry] -> [EntryTransaction]
+entryTransactionsFrom es = concat $ map flattenEntry es
+
+sumEntryTransactions :: [EntryTransaction] -> Amount
+sumEntryTransactions ets = 
+    sumTransactions $ map transaction ets
+
+accountNamesFromTransactions :: [EntryTransaction] -> [AccountName]
+accountNamesFromTransactions ts = nub $ map account ts
+
+matchTransactionAccount :: String -> EntryTransaction -> Bool
+matchTransactionAccount s t =
+    case matchRegex (mkRegex s) (account t) of
+      Nothing -> False
+      otherwise -> True
+
+matchTransactionDescription :: String -> EntryTransaction -> Bool
+matchTransactionDescription s t =
+    case matchRegex (mkRegex s) (description t) of
+      Nothing -> False
+      otherwise -> True
+
+showTransactionsWithBalances :: [EntryTransaction] -> Amount -> String
+showTransactionsWithBalances [] _ = []
+showTransactionsWithBalances ts b =
+    unlines $ showTransactionsWithBalances' ts dummyt b
+        where
+          dummyt = (Entry "" False "" "" [], Transaction "" (Amount "" 0))
+          showTransactionsWithBalances' [] _ _ = []
+          showTransactionsWithBalances' (t:ts) tprev b =
+              (if (entry t /= (entry tprev))
+               then [showTransactionDescriptionAndBalance t b']
+               else [showTransactionAndBalance t b'])
+              ++ (showTransactionsWithBalances' ts t b')
+                  where b' = b + (amount t)
+
+showTransactionDescriptionAndBalance :: EntryTransaction -> Amount -> String
+showTransactionDescriptionAndBalance t b =
+    (showEntry $ entry t) ++ (showTransaction $ transaction t) ++ (showBalance b)
+
+showTransactionAndBalance :: EntryTransaction -> Amount -> String
+showTransactionAndBalance t b =
+    (replicate 32 ' ') ++ (showTransaction $ transaction t) ++ (showBalance b)
+
+showBalance :: Amount -> String
+showBalance b = printf " %12s" (amountRoundedOrZero b)
+

Ledger.hs

@@ -0,0 +1,69 @@
+module Ledger
+where
+
+import Debug.Trace
+import Text.Printf
+import Text.Regex
+import Data.List
+
+import Utils
+import Account
+import Entry
+import EntryTransaction
+
+
+data Ledger = Ledger {
+                      modifier_entries :: [ModifierEntry],
+                      periodic_entries :: [PeriodicEntry],
+                      entries :: [Entry]
+                     } deriving (Eq)
+
+instance Show Ledger where
+    show l = printf "Ledger with %d normal, %d modifier, %d periodic entries"
+             (show $ length $ modifier_entries l)
+             (show $ length $ periodic_entries l)
+             (show $ length $ entries l)
+
+ledgerTransactions :: Ledger -> [EntryTransaction]
+ledgerTransactions l = entryTransactionsFrom $ entries l
+
+ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction]
+ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l
+ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l
+ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l
+ledgerTransactionsMatching (acctregexps,descregexps) l =
+    intersect 
+    (concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
+    (concat [filter (matchTransactionDescription r) ts | r <- descregexps])
+    where ts = ledgerTransactions l
+
+ledgerAccountNamesUsed :: Ledger -> [AccountName]
+ledgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l
+
+ledgerAccountNames :: Ledger -> [AccountName]
+ledgerAccountNames = sort . expandAccountNames . ledgerAccountNamesUsed
+
+ledgerTopAccountNames :: Ledger -> [AccountName]
+ledgerTopAccountNames l = filter (notElem ':') (ledgerAccountNames l)
+
+ledgerAccountNamesMatching :: [String] -> Ledger -> [AccountName]
+ledgerAccountNamesMatching [] l = ledgerAccountNamesMatching [".*"] l
+ledgerAccountNamesMatching acctregexps l =
+    concat [filter (matchAccountName r) accountNames | r <- acctregexps]
+        where accountNames = ledgerTopAccountNames l
+
+ledgerAccounts :: Ledger -> Tree AccountName
+ledgerAccounts l = accountFrom $ ledgerAccountNames l
+
+showLedgerAccounts :: Ledger -> [String] -> Int -> String
+showLedgerAccounts l acctpats depth = 
+    showAccountsWithBalances l accounts depth
+        where
+          accounts = ledgerAccountsMatching l acctpats
+
+showAccountsWithBalances :: Ledger -> [Account] -> Int -> String
+showAccountsWithBalances l accts depth =
+    ""
+
+ledgerAccountsMatching :: Ledger -> [String] -> [Account]
+ledgerAccountsMatching l acctpats = []

Makefile

@@ -1,5 +1,5 @@
 build: Tags
-	ghc --make -O2 hledger.hs
+	ghc --make hledger.hs
 
 Tags:
 	hasktags *hs

Models.hs

@@ -1,5 +1,13 @@
-
-module Models -- data types & behaviours
+-- data types & behaviours
+module Models (
+               module Models,
+               module Ledger,
+               module EntryTransaction,
+               module Transaction,
+               module Entry,
+               module Account,
+               module BasicTypes,
+              )
 where
 
 import Debug.Trace
@@ -8,234 +16,24 @@ import Text.Regex
 import Data.List
 
 import Utils
+import BasicTypes
 import Account
+import Entry
+import Transaction
+import EntryTransaction
+import Ledger
 
--- basic types
 
-type Date = String
-type Status = Bool
+-- any top-level stuff that mixed up the other types
 
--- amounts
--- amount arithmetic currently ignores currency conversion
 
-data Amount = Amount {
-                      currency :: String,
-                      quantity :: Double
-                     } deriving (Eq,Ord)
+-- showAccountNamesWithBalances :: [(AccountName,String)] -> Ledger -> String
+-- showAccountNamesWithBalances as l =
+--     unlines $ map (showAccountNameAndBalance l) as
 
-instance Num Amount where
-    abs (Amount c q) = Amount c (abs q)
-    signum (Amount c q) = Amount c (signum q)
-    fromInteger i = Amount "$" (fromInteger i)
-    (+) = amountAdd
-    (-) = amountSub
-    (*) = amountMult
-Amount ca qa `amountAdd` Amount cb qb = Amount ca (qa + qb)
-Amount ca qa `amountSub` Amount cb qb = Amount ca (qa - qb)
-Amount ca qa `amountMult` Amount cb qb = Amount ca (qa * qb)
-
-instance Show Amount where show = amountRoundedOrZero
-
-amountRoundedOrZero :: Amount -> String
-amountRoundedOrZero (Amount cur qty) =
-    let rounded = printf "%.2f" qty in
-    case rounded of
-      "0.00"    -> "0"
-      "-0.00"   -> "0"
-      otherwise -> cur ++ rounded
-
--- modifier & periodic entries
-
-data ModifierEntry = ModifierEntry { -- aka "automated entry"
-                    valueexpr :: String,
-                    m_transactions :: [Transaction]
-                   } deriving (Eq)
-
-instance Show ModifierEntry where 
-    show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e))
-
-data PeriodicEntry = PeriodicEntry {
-                    periodexpr :: String,
-                    p_transactions :: [Transaction]
-                   } deriving (Eq)
-
-instance Show PeriodicEntry where 
-    show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e))
-
--- entries
--- a register entry is displayed as two or more lines like this:
--- date       description          account                 amount       balance
--- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
---                                 aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
---                                 ...                     ...         ...
--- dateWidth = 10
--- descWidth = 20
--- acctWidth = 22
--- amtWidth  = 11
--- balWidth  = 12
-
-data Entry = Entry {
-                    edate :: Date,
-                    estatus :: Status,
-                    ecode :: String,
-                    edescription :: String,
-                    etransactions :: [Transaction]
-                   } deriving (Eq,Ord)
-
-instance Show Entry where show = showEntry
-
-showEntry e = (showDate $ edate e) ++ " " ++ (showDescription $ edescription e) ++ " "
-showDate d = printf "%-10s" d
-showDescription s = printf "%-20s" (elideRight 20 s)
-
-isEntryBalanced :: Entry -> Bool
-isEntryBalanced e = (sumTransactions . etransactions) e == 0
-
-autofillEntry :: Entry -> Entry
-autofillEntry e = 
-    Entry (edate e) (estatus e) (ecode e) (edescription e)
-              (autofillTransactions (etransactions e))
-
--- transactions
-
-data Transaction = Transaction {
-                                taccount :: AccountName,
-                                tamount :: Amount
-                               } deriving (Eq,Ord)
-
-instance Show Transaction where show = showTransaction
-
-showTransaction t = (showAccountName $ taccount t) ++ "  " ++ (showAmount $ tamount t) 
-showAmount amt = printf "%11s" (show amt)
-showAccountName s = printf "%-22s" (elideRight 22 s)
-
-elideRight width s =
-    case length s > width of
-      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
-            where isNormal t = (currency $ tamount t) /= "AUTO" in
-    case (length as) of
-      0 -> ns
-      1 -> ns ++ [balanceTransaction $ head as]
-          where balanceTransaction t = t{tamount = -(sumTransactions ns)}
-      otherwise -> error "too many blank transactions in this entry"
-
-sumTransactions :: [Transaction] -> Amount
-sumTransactions ts = sum [tamount t | t <- ts]
-
--- entrytransactions
--- 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)).
-
-type EntryTransaction = (Entry,Transaction)
-
-entry       (e,t) = e
-transaction (e,t) = t
-date        (e,t) = edate e
-status      (e,t) = estatus e
-code        (e,t) = ecode e
-description (e,t) = edescription e
-account     (e,t) = taccount t
-amount      (e,t) = tamount t
-                                         
-flattenEntry :: Entry -> [EntryTransaction]
-flattenEntry e = [(e,t) | t <- etransactions e]
-
-entryTransactionsFrom :: [Entry] -> [EntryTransaction]
-entryTransactionsFrom es = concat $ map flattenEntry es
-
-sumEntryTransactions :: [EntryTransaction] -> Amount
-sumEntryTransactions ets = 
-    sumTransactions $ map transaction ets
-
-matchTransactionAccount :: String -> EntryTransaction -> Bool
-matchTransactionAccount s t =
-    case matchRegex (mkRegex s) (account t) of
-      Nothing -> False
-      otherwise -> True
-
-matchTransactionDescription :: String -> EntryTransaction -> Bool
-matchTransactionDescription s t =
-    case matchRegex (mkRegex s) (description t) of
-      Nothing -> False
-      otherwise -> True
-
-showTransactionsWithBalances :: [EntryTransaction] -> Amount -> String
-showTransactionsWithBalances [] _ = []
-showTransactionsWithBalances ts b =
-    unlines $ showTransactionsWithBalances' ts dummyt b
-        where
-          dummyt = (Entry "" False "" "" [], Transaction "" (Amount "" 0))
-          showTransactionsWithBalances' [] _ _ = []
-          showTransactionsWithBalances' (t:ts) tprev b =
-              (if (entry t /= (entry tprev))
-               then [showTransactionDescriptionAndBalance t b']
-               else [showTransactionAndBalance t b'])
-              ++ (showTransactionsWithBalances' ts t b')
-                  where b' = b + (amount t)
-
-showTransactionDescriptionAndBalance :: EntryTransaction -> Amount -> String
-showTransactionDescriptionAndBalance t b =
-    (showEntry $ entry t) ++ (showTransaction $ transaction t) ++ (showBalance b)
-
-showTransactionAndBalance :: EntryTransaction -> Amount -> String
-showTransactionAndBalance t b =
-    (replicate 32 ' ') ++ (showTransaction $ transaction t) ++ (showBalance b)
-
-showBalance :: Amount -> String
-showBalance b = printf " %12s" (amountRoundedOrZero b)
-
--- more account functions
-
-accountNamesFromTransactions :: [EntryTransaction] -> [AccountName]
-accountNamesFromTransactions ts = nub $ map account ts
-
--- like expandAccountNames, but goes from the top down and elides accountNames
--- with only one child and no transactions. Returns accountNames paired with
--- the appropriate indented name. Eg
--- [("assets","assets"),("assets:cash:gifts","  cash:gifts"),("assets:checking","  checking")]
-expandAccountNamesMostly :: Ledger -> [AccountName] -> [(AccountName, String)]
-expandAccountNamesMostly l as = concat $ map (expandAccountNameMostly l) as
-    where 
-      expandAccountNameMostly :: Ledger -> AccountName -> [(AccountName, String)]
-      expandAccountNameMostly l a =
-          [(acct, acctname)] ++ (concat $ map (expandAccountNameMostly l) subs)
-              where 
-                subs = subAccountNames l a
-                txns = accountTransactionsNoSubs l a
-                (acct, acctname) = 
-                    case (length subs == 1) && (length txns == 0) of
-                      False -> (a, indentAccountName a)
-                      True -> (a, indentAccountName a ++ ":" ++ subname)
-                        where 
-                          sub = head subs
-                          subname = (reverse . takeWhile (/= ':') . reverse) sub
-
-subAccountNames :: Ledger -> AccountName -> [AccountName]
-subAccountNames l a = [a' | a' <- ledgerAccountNames l, a `isSubAccountNameOf` a']
-
-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
+-- showAccountNameAndBalance :: Ledger -> (AccountName, String) -> String
+-- showAccountNameAndBalance l (a, adisplay) =
+--     printf "%20s  %s" (showBalance $ accountBalance l a) adisplay
 
 accountBalance :: Ledger -> AccountName -> Amount
 accountBalance l a =
@@ -255,10 +53,10 @@ addDataToAccounts :: Ledger -> (Tree AccountName) -> (Tree AccountData)
 addDataToAccounts l acct = 
     Tree (acctdata, map (addDataToAccounts l) (atsubs acct))
         where 
+          acctdata = (aname, atxns, abal)
           aname = atacct acct
           atxns = accountTransactionsNoSubs l aname
           abal = accountBalance l aname
-          acctdata = (aname, atxns, abal)
 
 -- an AccountData tree adds some other things we want to cache for
 -- convenience, like the account's balance and transactions.
@@ -295,7 +93,7 @@ adamt (_,_,amt) = amt
 -- $5    b
 -- $5      c
 -- $0  d
-showAccountWithBalances :: Ledger -> (Tree AccountData) -> String
+showAccountWithBalances :: Ledger -> Tree AccountData -> String
 showAccountWithBalances l adt = (showAccountsWithBalance l) (adtsubs adt)
 
 showAccountsWithBalance :: Ledger -> [Tree AccountData] -> String
@@ -304,9 +102,10 @@ showAccountsWithBalance l adts =
         where
           showAccountDataBranch :: Tree AccountData -> String
           showAccountDataBranch adt = 
-              case boring of
-                True  -> 
-                False -> topacct ++ "\n" ++ subs
+              topacct ++ "\n" ++ subs
+--               case boring of
+--                 True  -> 
+--                 False -> 
               where
                 topacct = (showAmount abal) ++ "  " ++ (indentAccountName aname)
                 showAmount amt = printf "%11s" (show amt)
@@ -316,61 +115,9 @@ showAccountsWithBalance l adts =
                 subs = (showAccountsWithBalance l) $ adtsubs adt
                 boring = (length atxns == 0) && ((length subs) == 1)
 
-    
-
-
--- ledger
-
-data Ledger = Ledger {
-                      modifier_entries :: [ModifierEntry],
-                      periodic_entries :: [PeriodicEntry],
-                      entries :: [Entry]
-                     } deriving (Eq)
-
-instance Show Ledger where
-    show l = "Ledger with " ++ m ++ " modifier, " ++ p ++ " periodic, " ++ e ++ " normal entries:\n"
-                     ++ (concat $ map show (modifier_entries l))
-                     ++ (concat $ map show (periodic_entries l))
-                     ++ (concat $ map show (entries l))
-                     where 
-                       m = show $ length $ modifier_entries l
-                       p = show $ length $ periodic_entries l
-                       e = show $ length $ entries l
-
-ledgerTransactions :: Ledger -> [EntryTransaction]
-ledgerTransactions l = entryTransactionsFrom $ entries l
-
-ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction]
-ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l
-ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l
-ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l
-ledgerTransactionsMatching (acctregexps,descregexps) l =
-    intersect 
-    (concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
-    (concat [filter (matchTransactionDescription r) ts | r <- descregexps])
-    where ts = ledgerTransactions l
-
-ledgerAccountNamesUsed :: Ledger -> [AccountName]
-ledgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l
-
-ledgerAccountNames :: Ledger -> [AccountName]
-ledgerAccountNames = sort . expandAccountNames . ledgerAccountNamesUsed
-
-ledgerTopAccountNames :: Ledger -> [AccountName]
-ledgerTopAccountNames l = filter (notElem ':') (ledgerAccountNames l)
-
-ledgerAccountNamesMatching :: [String] -> Ledger -> [AccountName]
-ledgerAccountNamesMatching [] l = ledgerAccountNamesMatching [".*"] l
-ledgerAccountNamesMatching acctregexps l =
-    concat [filter (matchAccountName r) accountNames | r <- acctregexps]
-        where accountNames = ledgerTopAccountNames l
-
-ledgerAccounts :: Ledger -> Tree AccountName
-ledgerAccounts l = accountFrom $ ledgerAccountNames l
-
 ledgerAccountsData :: Ledger -> Tree AccountData
 ledgerAccountsData l = addDataToAccounts l (ledgerAccounts l)
 
-showLedgerAccountsWithBalances :: Ledger -> String
-showLedgerAccountsWithBalances l =
-    showAccountWithBalances l (ledgerAccountsData l)
+showLedgerAccountsWithBalances :: Ledger -> Tree AccountData -> String
+showLedgerAccountsWithBalances l adt =
+    showAccountWithBalances l adt

Options.hs

@@ -1,5 +1,5 @@
 
-module Options
+module Options (module Options, usageInfo)
 where
     
 import System.Console.GetOpt
@@ -15,7 +15,7 @@ options :: [OptDescr Flag]
 options = [
             Option ['v'] ["version"] (NoArg Version)     "show version number"
           , Option ['f'] ["file"]    (OptArg inp "FILE") "ledger file, or - to read stdin"
-          , Option ['s'] ["subtotal"] (NoArg ShowSubs)     "balance: show sub-accounts; other: show subtotals"
+--          , Option ['s'] ["subtotal"] (NoArg ShowSubs)     "balance: show sub-accounts; register: show subtotals"
           ]
 
 inp :: Maybe String -> Flag
@@ -25,8 +25,9 @@ getOptions :: [String] -> IO ([Flag], [String])
 getOptions argv =
     case getOpt RequireOrder options argv of
       (o,n,[]  ) -> return (o,n)
-      (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
-        where header = "Usage: hledger [OPTIONS]"
+      (_,_,errs) -> ioError (userError (concat errs ++ usageInfo usageHeader options))
+
+usageHeader = "Usage: hledger [OPTIONS] register|balance [MATCHARGS]"
 
 get_content :: Flag -> Maybe String
 get_content (File s) = Just s
@@ -45,3 +46,6 @@ ledgerPatternArgs args =
     case "--" `elem` args of
       True -> ((takeWhile (/= "--") args), tail $ (dropWhile (/= "--") args))
       False -> (args,[])
+
+depthOption :: [Flag] -> Int
+depthOption opts = 1

TODO

@@ -1,3 +1,17 @@
+cleanup/reorganize
+hledger
+ Options
+ Tests
+  Parse
+   Models
+    Ledger
+     EntryTransaction
+      Entry
+       Transaction
+        Account
+        BasicTypes
+         Utils
+
 basic features
  balance
   show balances with new tree structures
@@ -21,6 +35,8 @@ more features
 new features
  graph automation
  smart data entry
+ incorporate timeclock features
+ timelog simple amount entries
 
 tests
  better use of quickcheck/smallcheck

Tests.hs

@@ -11,7 +11,6 @@ import Test.HUnit
 
 import Options
 import Models
-import Account
 import Parse
 
 -- sample data
@@ -155,6 +154,7 @@ ledger7_str = "\
 \    assets:checking                                 \n\
 \\n" --"
 
+l = ledger7
 ledger7 = Ledger
           [] 
           [] 
@@ -167,7 +167,8 @@ ledger7 = Ledger
                                 Transaction {taccount="equity:opening balances", 
                                              tamount=Amount {currency="$", quantity=(-4.82)}}
                                ]
-                 },
+                 }
+          ,
            Entry {
                   edate="2007/02/01", estatus=False, ecode="*", edescription="ayres suites",
                   etransactions=[
@@ -177,6 +178,46 @@ ledger7 = Ledger
                                              tamount=Amount {currency="$", quantity=(-179.92)}}
                                ]
                  }
+          ,
+           Entry {
+                  edate="2007/01/02", estatus=False, ecode="*", edescription="auto transfer to savings",
+                  etransactions=[
+                                Transaction {taccount="assets:saving", 
+                                             tamount=Amount {currency="$", quantity=200}},
+                                Transaction {taccount="assets:checking", 
+                                             tamount=Amount {currency="$", quantity=(-200)}}
+                               ]
+                 }
+          ,
+           Entry {
+                  edate="2007/01/03", estatus=False, ecode="*", edescription="poquito mas",
+                  etransactions=[
+                                Transaction {taccount="expenses:food:dining", 
+                                             tamount=Amount {currency="$", quantity=4.82}},
+                                Transaction {taccount="assets:cash", 
+                                             tamount=Amount {currency="$", quantity=(-4.82)}}
+                               ]
+                 }
+          ,
+           Entry {
+                  edate="2007/01/03", estatus=False, ecode="*", edescription="verizon",
+                  etransactions=[
+                                Transaction {taccount="expenses:phone", 
+                                             tamount=Amount {currency="$", quantity=95.11}},
+                                Transaction {taccount="assets:checking", 
+                                             tamount=Amount {currency="$", quantity=(-95.11)}}
+                               ]
+                 }
+          ,
+           Entry {
+                  edate="2007/01/03", estatus=False, ecode="*", edescription="discover",
+                  etransactions=[
+                                Transaction {taccount="liabilities:credit cards:discover", 
+                                             tamount=Amount {currency="$", quantity=80}},
+                                Transaction {taccount="assets:checking", 
+                                             tamount=Amount {currency="$", quantity=(-80)}}
+                               ]
+                 }
           ]
 
 -- utils

Transaction.hs

@@ -0,0 +1,52 @@
+
+module Transaction
+where
+
+import Debug.Trace
+import Text.Printf
+import Text.Regex
+import Data.List
+
+import Utils
+import BasicTypes
+import Account
+
+
+data Transaction = Transaction {
+                                taccount :: AccountName,
+                                tamount :: Amount
+                               } deriving (Eq,Ord)
+
+instance Show Transaction where show = showTransaction
+
+showTransaction t = (showAccountName $ taccount t) ++ "  " ++ (showAmount $ tamount t) 
+showAmount amt = printf "%11s" (show amt)
+showAccountName s = printf "%-22s" (elideRight 22 s)
+
+elideRight width s =
+    case length s > width of
+      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
+            where isNormal t = (currency $ tamount t) /= "AUTO" in
+    case (length as) of
+      0 -> ns
+      1 -> ns ++ [balanceTransaction $ head as]
+          where balanceTransaction t = t{tamount = -(sumTransactions ns)}
+      otherwise -> error "too many blank transactions in this entry"
+
+sumTransactions :: [Transaction] -> Amount
+sumTransactions ts = sum [tamount t | t <- ts]
+

Utils.hs

@@ -0,0 +1,29 @@
+
+module Utils
+where
+
+import Data.List
+import System.Directory
+
+rhead = head . reverse 
+rtail = reverse . tail . reverse 
+
+splitAtElement :: Eq a => a -> [a] -> [[a]]
+splitAtElement e l = 
+    case dropWhile (e==) l of
+      [] -> []
+      l' -> first : splitAtElement e rest
+        where
+          (first,rest) = break (e==) l'
+
+-- courtesy of allberry_b
+tildeExpand              :: FilePath -> IO FilePath
+tildeExpand ('~':[])     =  getHomeDirectory
+tildeExpand ('~':'/':xs) =  getHomeDirectory >>= return . (++ ('/':xs))
+-- ~name, requires -fvia-C or ghc 6.8
+--import System.Posix.User
+-- tildeExpand ('~':xs)     =  do let (user, path) = span (/= '/') xs
+--                                pw <- getUserEntryForName user
+--                                return (homeDirectory pw ++ path)
+tildeExpand xs           =  return xs
+

hledger.hs

@@ -6,6 +6,7 @@
 module Main -- application logic & most IO
 where
 
+import System.Environment (withArgs) -- for testing in old hugs
 import System
 import Data.List
 import Test.HUnit (runTestTT)
@@ -14,7 +15,6 @@ import Text.ParserCombinators.Parsec (parseFromFile, ParseError)
 
 import Options
 import Models
-import Account
 import Parse
 import Tests
 
@@ -28,7 +28,7 @@ main = do
       if "reg" `isPrefixOf` command then (register opts args')
       else if "bal" `isPrefixOf` command then balance opts args'
            else if "test" `isPrefixOf` command then test
-                else error "could not recognise your command"
+                else putStr $ usageInfo usageHeader options
 
 -- commands
 
@@ -67,10 +67,13 @@ printRegister opts args ledger = do
 
 printBalance :: [Flag] -> [String] -> Ledger -> IO ()
 printBalance opts args ledger = do
-  putStr $ showLedgerAccountsWithBalances ledger
+--   putStr $ showAccountWithBalances ledger (ledgerAccountsData l)
+  putStr $ showLedgerAccounts ledger acctpats depth
       where 
         (acctpats,_) = ledgerPatternArgs args
-        showsubs = (ShowSubs `elem` opts)
-        accounts = case showsubs of
-                     True -> expandAccountNamesMostly ledger (ledgerTopAccountNames ledger)
-                     False -> [(a,indentAccountName a) | a <- ledgerAccountNamesMatching acctpats ledger]
+        depth = depthOption opts
+
+--         showsubs = (ShowSubs `elem` opts)
+--         accounts = case showsubs of
+--                      True -> expandAccountNamesMostly ledger (ledgerTopAccountNames ledger)
+--                      False -> [(a,indentAccountName a) | a <- ledgerAccountNamesMatching acctpats ledger]