From 129f6e6839db91fb17c13aa9ce0718f168b5a193 Mon Sep 17 00:00:00 2001
From: Stephen Morgan <morgan.stephen99@gmail.com>
Date: Mon, 7 May 2018 16:59:30 +1000
Subject: [PATCH] Adjust start date of DateSpan for periodic forecasting with
 Days interval.

---
 hledger-lib/Hledger/Data/AutoTransaction.hs |  9 ++++-----
 hledger-lib/Hledger/Data/Dates.hs           | 22 +++++++++++++++++++++
 2 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/hledger-lib/Hledger/Data/AutoTransaction.hs b/hledger-lib/Hledger/Data/AutoTransaction.hs
index 7547afba2..09b4c57c9 100644
--- a/hledger-lib/Hledger/Data/AutoTransaction.hs
+++ b/hledger-lib/Hledger/Data/AutoTransaction.hs
@@ -233,11 +233,9 @@ renderPostingCommentDates p = p { pcomment = comment' }
 --
 -- >>> let reportperiod="daily from 2018/01/03" in runPeriodicTransaction (PeriodicTransaction reportperiod [post "a" (usd 1)]) (DateSpan (Just $ parsedate "2018-01-01") (Just $ parsedate "2018-01-03"))
 -- []
-runPeriodicTransaction :: PeriodicTransaction -> (DateSpan -> [Transaction])
-runPeriodicTransaction pt =
-  \requestedspan ->
-    let fillspan = ptspan `spanIntersect` requestedspan
-    in  [ t{tdate=d} | (DateSpan (Just d) _) <- ptinterval `splitSpan` fillspan ]
+runPeriodicTransaction :: PeriodicTransaction -> DateSpan -> [Transaction]
+runPeriodicTransaction pt requestedspan =
+    [ t{tdate=d} | (DateSpan (Just d) _) <- ptinterval `splitSpan` fillspan ]
   where
     descr = T.pack $ "Forecast transaction (" ++ T.unpack periodexpr ++ ")"
     t = nulltransaction { tpostings = ptpostings pt, tdescription = descr }
@@ -247,6 +245,7 @@ runPeriodicTransaction pt =
         case parsePeriodExpr currentdateerr periodexpr of
             Left e  -> error' $ "Failed to parse " ++ show (T.unpack periodexpr) ++ ": " ++ showDateParseError e
             Right x -> checkPeriodTransactionStartDate periodexpr x
+    fillspan = spanIntervalIntersect ptinterval ptspan requestedspan
 
 checkPeriodTransactionStartDate :: T.Text -> (Interval, DateSpan) -> (Interval, DateSpan)
 checkPeriodTransactionStartDate periodexpr (i,s) = 
diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs
index 30f61d310..df756a575 100644
--- a/hledger-lib/Hledger/Data/Dates.hs
+++ b/hledger-lib/Hledger/Data/Dates.hs
@@ -55,6 +55,7 @@ module Hledger.Data.Dates (
   spansSpan,
   spanIntersect,
   spansIntersect,
+  spanIntervalIntersect,
   spanDefaultsFrom,
   spanUnion,
   spansUnion,
@@ -260,6 +261,27 @@ spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e
       b = latest b1 b2
       e = earliest e1 e2
 
+-- | Calculate the intersection of two DateSpans, adjusting the start date so
+-- the interval is preserved.
+--
+-- >>> let intervalIntersect = spanIntervalIntersect (Days 3)
+-- >>> mkdatespan "2018-01-01" "2018-01-03" `intervalIntersect` mkdatespan "2018-01-01" "2018-01-05"
+-- DateSpan 2018/01/01-2018/01/02
+-- >>> mkdatespan "2018-01-01" "2018-01-05" `intervalIntersect` mkdatespan "2018-01-02" "2018-01-05"
+-- DateSpan 2018/01/04
+-- >>> mkdatespan "2018-01-01" "2018-01-05" `intervalIntersect` mkdatespan "2018-01-03" "2018-01-05"
+-- DateSpan 2018/01/04
+-- >>> mkdatespan "2018-01-01" "2018-01-05" `intervalIntersect` mkdatespan "2018-01-04" "2018-01-05"
+-- DateSpan 2018/01/04
+-- >>> mkdatespan "2018-01-01" "2018-01-05" `intervalIntersect` mkdatespan "2017-12-01" "2018-01-05"
+-- DateSpan 2018/01/01-2018/01/04
+spanIntervalIntersect :: Interval -> DateSpan -> DateSpan -> DateSpan
+spanIntervalIntersect (Days n) (DateSpan (Just b1) e1) sp2@(DateSpan (Just b2) _) =
+      DateSpan (Just b) e1 `spanIntersect` sp2
+    where
+      b = if b1 < b2 then addDays (diffDays b1 b2 `mod` toInteger n) b2 else b1
+spanIntervalIntersect _ sp1 sp2 = sp1 `spanIntersect` sp2
+
 -- | Fill any unspecified dates in the first span with the dates from
 -- the second one. Sort of a one-way spanIntersect.
 spanDefaultsFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b