combine command-line flags like --depth properly with non-flag query patterns
This commit is contained in:
		
							parent
							
								
									5e944374de
								
							
						
					
					
						commit
						d4a897306c
					
				| @ -293,16 +293,20 @@ same (a:as) = all (a==) as | ||||
| -- | Remove query terms (or whole sub-expressions) not matching the given | ||||
| -- predicate from this query.  XXX Semantics not yet clear. | ||||
| filterQuery :: (Query -> Bool) -> Query -> Query | ||||
| filterQuery p (And qs) = And $ filter p qs | ||||
| filterQuery p (Or qs) = Or $ filter p qs | ||||
| -- filterQuery p (Not q) = Not $ filterQuery p q | ||||
| filterQuery p q = if p q then q else Any | ||||
| filterQuery p = simplifyQuery . filterQuery' p | ||||
| 
 | ||||
| filterQuery' :: (Query -> Bool) -> Query -> Query | ||||
| filterQuery' p (And qs) = And $ map (filterQuery p) qs | ||||
| filterQuery' p (Or qs) = Or $ map (filterQuery p) qs | ||||
| -- filterQuery' p (Not q) = Not $ filterQuery p q | ||||
| filterQuery' p q = if p q then q else Any | ||||
| 
 | ||||
| tests_filterQuery = [ | ||||
|  "filterQuery" ~: do | ||||
|   let (q,p) `gives` r = assertEqual "" r (filterQuery p q) | ||||
|   (Any, queryIsDepth) `gives` Any | ||||
|   (Depth 1, queryIsDepth) `gives` Depth 1 | ||||
|   (And [And [Status True,Depth 1]], not . queryIsDepth) `gives` Status True | ||||
|   -- (And [Date nulldatespan, Not (Or [Any, Depth 1])], queryIsDepth) `gives` And [Not (Or [Depth 1])] | ||||
|  ] | ||||
| 
 | ||||
|  | ||||
| @ -252,7 +252,8 @@ type PostingsReportItem = (Maybe (Day, String) -- transaction date and descripti | ||||
| -- | Select postings from the journal and add running balance and other | ||||
| -- information to make a postings report. Used by eg hledger's register command. | ||||
| postingsReport :: ReportOpts -> Query -> Journal -> PostingsReport | ||||
| postingsReport opts q j = (totallabel, postingsReportItems ps nullposting depth startbal (+)) | ||||
| postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $ | ||||
|                           (totallabel, postingsReportItems ps nullposting depth startbal (+)) | ||||
|     where | ||||
|       ps | interval == NoInterval = displayableps | ||||
|          | otherwise              = summarisePostingsByInterval interval depth empty reportspan displayableps | ||||
| @ -285,14 +286,17 @@ postingsReport opts q j = (totallabel, postingsReportItems ps nullposting depth | ||||
| 
 | ||||
| tests_postingsReport = [ | ||||
|   "postingsReport" ~: do | ||||
| 
 | ||||
|    -- with the query specified explicitly | ||||
|    let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) `is` n | ||||
|    (Any, nulljournal) `gives` 0 | ||||
|    (Any, samplejournal) `gives` 11 | ||||
|    -- register --depth just clips account names | ||||
|    (Depth 2, samplejournal) `gives` 11 | ||||
|    -- (Depth 2, samplejournal) `gives` 6 | ||||
|    -- (Depth 1, samplejournal) `gives` 4 | ||||
|    (And [Depth 1, Status True, Acct "expenses"], samplejournal) `gives` 2 | ||||
|    (And [And [Depth 1, Status True], Acct "expenses"], samplejournal) `gives` 2 | ||||
| 
 | ||||
|    -- with query and/or command-line options | ||||
|    assertEqual "" 11 (length $ snd $ postingsReport defreportopts Any samplejournal) | ||||
|    assertEqual ""  9 (length $ snd $ postingsReport defreportopts{monthly_=True} Any samplejournal) | ||||
|    assertEqual "" 19 (length $ snd $ postingsReport defreportopts{monthly_=True} (Empty True) samplejournal) | ||||
|  | ||||
| @ -1,15 +1,14 @@ | ||||
| # this matches the second-level account but displays only the first-level name | ||||
| # 1. register --depth N matches postings as usual but clips account names to N | ||||
| bin/hledger -f - register aa --depth 1 | ||||
| <<< | ||||
| 2010/1/1 x | ||||
|   a:aa:aaa      1 | ||||
|   b | ||||
| 
 | ||||
| >>> | ||||
| 2010/01/01 x                    a                                 1            1 | ||||
| >>>=0 | ||||
| 
 | ||||
| # this matches the second-level account, displays the second-level name, does not aggregate transactions | ||||
| # 2. similar to above, postings with same clipped account name are not aggregated | ||||
| bin/hledger -f - register aa --depth 2 | ||||
| <<< | ||||
| 2010/1/1 x | ||||
| @ -23,14 +22,13 @@ bin/hledger -f - register aa --depth 2 | ||||
| 2010/1/2 z | ||||
|   a:aa      1 | ||||
|   b:bb:bbb | ||||
| 
 | ||||
| >>> | ||||
| 2010/01/01 x                    a:aa                              1            1 | ||||
| 2010/01/01 y                    a:aa                              1            2 | ||||
| 2010/01/02 z                    a:aa                              1            3 | ||||
| >>>=0 | ||||
| 
 | ||||
| # this matches the second-level account, displays the first-level name, aggregates by reporting interval | ||||
| # 3. as above, but with a reporting interval causing postings to be aggregated | ||||
| bin/hledger -f - register aa --depth 1 --daily | ||||
| <<< | ||||
| 2010/1/1 x | ||||
| @ -44,8 +42,17 @@ bin/hledger -f - register aa --depth 1 --daily | ||||
| 2010/1/2 z | ||||
|   a:aa      1 | ||||
|   b:bb:bbb | ||||
| 
 | ||||
| >>> | ||||
| 2010/01/01 - 2010/01/01         a                                 2            2 | ||||
| 2010/01/02 - 2010/01/02         a                                 1            3 | ||||
| >>>=0 | ||||
| 
 | ||||
| # 4. with --cleared | ||||
| bin/hledger -f - register a --depth 1 --cleared | ||||
| <<< | ||||
| 2012/1/1 * | ||||
|   (a:aa)      1 | ||||
| >>> | ||||
| 2012/01/01                      (a)                               1            1 | ||||
| >>>2 | ||||
| >>>=0 | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user