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 "" | ||||
|     else printf "--------------------\n%20s\n" $ showAmountRounded total | ||||
|     where  | ||||
|       acctbranches = branches $ ledgerAccountTree maxdepth l | ||||
|       acctbranches = branches $ pruneBoringBranches $ ledgerAccountTree maxdepth l | ||||
|       filteredacctbranches = branches $ ledgerFilteredAccountTree maxdepth (acctpat l) l | ||||
|       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. | ||||
| -- The ledger from which the accounts come is required so that | ||||
| -- we can check for boring accounts. | ||||
|  | ||||
							
								
								
									
										7
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										7
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -15,7 +15,7 @@ import RegisterCommand | ||||
| -- quickcheck = mapM quickCheck ([ | ||||
| --         ] :: [Bool]) | ||||
| 
 | ||||
| runhunit = runTestTT alltests | ||||
| runtests = runTestTT alltests | ||||
| 
 | ||||
| alltests = concattests [ | ||||
|             tests | ||||
| @ -93,6 +93,10 @@ tests = | ||||
|         assertparseequal (Amount (getcurrency "$") 47.18 2) (parsewith ledgeramount " $47.18") | ||||
|         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 =  | ||||
| @ -156,6 +160,7 @@ balancecommandtests = | ||||
| assertparseequal :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion | ||||
| assertparseequal expected parsed = either printParseError (assertequal expected) parsed | ||||
| 
 | ||||
| 
 | ||||
| -- test data | ||||
| 
 | ||||
| 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 | ||||
| <http://newartisans.com/software/ledger.html>.  hledger generates | ||||
| simple ledger-compatible register & balance reports from a plain text | ||||
| ledger file, and demonstrates a (naive) purely functional | ||||
| implementation of ledger. | ||||
| ledger file, and demonstrates a functional implementation of ledger. | ||||
| 
 | ||||
| -} | ||||
| 
 | ||||
| @ -33,10 +32,10 @@ main = do | ||||
|       run cmd opts args | ||||
|        | Help `elem` opts            = putStr usage | ||||
|        | 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` "register" = parseLedgerAndDo opts args printregister | ||||
|        | cmd `isPrefixOf` "balance"  = parseLedgerAndDo opts args printbalance | ||||
|        | cmd `isPrefixOf` "test"     = runtests >> return () | ||||
|        | otherwise                   = putStr usage | ||||
| 
 | ||||
| -- | parse the user's specified ledger file and do some action with it | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user