move commands to top-level modules, make Ledger pure (except for Parse)
This commit is contained in:
Simon Michael
parent
65cfcceae0
commit
67c203f316
177
BalanceCommand.hs
Normal file
177
BalanceCommand.hs
Normal file
@ -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
|
||||
176
Ledger/Ledger.hs
176
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
|
||||
|
||||
|
||||
16
PrintCommand.hs
Normal file
16
PrintCommand.hs
Normal file
@ -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))
|
||||
18
RegisterCommand.hs
Normal file
18
RegisterCommand.hs
Normal file
@ -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}
|
||||
2
Tests.hs
2
Tests.hs
@ -3,7 +3,7 @@ where
|
||||
import qualified Data.Map as Map
|
||||
import Text.ParserCombinators.Parsec
|
||||
import Ledger
|
||||
|
||||
import BalanceCommand
|
||||
|
||||
-- utils
|
||||
|
||||
|
||||
53
hledger.hs
53
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
|
||||
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
|
||||
| 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
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user