From 67c203f316c5f848b5ae83755bcfbd7c952e6987 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 10 Oct 2008 03:32:12 +0000 Subject: [PATCH] move commands to top-level modules, make Ledger pure (except for Parse) --- BalanceCommand.hs | 177 +++++++++++++++++++++++++++++++++++++++++++++ Ledger/Ledger.hs | 176 +------------------------------------------- PrintCommand.hs | 16 ++++ RegisterCommand.hs | 18 +++++ Tests.hs | 2 +- hledger.hs | 59 +++++---------- 6 files changed, 234 insertions(+), 214 deletions(-) create mode 100644 BalanceCommand.hs create mode 100644 PrintCommand.hs create mode 100644 RegisterCommand.hs diff --git a/BalanceCommand.hs b/BalanceCommand.hs new file mode 100644 index 000000000..c05ad1530 --- /dev/null +++ b/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 diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index 87987f503..9247aca7e 100644 --- a/Ledger/Ledger.hs +++ b/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 --- description patterns, or transact with an account matching the account --- patterns. -filterLedgerEntries :: String -> String -> Regex -> Regex -> RawLedger -> RawLedger -filterLedgerEntries begin end acctpat descpat = +-- Keep only those which fall between the begin and end dates, and match +-- the description patterns. +filterLedgerEntries :: String -> String -> Regex -> RawLedger -> RawLedger +filterLedgerEntries begin end 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 - diff --git a/PrintCommand.hs b/PrintCommand.hs new file mode 100644 index 000000000..6b9bccff1 --- /dev/null +++ b/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)) diff --git a/RegisterCommand.hs b/RegisterCommand.hs new file mode 100644 index 000000000..f6473efb6 --- /dev/null +++ b/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} diff --git a/Tests.hs b/Tests.hs index d9965ec21..b73023ca9 100644 --- a/Tests.hs +++ b/Tests.hs @@ -3,7 +3,7 @@ where import qualified Data.Map as Map import Text.ParserCombinators.Parsec import Ledger - +import BalanceCommand -- utils diff --git a/hledger.hs b/hledger.hs index 04c103012..68cabff22 100644 --- a/hledger.hs +++ b/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 - | Help `elem` opts = putStr usage - | Version `elem` opts = putStr version - | cmd `isPrefixOf` "selftest" = selftest opts args - | cmd `isPrefixOf` "print" = print_ opts args - | cmd `isPrefixOf` "register" = register opts args - | cmd `isPrefixOf` "balance" = balance opts args - | 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 + where + run cmd opts args + | Help `elem` opts = putStr usage + | Version `elem` opts = putStr version + | cmd `isPrefixOf` "selftest" = hunit >> quickcheck >> return () + | cmd `isPrefixOf` "print" = parseLedgerAndDo opts args printentries + | cmd `isPrefixOf` "register" = parseLedgerAndDo opts args printregister + | cmd `isPrefixOf` "balance" = parseLedgerAndDo opts args printbalance + | otherwise = putStr usage -- | 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 - dregex = regexFor descpats + acctpat = regexFor acctpats + 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