apply --depth to print command
This commit is contained in:
		
							parent
							
								
									80a0653b3e
								
							
						
					
					
						commit
						bd8dcefd9d
					
				| @ -106,6 +106,14 @@ filterRawLedgerTransactionsByRealness True (RawLedger ms ps es tls hs f) = | |||||||
|     RawLedger ms ps (map filtertxns es) tls hs f |     RawLedger ms ps (map filtertxns es) tls hs f | ||||||
|     where filtertxns e@Entry{etransactions=ts} = e{etransactions=filter isReal ts} |     where filtertxns e@Entry{etransactions=ts} = e{etransactions=filter isReal ts} | ||||||
| 
 | 
 | ||||||
|  | -- | Strip out any transactions to accounts deeper than the specified depth | ||||||
|  | -- (and any entries which have no transactions as a result). | ||||||
|  | filterRawLedgerTransactionsByDepth :: Int -> RawLedger -> RawLedger | ||||||
|  | filterRawLedgerTransactionsByDepth depth (RawLedger ms ps es tls hs f) = | ||||||
|  |     RawLedger ms ps (filter (not . null . etransactions) $ map filtertxns es) tls hs f | ||||||
|  |     where filtertxns e@Entry{etransactions=ts} =  | ||||||
|  |               e{etransactions=filter ((<= depth) . accountNameLevel . taccount) ts} | ||||||
|  | 
 | ||||||
| -- | Keep only entries which affect accounts matched by the account patterns. | -- | Keep only entries which affect accounts matched by the account patterns. | ||||||
| filterRawLedgerEntriesByAccount :: [String] -> RawLedger -> RawLedger | filterRawLedgerEntriesByAccount :: [String] -> RawLedger -> RawLedger | ||||||
| filterRawLedgerEntriesByAccount apats (RawLedger ms ps es tls hs f) = | filterRawLedgerEntriesByAccount apats (RawLedger ms ps es tls hs f) = | ||||||
|  | |||||||
| @ -17,5 +17,9 @@ print' opts args l = putStr $ showEntries opts args l | |||||||
| showEntries :: [Opt] -> [String] -> Ledger -> String | showEntries :: [Opt] -> [String] -> Ledger -> String | ||||||
| showEntries opts args l = concatMap showEntry $ filteredentries | showEntries opts args l = concatMap showEntry $ filteredentries | ||||||
|     where  |     where  | ||||||
|       filteredentries = entries $ filterRawLedgerEntriesByAccount apats $ rawledger l |       filteredentries = entries $  | ||||||
|  |                         filterRawLedgerTransactionsByDepth depth $  | ||||||
|  |                         filterRawLedgerEntriesByAccount apats $  | ||||||
|  |                         rawledger l | ||||||
|  |       depth = depthFromOpts opts | ||||||
|       (apats,_) = parseAccountDescriptionArgs opts args |       (apats,_) = parseAccountDescriptionArgs opts args | ||||||
|  | |||||||
							
								
								
									
										30
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										30
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -196,7 +196,7 @@ tests = [ | |||||||
|     ] |     ] | ||||||
| 
 | 
 | ||||||
|    ,"balance report with negative account pattern" ~: |    ,"balance report with negative account pattern" ~: | ||||||
|     ([], ["^assets"]) `gives` |     ([], ["not:assets"]) `gives` | ||||||
|     ["                  $2  expenses" |     ["                  $2  expenses" | ||||||
|     ,"                 $-2  income" |     ,"                 $-2  income" | ||||||
|     ,"                  $1  liabilities" |     ,"                  $1  liabilities" | ||||||
| @ -205,10 +205,10 @@ tests = [ | |||||||
|     ] |     ] | ||||||
| 
 | 
 | ||||||
|    ,"balance report negative account pattern always matches full name" ~:  |    ,"balance report negative account pattern always matches full name" ~:  | ||||||
|     ([], ["^e"]) `gives` [] |     ([], ["not:e"]) `gives` [] | ||||||
| 
 | 
 | ||||||
|    ,"balance report negative patterns affect totals" ~:  |    ,"balance report negative patterns affect totals" ~:  | ||||||
|     ([], ["expenses","^food"]) `gives` |     ([], ["expenses","not:food"]) `gives` | ||||||
|     ["                  $1  expenses" |     ["                  $1  expenses" | ||||||
|     ,"--------------------" |     ,"--------------------" | ||||||
|     ,"                  $1" |     ,"                  $1" | ||||||
| @ -381,7 +381,7 @@ tests = [ | |||||||
|     "daily from aug"            `gives` "(Daily,DateSpan (Just 2008-08-01) Nothing)" |     "daily from aug"            `gives` "(Daily,DateSpan (Just 2008-08-01) Nothing)" | ||||||
|     "every week to 2009"        `gives` "(Weekly,DateSpan Nothing (Just 2009-01-01))" |     "every week to 2009"        `gives` "(Weekly,DateSpan Nothing (Just 2009-01-01))" | ||||||
| 
 | 
 | ||||||
|   ,"print command tests" ~: TestList |   ,"print report tests" ~: TestList | ||||||
|   [ |   [ | ||||||
| 
 | 
 | ||||||
|    "print expenses" ~: |    "print expenses" ~: | ||||||
| @ -395,6 +395,27 @@ tests = [ | |||||||
|      ,"    assets:cash                                  $-2" |      ,"    assets:cash                                  $-2" | ||||||
|      ,"" |      ,"" | ||||||
|      ] |      ] | ||||||
|  | 
 | ||||||
|  |   , "print report with depth arg" ~: | ||||||
|  |    do  | ||||||
|  |     l <- sampleledger | ||||||
|  |     showEntries [Depth "2"] [] l `is` unlines | ||||||
|  |       ["2008/01/01 income" | ||||||
|  |       ,"    income:salary                                $-1" | ||||||
|  |       ,"" | ||||||
|  |       ,"2008/06/01 gift" | ||||||
|  |       ,"    income:gifts                                 $-1" | ||||||
|  |       ,"" | ||||||
|  |       ,"2008/06/03 * eat & shop" | ||||||
|  |       ,"    expenses:food                                 $1" | ||||||
|  |       ,"    expenses:supplies                             $1" | ||||||
|  |       ,"    assets:cash                                  $-2" | ||||||
|  |       ,"" | ||||||
|  |       ,"2008/12/31 * pay off" | ||||||
|  |       ,"    liabilities:debts                             $1" | ||||||
|  |       ,"" | ||||||
|  |       ] | ||||||
|  | 
 | ||||||
|   ] |   ] | ||||||
| 
 | 
 | ||||||
|   ,"punctuatethousands 1" ~: punctuatethousands "" `is` "" |   ,"punctuatethousands 1" ~: punctuatethousands "" `is` "" | ||||||
| @ -488,7 +509,6 @@ tests = [ | |||||||
|      ,"2008/12/31 pay off              liabilities:debts                $1          $-1" |      ,"2008/12/31 pay off              liabilities:debts                $1          $-1" | ||||||
|      ] |      ] | ||||||
| 
 | 
 | ||||||
| 
 |  | ||||||
|   ,"show dollars" ~: show (dollars 1) ~?= "$1.00" |   ,"show dollars" ~: show (dollars 1) ~?= "$1.00" | ||||||
| 
 | 
 | ||||||
|   ,"show hours" ~: show (hours 1) ~?= "1.0h" |   ,"show hours" ~: show (hours 1) ~?= "1.0h" | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user