From dfe59676fbab8fdb18470f827d67be91325b403f Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Wed, 26 Nov 2008 21:18:24 +0000
Subject: [PATCH] support all five date comparisons in --display

---
 Ledger/Parse.hs | 17 ++++++++++++++---
 Options.hs      |  3 ++-
 Tests.hs        | 20 ++++++++++++++------
 3 files changed, 30 insertions(+), 10 deletions(-)

diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs
index a6848c1ba..def904705 100644
--- a/Ledger/Parse.hs
+++ b/Ledger/Parse.hs
@@ -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) ["<=",">=","==","<","=",">"]
diff --git a/Options.hs b/Options.hs
index 27fcaf112..37f2ecb26 100644
--- a/Options.hs
+++ b/Options.hs
@@ -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",
diff --git a/Tests.hs b/Tests.hs
index a4529c9df..4e3eac84f 100644
--- a/Tests.hs
+++ b/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