pkg!: test: Use --today in Journal parsing functions.

hledger-lib/Hledger/Read/Common.hs

@@ -259,6 +259,7 @@ rawOptsToInputOpts day rawopts =
                                , commodity_styles_  = rawOptsToCommodityStylesOpts rawopts
                                }
       ,strict_            = boolopt "strict" rawopts
+      ,_ioDay             = day
       }
 
 -- | Get the date span from --forecast's PERIODEXPR argument, if any.
@@ -316,8 +317,8 @@ journalSourcePos p p' = JournalSourcePos (sourceName p) (unPos $ sourceLine p, l
 parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts
                            -> FilePath -> Text -> ExceptT String IO Journal
 parseAndFinaliseJournal parser iopts f txt = do
-  y <- liftIO getCurrentYear
+  let y = first3 . toGregorian $ _ioDay iopts
-  let initJournal = nulljournal{ jparsedefaultyear = Just y, jincludefilestack = [f] }
+      initJournal = nulljournal{ jparsedefaultyear = Just y, jincludefilestack = [f] }
   eep <- liftIO $ runExceptT $ runParserT (evalStateT parser initJournal) f txt
   -- TODO: urgh.. clean this up somehow
   case eep of
@@ -333,8 +334,8 @@ parseAndFinaliseJournal parser iopts f txt = do
 parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts
                            -> FilePath -> Text -> ExceptT String IO Journal
 parseAndFinaliseJournal' parser iopts f txt = do
-  y <- liftIO getCurrentYear
+  let y = first3 . toGregorian $ _ioDay iopts
-  let initJournal = nulljournal
+      initJournal = nulljournal
         { jparsedefaultyear = Just y
         , jincludefilestack = [f] }
   ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt
@@ -366,10 +367,9 @@ parseAndFinaliseJournal' parser iopts f txt = do
 journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal
 journalFinalise iopts@InputOpts{auto_,balancingopts_,strict_} f txt pj = do
     t <- liftIO getPOSIXTime
-    d <- liftIO getCurrentDay
     -- Infer and apply canonical styles for each commodity (or throw an error).
     -- This affects transaction balancing/assertions/assignments, so needs to be done early.
-    liftEither $ checkAddAndBalance d <=< journalApplyCommodityStyles $
+    liftEither $ checkAddAndBalance (_ioDay iopts) <=< journalApplyCommodityStyles $
         pj{jglobalcommoditystyles=fromMaybe mempty $ commodity_styles_ balancingopts_}  -- save any global commodity styles
         & journalAddFile (f, txt)           -- save the main file's info
         & journalSetLastReadTime t          -- save the last read time
@@ -383,7 +383,7 @@ journalFinalise iopts@InputOpts{auto_,balancingopts_,strict_} f txt pj = do
           journalCheckCommoditiesDeclared j
 
         -- Add forecast transactions if enabled
-        journalAddForecast (forecastPeriod d iopts j) j
+        journalAddForecast (forecastPeriod iopts j) j
         -- Add auto postings if enabled
           & (if auto_ && not (null $ jtxnmodifiers j) then journalAddAutoPostings d balancingopts_ else pure)
         -- Balance all transactions and maybe check balance assertions.

hledger-lib/Hledger/Read/InputOptions.hs

@@ -20,7 +20,7 @@ import Data.Time (Day, addDays)
 import Hledger.Data.Types
 import Hledger.Data.Transaction (BalancingOpts(..), HasBalancingOpts(..), defbalancingopts)
 import Hledger.Data.Journal (journalEndDate)
-import Hledger.Data.Dates (nulldatespan)
+import Hledger.Data.Dates (nulldate, nulldatespan)
 import Hledger.Utils (dbg2, makeHledgerClassyLenses)
 
 data InputOpts = InputOpts {
@@ -38,6 +38,7 @@ data InputOpts = InputOpts {
     ,auto_              :: Bool                 -- ^ generate automatic postings when journal is parsed
     ,balancingopts_     :: BalancingOpts        -- ^ options for balancing transactions
     ,strict_            :: Bool                 -- ^ do extra error checking (eg, all posted accounts are declared, no prices are inferred)
+    ,_ioDay             :: Day                  -- ^ today's date, for use with forecast transactions  XXX this duplicates _rsDay, and should eventually be removed when it's not needed anymore.
  } deriving (Show)
 
 definputopts :: InputOpts
@@ -54,6 +55,7 @@ definputopts = InputOpts
     , auto_              = False
     , balancingopts_     = defbalancingopts
     , strict_            = False
+    , _ioDay             = nulldate
     }
 
 -- | Get the Maybe the DateSpan to generate forecast options from.
@@ -67,11 +69,11 @@ definputopts = InputOpts
 -- - the end date supplied to the `--forecast` argument, if present
 -- - otherwise the report end date if specified with -e/-p/date:
 -- - otherwise 180 days (6 months) from today.
-forecastPeriod :: Day -> InputOpts -> Journal -> Maybe DateSpan
+forecastPeriod :: InputOpts -> Journal -> Maybe DateSpan
-forecastPeriod d iopts j = do
+forecastPeriod iopts j = do
     DateSpan requestedStart requestedEnd <- forecast_ iopts
-    let forecastStart = requestedStart <|> max mjournalend reportStart <|> Just d
+    let forecastStart = requestedStart <|> max mjournalend reportStart <|> Just (_ioDay iopts)
-        forecastEnd   = requestedEnd <|> reportEnd <|> Just (addDays 180 d)
+        forecastEnd   = requestedEnd <|> reportEnd <|> Just (addDays 180 $ _ioDay iopts)
         mjournalend   = dbg2 "journalEndDate" $ journalEndDate False j  -- ignore secondary dates
         DateSpan reportStart reportEnd = reportspan_ iopts
     return . dbg2 "forecastspan" $ DateSpan forecastStart forecastEnd