pruneBoringBranches again, a test, and fix hiding of zero-balance leaf accounts
This commit is contained in:
parent
3458d1f379
commit
a30154b401
@ -131,10 +131,20 @@ showLedgerAccountBalances l maxdepth =
|
|||||||
then ""
|
then ""
|
||||||
else printf "--------------------\n%20s\n" $ showAmountRounded total
|
else printf "--------------------\n%20s\n" $ showAmountRounded total
|
||||||
where
|
where
|
||||||
acctbranches = branches $ ledgerAccountTree maxdepth l
|
acctbranches = branches $ pruneBoringBranches $ ledgerAccountTree maxdepth l
|
||||||
filteredacctbranches = branches $ ledgerFilteredAccountTree maxdepth (acctpat l) l
|
filteredacctbranches = branches $ ledgerFilteredAccountTree maxdepth (acctpat l) l
|
||||||
total = sum $ map (abalance . root) filteredacctbranches
|
total = sum $ map (abalance . root) filteredacctbranches
|
||||||
|
|
||||||
|
-- | Remove boring branches and leaves from a tree of accounts.
|
||||||
|
-- A boring branch contains only accounts which have a 0 balance.
|
||||||
|
pruneBoringBranches :: Tree Account -> Tree Account
|
||||||
|
pruneBoringBranches =
|
||||||
|
-- treefilter hastxns .
|
||||||
|
treefilter hasbalance
|
||||||
|
where
|
||||||
|
hasbalance = not . isZeroAmount . abalance
|
||||||
|
hastxns = (> 0) . length . atransactions
|
||||||
|
|
||||||
-- | Get the string representation of a tree of accounts.
|
-- | Get the string representation of a tree of accounts.
|
||||||
-- The ledger from which the accounts come is required so that
|
-- The ledger from which the accounts come is required so that
|
||||||
-- we can check for boring accounts.
|
-- we can check for boring accounts.
|
||||||
|
|||||||
7
Tests.hs
7
Tests.hs
@ -15,7 +15,7 @@ import RegisterCommand
|
|||||||
-- quickcheck = mapM quickCheck ([
|
-- quickcheck = mapM quickCheck ([
|
||||||
-- ] :: [Bool])
|
-- ] :: [Bool])
|
||||||
|
|
||||||
runhunit = runTestTT alltests
|
runtests = runTestTT alltests
|
||||||
|
|
||||||
alltests = concattests [
|
alltests = concattests [
|
||||||
tests
|
tests
|
||||||
@ -93,6 +93,10 @@ tests =
|
|||||||
assertparseequal (Amount (getcurrency "$") 47.18 2) (parsewith ledgeramount " $47.18")
|
assertparseequal (Amount (getcurrency "$") 47.18 2) (parsewith ledgeramount " $47.18")
|
||||||
assertparseequal (Amount (getcurrency "$") 1 0) (parsewith ledgeramount " $1.")
|
assertparseequal (Amount (getcurrency "$") 1 0) (parsewith ledgeramount " $1.")
|
||||||
|
|
||||||
|
,"pruneBoringBranches" ~: do
|
||||||
|
atree <- liftM (ledgerAccountTree 99) $ ledgerfromfile "sample.ledger"
|
||||||
|
assertequal 13 (length $ flatten $ atree)
|
||||||
|
assertequal 12 (length $ flatten $ pruneBoringBranches $ atree)
|
||||||
]
|
]
|
||||||
|
|
||||||
balancecommandtests =
|
balancecommandtests =
|
||||||
@ -156,6 +160,7 @@ balancecommandtests =
|
|||||||
assertparseequal :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion
|
assertparseequal :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion
|
||||||
assertparseequal expected parsed = either printParseError (assertequal expected) parsed
|
assertparseequal expected parsed = either printParseError (assertequal expected) parsed
|
||||||
|
|
||||||
|
|
||||||
-- test data
|
-- test data
|
||||||
|
|
||||||
rawtransaction1_str = " expenses:food:dining $10.00\n"
|
rawtransaction1_str = " expenses:food:dining $10.00\n"
|
||||||
|
|||||||
@ -8,8 +8,7 @@ Released under GPL version 3 or later.
|
|||||||
This is a minimal haskell clone of John Wiegley's ledger
|
This is a minimal haskell clone of John Wiegley's ledger
|
||||||
<http://newartisans.com/software/ledger.html>. hledger generates
|
<http://newartisans.com/software/ledger.html>. hledger generates
|
||||||
simple ledger-compatible register & balance reports from a plain text
|
simple ledger-compatible register & balance reports from a plain text
|
||||||
ledger file, and demonstrates a (naive) purely functional
|
ledger file, and demonstrates a functional implementation of ledger.
|
||||||
implementation of ledger.
|
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
@ -33,10 +32,10 @@ main = do
|
|||||||
run cmd opts args
|
run cmd opts args
|
||||||
| Help `elem` opts = putStr usage
|
| Help `elem` opts = putStr usage
|
||||||
| Version `elem` opts = putStr version
|
| Version `elem` opts = putStr version
|
||||||
| cmd `isPrefixOf` "selftest" = runhunit >> return ()
|
| cmd `isPrefixOf` "balance" = parseLedgerAndDo opts args printbalance
|
||||||
| cmd `isPrefixOf` "print" = parseLedgerAndDo opts args printentries
|
| cmd `isPrefixOf` "print" = parseLedgerAndDo opts args printentries
|
||||||
| cmd `isPrefixOf` "register" = parseLedgerAndDo opts args printregister
|
| cmd `isPrefixOf` "register" = parseLedgerAndDo opts args printregister
|
||||||
| cmd `isPrefixOf` "balance" = parseLedgerAndDo opts args printbalance
|
| cmd `isPrefixOf` "test" = runtests >> return ()
|
||||||
| otherwise = putStr usage
|
| otherwise = putStr usage
|
||||||
|
|
||||||
-- | parse the user's specified ledger file and do some action with it
|
-- | parse the user's specified ledger file and do some action with it
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user