support all five date comparisons in --display
This commit is contained in:
		
							parent
							
								
									33b2deba75
								
							
						
					
					
						commit
						dfe59676fb
					
				| @ -541,13 +541,24 @@ smartparsedate s = parsedate $ printf "%04s/%02s/%02s" y m d | ||||
| 
 | ||||
| type TransactionMatcher = Transaction -> Bool | ||||
| 
 | ||||
| -- | Parse a --display expression of the form "d>[DATE]" | ||||
| -- | Parse a --display expression which is a simple date predicate, | ||||
| -- like "d>[DATE]" or "d<=[DATE]". | ||||
| datedisplayexpr :: Parser TransactionMatcher | ||||
| datedisplayexpr = do | ||||
|   char 'd' | ||||
|   char '>' | ||||
|   op <- compareop | ||||
|   char '[' | ||||
|   (y,m,d) <- smartdate | ||||
|   char ']' | ||||
|   let edate = parsedate $ printf "%04s/%02s/%02s" y m d | ||||
|   return $ \(Transaction{date=tdate}) -> tdate > edate | ||||
|   let matcher = \(Transaction{date=tdate}) ->  | ||||
|                   case op of | ||||
|                     "<"  -> tdate <  edate | ||||
|                     "<=" -> tdate <= edate | ||||
|                     "="  -> tdate == edate | ||||
|                     "==" -> tdate == edate -- just in case | ||||
|                     ">=" -> tdate >= edate | ||||
|                     ">"  -> tdate >  edate | ||||
|   return matcher               | ||||
| 
 | ||||
| compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"] | ||||
|  | ||||
| @ -37,7 +37,8 @@ options = [ | ||||
|  Option ['C'] ["cleared"]      (NoArg  Cleared)       "report only on cleared entries", | ||||
|  Option ['B'] ["cost","basis"] (NoArg  CostBasis)     "report cost basis of commodities", | ||||
|  Option []    ["depth"]        (ReqArg Depth "N")     "balance report: maximum account depth to show", | ||||
|  Option ['d'] ["display"]      (ReqArg Display "EXPR") "display only transactions matching EXPR\n(where EXPR is 'd>[Y/M/D]')", | ||||
|  Option ['d'] ["display"]      (ReqArg Display "EXPR") ("display only transactions matching simple EXPR\n" ++ | ||||
|                                                         "(where EXPR is 'dOP[Y/M/D]', OP is <, <=, =, >=, >)"), | ||||
|  Option ['E'] ["empty"]        (NoArg  Empty)         "balance report: show accounts with zero balance", | ||||
|  Option ['R'] ["real"]         (NoArg  Real)          "report only on real (non-virtual) transactions", | ||||
|  Option ['n'] ["collapse"]     (NoArg  Collapse)      "balance report: no grand total", | ||||
|  | ||||
							
								
								
									
										20
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										20
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -318,13 +318,21 @@ registercommand_tests = TestList [ | ||||
|   , | ||||
|   "register report with display expression" ~: | ||||
|   do  | ||||
|     l <- ledgerfromfile [] "sample.ledger" | ||||
|     assertequal ( | ||||
|      "2008/01/01 pay off              liabilities:debts                $1           $1\n" ++ | ||||
|      "                                assets:checking                 $-1            0\n" ++ | ||||
|      "") | ||||
|      $ showRegisterReport [Display "d>[2007/12]"] [] l | ||||
|     "d<[2008/6/2]"  `displayexprgivestxns` ["2008/01/01","2008/06/01"] | ||||
|     "d<=[2008/6/2]" `displayexprgivestxns` ["2008/01/01","2008/06/01","2008/06/02"] | ||||
|     "d=[2008/6/2]"  `displayexprgivestxns` ["2008/06/02"] | ||||
|     "d>=[2008/6/2]" `displayexprgivestxns` ["2008/06/02","2008/06/03","2008/12/31"] | ||||
|     "d>[2008/6/2]"  `displayexprgivestxns` ["2008/06/03","2008/12/31"] | ||||
|   ] | ||||
|   where | ||||
|     expr `displayexprgivestxns` dates =  | ||||
|         assertequal dates (datesfromregister r) | ||||
|         where | ||||
|           r = showRegisterReport [Display expr] [] l | ||||
|           l = ledgerfromstring [] sample_ledger_str | ||||
|            | ||||
| datesfromregister = filter (not . null) .  map (strip . take 10) . lines | ||||
| 
 | ||||
|    | ||||
| ------------------------------------------------------------------------------ | ||||
| -- test data | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user