From dd9341878447fedfd16a0c2b191a6ef8d985f872 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Thu, 27 Nov 2008 19:42:03 +0000
Subject: [PATCH] handle "from ... to ..." period expressions

---
 Ledger/Dates.hs | 28 +++++++++++++++++++++++++---
 Ledger/Entry.hs |  2 +-
 Ledger/Types.hs |  2 +-
 3 files changed, 27 insertions(+), 5 deletions(-)

diff --git a/Ledger/Dates.hs b/Ledger/Dates.hs
index b9943ca47..07cfc08ee 100644
--- a/Ledger/Dates.hs
+++ b/Ledger/Dates.hs
@@ -54,13 +54,17 @@ dayToUTC :: Day -> UTCTime
 dayToUTC d = localTimeToUTC utc (LocalTime d midnight)
 
 -- | Convert a period expression to a date span using the provided reference date.
-spanFromPeriodExpr refdate = spanFromSmartDateString refdate
-
+spanFromPeriodExpr refdate = fromparse . parsewith (periodexpr refdate) 
+    
 -- | Convert a smart date string to a date span using the provided reference date.
 spanFromSmartDateString :: Day -> String -> DateSpan
-spanFromSmartDateString refdate s = DateSpan (Just b) (Just e)
+spanFromSmartDateString refdate s = spanFromSmartDate refdate sdate
     where
       sdate = fromparse $ parsewith smartdate s
+
+spanFromSmartDate :: Day -> SmartDate -> DateSpan
+spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
+    where
       (ry,rm,rd) = toGregorian refdate
       (b,e) = span sdate
       span :: SmartDate -> (Day,Day)
@@ -288,3 +292,21 @@ lastthisnextthing = do
       ]
   return ("",r,p)
 
+periodexpr :: Day -> Parser DateSpan
+periodexpr rdate = try (doubledateperiod rdate) <|> (singledateperiod rdate)
+
+doubledateperiod :: Day -> Parser DateSpan
+doubledateperiod rdate = do
+  string "from"
+  many spacenonewline
+  b <- smartdate
+  many spacenonewline
+  string "to"
+  many spacenonewline
+  e <- smartdate
+  let span = DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e)
+  return span
+
+singledateperiod :: Day -> Parser DateSpan
+singledateperiod rdate = smartdate >>= return . spanFromSmartDate rdate
+
diff --git a/Ledger/Entry.hs b/Ledger/Entry.hs
index 149082950..87397d741 100644
--- a/Ledger/Entry.hs
+++ b/Ledger/Entry.hs
@@ -20,7 +20,7 @@ instance Show ModifierEntry where
     show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e))
 
 instance Show PeriodicEntry where 
-    show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e))
+    show e = "~ " ++ (periodicexpr e) ++ "\n" ++ unlines (map show (p_transactions e))
 
 nullentry = Entry {
               edate=parsedate "1900/1/1", 
diff --git a/Ledger/Types.hs b/Ledger/Types.hs
index f6d9ac040..7bad37bdc 100644
--- a/Ledger/Types.hs
+++ b/Ledger/Types.hs
@@ -56,7 +56,7 @@ data ModifierEntry = ModifierEntry {
 
 -- | a ledger "periodic" entry. Currently ignored.
 data PeriodicEntry = PeriodicEntry {
-      periodexpr :: String,
+      periodicexpr :: String,
       p_transactions :: [RawTransaction]
     } deriving (Eq)