From 05820466480d888b980c350708d27ffa8734ed10 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Mon, 24 Nov 2008 21:51:31 +0000
Subject: [PATCH] preliminary --display/-d support (-d "d>DATE", sufficient for
 reconciling)

---
 Ledger/Parse.hs    | 13 +++++++++++++
 Options.hs         | 15 +++++++++++++++
 RegisterCommand.hs | 12 ++++++++----
 Tests.hs           |  9 +++++++++
 4 files changed, 45 insertions(+), 4 deletions(-)

diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs
index 4fdac17e3..4d96f7a77 100644
--- a/Ledger/Parse.hs
+++ b/Ledger/Parse.hs
@@ -538,3 +538,16 @@ y = do
 smartparsedate :: String -> Date
 smartparsedate s = parsedate $ printf "%04s/%02s/%02s" y m d
     where (y,m,d) = fromparse $ parsewith smartdate s
+
+-- | Parse a --display expression of the form "d>DATE"
+
+type TransactionMatcher = Transaction -> Bool
+
+datedisplayexpr :: Parser TransactionMatcher
+datedisplayexpr = do
+  char 'd'
+  char '>'
+  (y,m,d) <- smartdate
+  let edate = parsedate $ printf "%04s/%02s/%02s" y m d
+  return $ \(Transaction{date=tdate}) -> tdate > edate
+
diff --git a/Options.hs b/Options.hs
index 87ed0e3e1..687140fff 100644
--- a/Options.hs
+++ b/Options.hs
@@ -7,6 +7,8 @@ import Text.Printf
 import Ledger.AccountName (negativepatternchar)
 import Ledger.Parse (smartparsedate)
 import Ledger.Dates
+import Ledger.Utils
+
 
 usagehdr    = "Usage: hledger [OPTS] COMMAND [ACCTPATTERNS] [-- DESCPATTERNS]\n\nOptions"++warning++":"
 warning     = if negativepatternchar=='-' then " (must appear before command)" else " (can appear anywhere)"
@@ -35,6 +37,7 @@ 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 ['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",
@@ -55,6 +58,7 @@ data Opt =
     Cleared | 
     CostBasis | 
     Depth String | 
+    Display String | 
     Empty | 
     Real | 
     Collapse |
@@ -135,6 +139,17 @@ depthFromOpts opts =
       getdepth (Depth s) = [s]
       getdepth _ = []
 
+-- | Get the value of the display option, if any.
+displayFromOpts :: [Opt] -> Maybe String
+displayFromOpts opts =
+    case displayopts of
+      (s:_) -> Just s
+      _     -> Nothing
+    where
+      displayopts = concatMap getdisplay opts
+      getdisplay (Display s) = [s]
+      getdisplay _ = []
+
 -- | Gather any ledger-style account/description pattern arguments into
 -- two lists.  These are 0 or more account patterns optionally followed by
 -- -- and 0 or more description patterns.
diff --git a/RegisterCommand.hs b/RegisterCommand.hs
index 4acb6f549..4497f9994 100644
--- a/RegisterCommand.hs
+++ b/RegisterCommand.hs
@@ -28,14 +28,17 @@ DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
 showRegisterReport :: [Opt] -> [String] -> Ledger -> String
 showRegisterReport opts args l = showtxns ts nulltxn nullmixedamt
     where
-      ts = filter matchtxn $ ledgerTransactions l
-      matchtxn Transaction{account=a} = matchpats apats a
+      ts = filter matchapats $ ledgerTransactions l
+      matchapats t = matchpats apats $ account t
       apats = fst $ parseAccountDescriptionArgs args
+      matchdisplayopt Nothing t = True
+      matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t
+      dopt = displayFromOpts opts
 
-      -- show transactions, one per line, with a running balance
+      -- show display-filtered transactions, one per line, with a running balance
       showtxns [] _ _ = ""
       showtxns (t@Transaction{amount=a}:ts) tprev bal =
-          (if isZeroMixedAmount a then "" else this) ++ showtxns ts t bal'
+          (if (isZeroMixedAmount a || (not $ matchdisplayopt dopt t)) then "" else this) ++ showtxns ts t bal'
           where
             this = showtxn (t `issame` tprev) t bal'
             issame t1 t2 = entryno t1 == entryno t2
@@ -51,3 +54,4 @@ showRegisterReport opts args l = showtxns ts nulltxn nullmixedamt
             txn = showRawTransaction $ RawTransaction a amt "" tt
             bal = padleft 12 (showMixedAmountOrZero b)
             Transaction{date=da,description=de,account=a,amount=amt,ttype=tt} = t
+
diff --git a/Tests.hs b/Tests.hs
index 925a3959e..ca96c099b 100644
--- a/Tests.hs
+++ b/Tests.hs
@@ -315,6 +315,15 @@ registercommand_tests = TestList [
      "2007/01/01 eat & shop           assets:cash                     $-2          $-2\n" ++
      "")
      $ showRegisterReport [] ["cash"] l
+  ,
+  "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
   ]
   
 ------------------------------------------------------------------------------