move commands to top-level modules, make Ledger pure (except for Parse)

BalanceCommand.hs

@@ -0,0 +1,177 @@
+{-| 
+
+A ledger-compatible @balance@ command. Here's how it should work:
+
+A sample account tree (as in the sample.ledger file):
+
+@
+ assets
+  cash
+  checking
+  saving
+ expenses
+  food
+  supplies
+ income
+  gifts
+  salary
+ liabilities
+  debts
+@
+
+The balance command shows top-level accounts by default:
+
+@
+ \> ledger balance
+ $-1  assets
+  $2  expenses
+ $-2  income
+  $1  liabilities
+@
+
+With -s (--showsubs), also show the subaccounts:
+
+@
+ $-1  assets
+ $-2    cash
+  $1    saving
+  $2  expenses
+  $1    food
+  $1    supplies
+ $-2  income
+ $-1    gifts
+ $-1    salary
+  $1  liabilities:debts
+@
+
+- @checking@ is not shown because it has a zero balance and no interesting
+  subaccounts.  
+
+- @liabilities@ is displayed only as a prefix because it has no transactions
+  of its own and only one subaccount.
+
+With an account pattern, show only the accounts with matching names:
+
+@
+ \> ledger balance o
+  $1  expenses:food
+ $-2  income
+--------------------
+ $-1  
+@
+
+- The o matched @food@ and @income@, so they are shown.
+
+- Parents of matched accounts are also shown for context (@expenses@).
+
+- This time the grand total is also shown, because it is not zero.
+
+Again, -s adds the subaccounts:
+
+@
+\> ledger -s balance o
+  $1  expenses:food
+ $-2  income
+ $-1    gifts
+ $-1    salary
+--------------------
+ $-1  
+@
+
+- @food@ has no subaccounts. @income@ has two, so they are shown. 
+
+- We do not add the subaccounts of parents included for context (@expenses@).
+
+Here are some rules for account balance display, as seen above:
+
+- grand total is omitted if it is 0
+
+- leaf accounts and branches with 0 balance or 0 transactions are omitted
+
+- inner accounts with 0 transactions and 1 subaccount are displayed inline
+
+- in a filtered report, matched accounts are displayed with their parents
+  inline (a consequence of the above)
+
+- in a showsubs report, all subaccounts of matched accounts are displayed
+
+-}
+
+module BalanceCommand
+where
+import Ledger.Utils
+import Ledger.Types
+import Ledger.Amount
+import Ledger.AccountName
+import Ledger.Ledger
+import Options
+
+
+-- | Print a balance report.
+printbalance :: [Opt] -> [String] -> Ledger -> IO ()
+printbalance opts args l = putStr $ showLedgerAccountBalances l depth
+    where 
+      showsubs = (ShowSubs `elem` opts)
+      pats = parseAccountDescriptionArgs args
+      -- when there is no -s or pattern args, show with depth 1
+      depth = case (pats, showsubs) of
+                (([],[]), False) -> 1
+                otherwise  -> 9999
+
+-- | Generate balance report output for a ledger, to the specified depth.
+showLedgerAccountBalances :: Ledger -> Int -> String
+showLedgerAccountBalances l maxdepth = 
+    concatMap (showAccountTree l maxdepth) acctbranches
+    ++
+    if isZeroAmount total 
+    then ""
+    else printf "--------------------\n%20s\n" $ showAmountRounded total
+    where 
+      acctbranches = branches $ ledgerAccountTree maxdepth l
+      filteredacctbranches = branches $ ledgerFilteredAccountTree maxdepth (acctpat l) l
+      total = sum $ map (abalance . root) filteredacctbranches
+
+-- | Get the string representation of a tree of accounts.
+-- The ledger from which the accounts come is required so that
+-- we can check for boring accounts.
+showAccountTree :: Ledger -> Int -> Tree Account -> String
+showAccountTree l maxdepth = showAccountTree' l maxdepth 0 ""
+
+showAccountTree' :: Ledger -> Int -> Int -> String -> Tree Account -> String
+showAccountTree' l maxdepth indentlevel prefix t
+    -- merge boring inner account names with the next line
+    | isBoringInnerAccount l maxdepth acct = subsindented 0 (fullname++":")
+    -- ditto with unmatched parent accounts when filtering by account
+    |  filtering && doesnotmatch = subsindented 0 (fullname++":")
+    -- otherwise show this account's name & balance
+    | otherwise = bal ++ "  " ++ indent ++ prefix ++ leafname ++ "\n" ++ (subsindented 1 "")
+    where
+      acct = root t
+      subs = branches t
+      subsindented i p = concatMap (showAccountTree' l maxdepth (indentlevel+i) p) subs
+      bal = printf "%20s" $ show $ abalance $ acct
+      indent = replicate (indentlevel * 2) ' '
+      fullname = aname acct
+      leafname = accountLeafName fullname
+      filtering = filteredaccountnames l /= (accountnames l)
+      doesnotmatch = not (containsRegex (acctpat l) leafname)
+
+-- | Is this account a boring inner account in this ledger ? 
+-- Boring inner accounts have no transactions, one subaccount,
+-- and depth less than the maximum display depth.
+-- Also, they are unmatched parent accounts when account matching is in effect.
+isBoringInnerAccount :: Ledger -> Int -> Account -> Bool
+isBoringInnerAccount l maxdepth a
+    | name == "top" = False
+    | depth < maxdepth && numtxns == 0 && numsubs == 1 = True
+    | otherwise = False
+    where      
+      name = aname a
+      depth = accountNameLevel name
+      numtxns = length $ atransactions a
+      -- how many (filter-matching) subaccounts has this account ?
+      numsubs = length $ subAccountNamesFrom (filteredaccountnames l) name
+
+-- | Is the named account a boring inner account in this ledger ?
+isBoringInnerAccountName :: Ledger -> Int -> AccountName -> Bool
+isBoringInnerAccountName l maxdepth = isBoringInnerAccount l maxdepth . ledgerAccount l

Ledger/Ledger.hs

@@ -15,7 +15,6 @@ import Data.Map ((!))
 import Ledger.Utils
 import Ledger.Types
 import Ledger.Amount
-import Ledger.Account
 import Ledger.AccountName
 import Ledger.Transaction
 import Ledger.RawLedger
@@ -76,11 +75,10 @@ cacheLedger acctpat l =
       Ledger l ant amap maxprecision acctpat filteredant filteredamap
 
 -- | Remove ledger entries we are not interested in.
--- Keep only those which fall between the begin and end dates, match the
+-- Keep only those which fall between the begin and end dates, and match
--- description patterns, or transact with an account matching the account
+-- the description patterns.
--- patterns.
+filterLedgerEntries :: String -> String -> Regex -> RawLedger -> RawLedger
-filterLedgerEntries :: String -> String -> Regex -> Regex -> RawLedger -> RawLedger
+filterLedgerEntries begin end descpat = 
-filterLedgerEntries begin end acctpat descpat = 
     filterLedgerEntriesByDate begin end .
     filterLedgerEntriesByDescription descpat
 
@@ -161,169 +159,3 @@ addDataToAccountNameTree = treemap . ledgerAccount
 addFilteredDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
 addFilteredDataToAccountNameTree l = treemap (ledgerFilteredAccount l)
 
--- | Print a print report.
-printentries :: Ledger -> IO ()
-printentries l = putStr $ showEntries $ setprecisions $ entries $ rawledger l
-    where setprecisions = map (entrySetPrecision (lprecision l))
-      
--- | Print a register report.
-printregister :: Ledger -> IO ()
-printregister l = putStr $ showTransactionsWithBalances 
-                  (sortBy (comparing date) $ ledgerTransactions l)
-                  nullamt{precision=lprecision l}
-
-{-| 
-This and the helper functions below generate ledger-compatible balance
-report output. Here's how it should work:
-
-A sample account tree (as in the sample.ledger file):
-
-@
- assets
-  cash
-  checking
-  saving
- expenses
-  food
-  supplies
- income
-  gifts
-  salary
- liabilities
-  debts
-@
-
-The balance command shows top-level accounts by default:
-
-@
- \> ledger balance
- $-1  assets
-  $2  expenses
- $-2  income
-  $1  liabilities
-@
-
-With -s (--showsubs), also show the subaccounts:
-
-@
- $-1  assets
- $-2    cash
-  $1    saving
-  $2  expenses
-  $1    food
-  $1    supplies
- $-2  income
- $-1    gifts
- $-1    salary
-  $1  liabilities:debts
-@
-
-- @checking@ is not shown because it has a zero balance and no interesting
-  subaccounts.  
-
-- @liabilities@ is displayed only as a prefix because it has no transactions
-  of its own and only one subaccount.
-
-With an account pattern, show only the accounts with matching names:
-
-@
- \> ledger balance o
-  $1  expenses:food
- $-2  income
---------------------
- $-1  
-@
-
-- The o matched @food@ and @income@, so they are shown.
-
-- Parents of matched accounts are also shown for context (@expenses@).
-
-- This time the grand total is also shown, because it is not zero.
-
-Again, -s adds the subaccounts:
-
-@
-\> ledger -s balance o
-  $1  expenses:food
- $-2  income
- $-1    gifts
- $-1    salary
---------------------
- $-1  
-@
-
-- @food@ has no subaccounts. @income@ has two, so they are shown. 
-
-- We do not add the subaccounts of parents included for context (@expenses@).
-
-Here are some rules for account balance display, as seen above:
-
-- grand total is omitted if it is 0
-
-- leaf accounts and branches with 0 balance or 0 transactions are omitted
-
-- inner accounts with 0 transactions and 1 subaccount are displayed inline
-
-- in a filtered report, matched accounts are displayed with their parents
-  inline (a consequence of the above)
-
-- in a showsubs report, all subaccounts of matched accounts are displayed
-
--}
-showLedgerAccountBalances :: Ledger -> Int -> String
-showLedgerAccountBalances l maxdepth = 
-    concatMap (showAccountTree l maxdepth) acctbranches
-    ++
-    if isZeroAmount total 
-    then ""
-    else printf "--------------------\n%20s\n" $ showAmountRounded total
-    where 
-      acctbranches = branches $ ledgerAccountTree maxdepth l
-      filteredacctbranches = branches $ ledgerFilteredAccountTree maxdepth (acctpat l) l
-      total = sum $ map (abalance . root) filteredacctbranches
-
--- | Get the string representation of a tree of accounts.
--- The ledger from which the accounts come is also required, so that
--- we can check for boring accounts.
-showAccountTree :: Ledger -> Int -> Tree Account -> String
-showAccountTree l maxdepth = showAccountTree' l maxdepth 0 ""
-
-showAccountTree' :: Ledger -> Int -> Int -> String -> Tree Account -> String
-showAccountTree' l maxdepth indentlevel prefix t
-    -- merge boring inner account names with the next line
-    | isBoringInnerAccount l maxdepth acct = subsindented 0 (fullname++":")
-    -- ditto with unmatched parent accounts when filtering by account
-    |  filtering && doesnotmatch = subsindented 0 (fullname++":")
-    -- otherwise show this account's name & balance
-    | otherwise = bal ++ "  " ++ indent ++ prefix ++ leafname ++ "\n" ++ (subsindented 1 "")
-    where
-      acct = root t
-      subs = branches t
-      subsindented i p = concatMap (showAccountTree' l maxdepth (indentlevel+i) p) subs
-      bal = printf "%20s" $ show $ abalance $ acct
-      indent = replicate (indentlevel * 2) ' '
-      fullname = aname acct
-      leafname = accountLeafName fullname
-      filtering = filteredaccountnames l /= (accountnames l)
-      doesnotmatch = not (containsRegex (acctpat l) leafname)
-
--- | Is this account a boring inner account in this ledger ? 
--- Boring inner accounts have no transactions, one subaccount,
--- and depth less than the maximum display depth.
--- Also, they are unmatched parent accounts when account matching is in effect.
-isBoringInnerAccount :: Ledger -> Int -> Account -> Bool
-isBoringInnerAccount l maxdepth a
-    | name == "top" = False
-    | depth < maxdepth && numtxns == 0 && numsubs == 1 = True
-    | otherwise = False
-    where      
-      name = aname a
-      depth = accountNameLevel name
-      numtxns = length $ atransactions a
-      -- how many (filter-matching) subaccounts has this account ?
-      numsubs = length $ subAccountNamesFrom (filteredaccountnames l) name
-
--- | Is the named account a boring inner account in this ledger ?
-isBoringInnerAccountName :: Ledger -> Int -> AccountName -> Bool
-isBoringInnerAccountName l maxdepth = isBoringInnerAccount l maxdepth . ledgerAccount l
-

PrintCommand.hs

@@ -0,0 +1,16 @@
+{-| 
+
+A ledger-compatible @print@ command.
+
+-}
+
+module PrintCommand
+where
+import Ledger
+import Options
+
+
+-- | Print ledger entries in standard format.
+printentries :: [Opt] -> [String] -> Ledger -> IO ()
+printentries opts args l = putStr $ showEntries $ setprecisions $ entries $ rawledger l
+    where setprecisions = map (entrySetPrecision (lprecision l))

RegisterCommand.hs

@@ -0,0 +1,18 @@
+{-| 
+
+A ledger-compatible @register@ command.
+
+-}
+
+module RegisterCommand
+where
+import Ledger
+import Options
+
+
+-- | Print a register report.
+printregister :: [Opt] -> [String] -> Ledger -> IO ()
+printregister opts args l = putStr $ showTransactionsWithBalances txns startingbalance
+    where
+      txns = sortBy (comparing date) $ ledgerTransactions l
+      startingbalance = nullamt{precision=lprecision l}

Tests.hs

@@ -3,7 +3,7 @@ where
 import qualified Data.Map as Map
 import Text.ParserCombinators.Parsec
 import Ledger
-
+import BalanceCommand
 
 -- utils
 

hledger.hs

@@ -33,8 +33,11 @@ This module includes some helpers for working with your ledger in ghci. Examples
 module Main
 where
 import qualified Data.Map as Map (lookup)
-import Ledger
 import Options
+import Ledger
+import BalanceCommand
+import PrintCommand
+import RegisterCommand
 import Tests
 
 
@@ -42,53 +45,27 @@ main :: IO ()
 main = do
   (opts, cmd, args) <- parseArguments
   run cmd opts args
-    where run cmd opts args
+    where 
-              | Help `elem` opts            = putStr usage
+      run cmd opts args
-              | Version `elem` opts         = putStr version
+       | Help `elem` opts            = putStr usage
-              | cmd `isPrefixOf` "selftest" = selftest opts args
+       | Version `elem` opts         = putStr version
-              | cmd `isPrefixOf` "print"    = print_   opts args
+       | cmd `isPrefixOf` "selftest" = hunit >> quickcheck >> return ()
-              | cmd `isPrefixOf` "register" = register opts args
+       | cmd `isPrefixOf` "print"    = parseLedgerAndDo opts args printentries
-              | cmd `isPrefixOf` "balance"  = balance  opts args
+       | cmd `isPrefixOf` "register" = parseLedgerAndDo opts args printregister
-              | otherwise                   = putStr usage
+       | cmd `isPrefixOf` "balance"  = parseLedgerAndDo opts args printbalance
-
+       | otherwise                   = putStr usage
-type Command = [Opt] -> [String] -> IO ()
-
-selftest :: Command
-selftest _ _ = do 
-  hunit
-  quickcheck
-  return ()
-
-print_ :: Command
-print_ opts args = parseLedgerAndDo opts args printentries
-
-register :: Command
-register opts args = parseLedgerAndDo opts args printregister
-
-balance :: Command
-balance opts args = parseLedgerAndDo opts args printbalance
-    where
-      printbalance :: Ledger -> IO ()
-      printbalance l = putStr $ showLedgerAccountBalances l depth
-          where 
-            showsubs = (ShowSubs `elem` opts)
-            pats@(acctpats,descpats) = parseAccountDescriptionArgs args
-            depth = case (pats, showsubs) of
-                      -- when there is no -s or pattern args, show with depth 1
-                      (([],[]), False) -> 1
-                      otherwise  -> 9999
 
 -- | parse the user's specified ledger file and do some action with it
 -- (or report a parse error). This function makes the whole thing go.
-parseLedgerAndDo :: [Opt] -> [String] -> (Ledger -> IO ()) -> IO ()
+parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ()) -> IO ()
 parseLedgerAndDo opts args cmd = 
     ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runthecommand
     where
-      runthecommand = cmd . cacheLedger aregex . filterLedgerEntries begin end aregex dregex
+      runthecommand = cmd opts args . cacheLedger acctpat . filterLedgerEntries begin end descpat
       begin = beginDateFromOpts opts
       end = endDateFromOpts opts
-      aregex = regexFor acctpats
+      acctpat = regexFor acctpats
-      dregex = regexFor descpats
+      descpat = regexFor descpats
       (acctpats,descpats) = parseAccountDescriptionArgs args
 
 -- ghci helpers
@@ -104,7 +81,7 @@ myrawledger = do
 myledger :: IO Ledger
 myledger = do
   l <- myrawledger
-  return $ cacheLedger wildcard $ filterLedgerEntries "" "" wildcard wildcard l
+  return $ cacheLedger wildcard $ filterLedgerEntries "" "" wildcard l
 
 -- | get a Ledger from the given file path
 rawledgerfromfile :: String -> IO RawLedger