sample Ledger for testing, get account list from a ledger

TODO

@@ -1,22 +1,20 @@
 testing
- more, easy tests
  get quickcheck working
  consider hunit dsl
  ledger regression/compatibility tests
 
 features
- auto transaction amounts
- parse , thousand separator
- register
-  show running total
  balance
-  show balances, summarized or in depth
+  show final balance
+  show per-account balances
  print
- more directives, especially include
  matching by account/description regexp
+ more directives, eg include
+ read timelog files
  -p period expressions
  -d display expressions
  -j and -J graph data output
+ graph automation
  auto entry generation
  read gnucash files
 

Tests.hs

@@ -110,6 +110,88 @@ sample_ledger6 = "\
 \;     equity:opening balances                         \n\
 \\n" --"
 
+sample_ledger7 = "\
+\2007/01/01 * opening balance\n\
+\    assets:cash                                $4.82\n\
+\    equity:opening balances                         \n\
+\\n\
+\2007/01/02 * ayres suites\n\
+\    expenses:vacation                        $179.92\n\
+\    assets:checking                                 \n\
+\\n\
+\2007/01/02 * auto transfer to savings\n\
+\    assets:saving                            $200.00\n\
+\    assets:checking                                 \n\
+\\n\
+\2007/01/03 * poquito mas\n\
+\    expenses:food:dining                       $4.82\n\
+\    assets:cash                                     \n\
+\\n\
+\2007/01/03 * verizon\n\
+\    expenses:phone                            $95.11\n\
+\    assets:checking                                 \n\
+\\n\
+\2007/01/03 * discover\n\
+\    liabilities:credit cards:discover         $80.00\n\
+\    assets:checking                                 \n\
+\\n\
+\2007/01/04 * blue cross\n\
+\    expenses:health:insurance                 $90.00\n\
+\    assets:checking                                 \n\
+\\n\
+\2007/01/05 * village market liquor\n\
+\    expenses:food:dining                       $6.48\n\
+\    assets:checking                                 \n\
+\\n" --"
+
+ledger7 = Ledger [] [] 
+          [
+           Entry {
+                  date="2007/01/01", status=False, code="*", description="opening balance",
+                  transactions=[
+                                Transaction {account="assets:cash", 
+                                             amount=Amount {currency="$", quantity=4.82}},
+                                Transaction {account="equity:opening balances", 
+                                             amount=Amount {currency="$", quantity=(-4.82)}}
+                               ]
+                 },
+           Entry {
+                  date="2007/02/01", status=False, code="*", description="ayres suites",
+                  transactions=[
+                                Transaction {account="expenses:vacation", 
+                                             amount=Amount {currency="$", quantity=179.92}},
+                                Transaction {account="assets:checking", 
+                                             amount=Amount {currency="$", quantity=(-179.92)}}
+                               ]
+                 }
+          ]
+
+-- 2007/01/02 * auto transfer to savings
+--     assets:saving                            $200.00
+--     assets:checking
+
+-- 2007/01/03 * poquito mas
+--     expenses:food:dining                       $4.82
+--     assets:cash
+
+-- 2007/01/03 * verizon
+--     expenses:phone                            $95.11
+--     assets:checking
+
+-- 2007/01/03 * discover
+--     liabilities:credit cards:discover         $80.00
+--     assets:checking
+
+-- 2007/01/04 * blue cross
+--     expenses:health:insurance                 $90.00
+--     assets:checking
+
+-- 2007/01/05 * village market liquor
+--     expenses:food:dining                       $6.48
+--     assets:checking
+
+
+
 -- utils
 
 assertParseEqual :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion

Types.hs

@@ -2,6 +2,7 @@
 module Types where
 
 import Text.Printf
+import List
 
 data Ledger = Ledger {
                       modifier_entries :: [ModifierEntry],
@@ -134,9 +135,6 @@ printRegister l = putStr $ showRegisterEntries (entries l) 0
 
 -- misc
 
-transactionsFrom :: [Entry] -> [Transaction]
-transactionsFrom es = concat $ map transactions es
-
 -- fill in missing amounts etc., as far as possible
 autofill :: Entry -> Entry
 autofill e = Entry (date e) (status e) (code e) (description e)
@@ -147,10 +145,7 @@ autofillTransactions ts =
     let (ns,as) = normalAndAutoTransactions ts in
     case (length as) of
       0 -> ns
-      1 -> let t = head as 
-               newamt = -(sumTransactions ns)
-           in 
-             ns ++ [Transaction (account t) newamt]
+      1 -> ns ++ [Transaction (account (head as)) (-(sumTransactions ns))]
       otherwise -> error "too many blank transactions in this entry"
 
 normalAndAutoTransactions :: [Transaction] -> ([Transaction], [Transaction])
@@ -160,3 +155,13 @@ normalAndAutoTransactions ts =
 
 sumTransactions :: [Transaction] -> Amount
 sumTransactions ts = sum [amount t | t <- ts]
+
+
+transactionsFrom :: [Entry] -> [Transaction]
+transactionsFrom es = concat $ map transactions es
+
+accountsFrom :: [Transaction] -> [Account]
+accountsFrom ts = nub $ map account ts
+
+accountList :: Ledger -> [Account]
+accountList l = accountsFrom $ transactionsFrom $ entries l

hledger.hs

@@ -4,6 +4,7 @@
 -- John Wiegley's ledger is at http://newartisans.com/ledger.html .
 
 import System (getArgs)
+import Data.List (isPrefixOf)
 
 import Options
 import Types
@@ -12,18 +13,27 @@ import Tests
 
 main :: IO ()
 main = do
-  (opts, args) <- getArgs >>= getOptions
+  (opts, args) <- (getArgs >>= getOptions)
   test
-  if "reg" `elem` args
-    then register
---     else if "test" `elem` args 
---          then test
-         else return ()
+  if args == []
+    then register []
+    else
+      let (command, args) = (head args, tail args) in
+      if "reg" `isPrefixOf` command then register args
+      else if "bal" `isPrefixOf` command then balance args
+           else error "could not recognise your command"
 
 -- commands
 
-register :: IO ()
-register = do 
+register :: [String] -> IO ()
+register args = do 
+  p <- parseLedgerFile ledgerFilePath
+  case p of
+    Left e -> do putStr "ledger parse error at "; print e
+    Right l  -> printRegister l
+
+balance :: [String] -> IO ()
+balance args = do 
   p <- parseLedgerFile ledgerFilePath
   case p of
     Left e -> do putStr "ledger parse error at "; print e