pkg!: test: Use --today in Journal parsing functions.
This commit is contained in:
		
							parent
							
								
									3456fcb862
								
							
						
					
					
						commit
						0f205295e8
					
				| @ -259,6 +259,7 @@ rawOptsToInputOpts day rawopts = | |||||||
|                                , commodity_styles_  = rawOptsToCommodityStylesOpts rawopts |                                , commodity_styles_  = rawOptsToCommodityStylesOpts rawopts | ||||||
|                                } |                                } | ||||||
|       ,strict_            = boolopt "strict" rawopts |       ,strict_            = boolopt "strict" rawopts | ||||||
|  |       ,_ioDay             = day | ||||||
|       } |       } | ||||||
| 
 | 
 | ||||||
| -- | Get the date span from --forecast's PERIODEXPR argument, if any. | -- | 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 | parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts | ||||||
|                            -> FilePath -> Text -> ExceptT String IO Journal |                            -> FilePath -> Text -> ExceptT String IO Journal | ||||||
| parseAndFinaliseJournal parser iopts f txt = do | 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 |   eep <- liftIO $ runExceptT $ runParserT (evalStateT parser initJournal) f txt | ||||||
|   -- TODO: urgh.. clean this up somehow |   -- TODO: urgh.. clean this up somehow | ||||||
|   case eep of |   case eep of | ||||||
| @ -333,15 +334,15 @@ parseAndFinaliseJournal parser iopts f txt = do | |||||||
| parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts | parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts | ||||||
|                            -> FilePath -> Text -> ExceptT String IO Journal |                            -> FilePath -> Text -> ExceptT String IO Journal | ||||||
| parseAndFinaliseJournal' parser iopts f txt = do | parseAndFinaliseJournal' parser iopts f txt = do | ||||||
|   y <- liftIO getCurrentYear |   let y = first3 . toGregorian $ _ioDay iopts | ||||||
|   let initJournal = nulljournal |       initJournal = nulljournal | ||||||
|         { jparsedefaultyear = Just y |         { jparsedefaultyear = Just y | ||||||
|         , jincludefilestack = [f] } |         , jincludefilestack = [f] } | ||||||
|   ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt |   ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt | ||||||
|   -- see notes above |   -- see notes above | ||||||
|   case ep of |   case ep of | ||||||
|     Left e   -> throwError $ customErrorBundlePretty e |     Left e   -> throwError $ customErrorBundlePretty e | ||||||
|     Right pj ->  |     Right pj -> | ||||||
|       -- apply any command line account aliases. Can fail with a bad replacement pattern. |       -- apply any command line account aliases. Can fail with a bad replacement pattern. | ||||||
|       case journalApplyAliases (aliasesFromOpts iopts) pj of |       case journalApplyAliases (aliasesFromOpts iopts) pj of | ||||||
|         Left e    -> throwError e |         Left e    -> throwError e | ||||||
| @ -366,10 +367,9 @@ parseAndFinaliseJournal' parser iopts f txt = do | |||||||
| journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal | journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal | ||||||
| journalFinalise iopts@InputOpts{auto_,balancingopts_,strict_} f txt pj = do | journalFinalise iopts@InputOpts{auto_,balancingopts_,strict_} f txt pj = do | ||||||
|     t <- liftIO getPOSIXTime |     t <- liftIO getPOSIXTime | ||||||
|     d <- liftIO getCurrentDay |  | ||||||
|     -- Infer and apply canonical styles for each commodity (or throw an error). |     -- Infer and apply canonical styles for each commodity (or throw an error). | ||||||
|     -- This affects transaction balancing/assertions/assignments, so needs to be done early. |     -- 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 |         pj{jglobalcommoditystyles=fromMaybe mempty $ commodity_styles_ balancingopts_}  -- save any global commodity styles | ||||||
|         & journalAddFile (f, txt)           -- save the main file's info |         & journalAddFile (f, txt)           -- save the main file's info | ||||||
|         & journalSetLastReadTime t          -- save the last read time |         & journalSetLastReadTime t          -- save the last read time | ||||||
| @ -383,7 +383,7 @@ journalFinalise iopts@InputOpts{auto_,balancingopts_,strict_} f txt pj = do | |||||||
|           journalCheckCommoditiesDeclared j |           journalCheckCommoditiesDeclared j | ||||||
| 
 | 
 | ||||||
|         -- Add forecast transactions if enabled |         -- Add forecast transactions if enabled | ||||||
|         journalAddForecast (forecastPeriod d iopts j) j |         journalAddForecast (forecastPeriod iopts j) j | ||||||
|         -- Add auto postings if enabled |         -- Add auto postings if enabled | ||||||
|           & (if auto_ && not (null $ jtxnmodifiers j) then journalAddAutoPostings d balancingopts_ else pure) |           & (if auto_ && not (null $ jtxnmodifiers j) then journalAddAutoPostings d balancingopts_ else pure) | ||||||
|         -- Balance all transactions and maybe check balance assertions. |         -- Balance all transactions and maybe check balance assertions. | ||||||
|  | |||||||
| @ -20,7 +20,7 @@ import Data.Time (Day, addDays) | |||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| import Hledger.Data.Transaction (BalancingOpts(..), HasBalancingOpts(..), defbalancingopts) | import Hledger.Data.Transaction (BalancingOpts(..), HasBalancingOpts(..), defbalancingopts) | ||||||
| import Hledger.Data.Journal (journalEndDate) | import Hledger.Data.Journal (journalEndDate) | ||||||
| import Hledger.Data.Dates (nulldatespan) | import Hledger.Data.Dates (nulldate, nulldatespan) | ||||||
| import Hledger.Utils (dbg2, makeHledgerClassyLenses) | import Hledger.Utils (dbg2, makeHledgerClassyLenses) | ||||||
| 
 | 
 | ||||||
| data InputOpts = InputOpts { | data InputOpts = InputOpts { | ||||||
| @ -38,6 +38,7 @@ data InputOpts = InputOpts { | |||||||
|     ,auto_              :: Bool                 -- ^ generate automatic postings when journal is parsed |     ,auto_              :: Bool                 -- ^ generate automatic postings when journal is parsed | ||||||
|     ,balancingopts_     :: BalancingOpts        -- ^ options for balancing transactions |     ,balancingopts_     :: BalancingOpts        -- ^ options for balancing transactions | ||||||
|     ,strict_            :: Bool                 -- ^ do extra error checking (eg, all posted accounts are declared, no prices are inferred) |     ,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) |  } deriving (Show) | ||||||
| 
 | 
 | ||||||
| definputopts :: InputOpts | definputopts :: InputOpts | ||||||
| @ -54,6 +55,7 @@ definputopts = InputOpts | |||||||
|     , auto_              = False |     , auto_              = False | ||||||
|     , balancingopts_     = defbalancingopts |     , balancingopts_     = defbalancingopts | ||||||
|     , strict_            = False |     , strict_            = False | ||||||
|  |     , _ioDay             = nulldate | ||||||
|     } |     } | ||||||
| 
 | 
 | ||||||
| -- | Get the Maybe the DateSpan to generate forecast options from. | -- | 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 | -- - the end date supplied to the `--forecast` argument, if present | ||||||
| -- - otherwise the report end date if specified with -e/-p/date: | -- - otherwise the report end date if specified with -e/-p/date: | ||||||
| -- - otherwise 180 days (6 months) from today. | -- - 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 |     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 |         mjournalend   = dbg2 "journalEndDate" $ journalEndDate False j  -- ignore secondary dates | ||||||
|         DateSpan reportStart reportEnd = reportspan_ iopts |         DateSpan reportStart reportEnd = reportspan_ iopts | ||||||
|     return . dbg2 "forecastspan" $ DateSpan forecastStart forecastEnd |     return . dbg2 "forecastspan" $ DateSpan forecastStart forecastEnd | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user