slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Stephen Morgan 2021-09-10 10:00:44 +10:00 committed by Simon Michael
parent 3456fcb862
commit 0f205295e8
2 changed files with 15 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
hledger-lib/Hledger/Read/Common.hs
View File

@ -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 initJournal = nulljournal{ jparsedefaultyear = Just y, jincludefilestack = [f] }
let y = first3 . toGregorian $ _ioDay iopts
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,15 +334,15 @@ 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 initJournal = nulljournal
let y = first3 . toGregorian $ _ioDay iopts
initJournal = nulljournal
{ jparsedefaultyear = Just y
, jincludefilestack = [f] }
ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt
-- see notes above
case ep of
Left e -> throwError $ customErrorBundlePretty e
Right pj ->
Right pj ->
-- apply any command line account aliases. Can fail with a bad replacement pattern.
case journalApplyAliases (aliasesFromOpts iopts) pj of
Left e -> throwError e
@ -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.

12
hledger-lib/Hledger/Read/InputOptions.hs
View File

@ -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 d iopts j = do
forecastPeriod :: InputOpts -> Journal -> Maybe DateSpan
forecastPeriod iopts j = do
DateSpan requestedStart requestedEnd <- forecast_ iopts
let forecastStart = requestedStart <|> max mjournalend reportStart <|> Just d
forecastEnd = requestedEnd <|> reportEnd <|> Just (addDays 180 d)
let forecastStart = requestedStart <|> max mjournalend reportStart <|> Just (_ioDay iopts)
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