diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index 14840d9a6..05b23f07d 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -20,6 +20,7 @@ module Hledger.Query ( -- * parsing parseQuery, parseQueryList, + parseQueryTerm, simplifyQuery, filterQuery, -- * accessors diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 50e12e796..6b168a7e2 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -49,6 +49,8 @@ module Hledger.Read.Common ( journalCheckAccountsDeclared, journalCheckCommoditiesDeclared, journalCheckPayeesDeclared, + journalAddForecast, + journalAddAutoPostings, setYear, getYear, setDefaultCommodityAndStyle, @@ -135,7 +137,9 @@ import Data.Bifunctor (bimap, second) import Data.Char (digitToInt, isDigit, isSpace) import Data.Decimal (DecimalRaw (Decimal), Decimal) import Data.Default (Default(..)) +import Data.Either (lefts, rights) import Data.Function ((&)) +import Data.Functor ((<&>)) import Data.Functor.Identity (Identity) import "base-compat-batteries" Data.List.Compat import Data.List.NonEmpty (NonEmpty(..)) @@ -144,7 +148,7 @@ import qualified Data.Map as M import qualified Data.Semigroup as Sem import Data.Text (Text) import qualified Data.Text as T -import Data.Time.Calendar (Day, fromGregorianValid, toGregorian) +import Data.Time.Calendar (Day, addDays, fromGregorianValid, toGregorian) import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..)) import Data.Word (Word8) import System.Time (getClockTime) @@ -156,6 +160,8 @@ import Text.Megaparsec.Custom finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion) import Hledger.Data +import Hledger.Query (Query(..), filterQuery, parseQueryTerm, queryEndDate, queryIsDate, simplifyQuery) +import Hledger.Reports.ReportOptions (ReportOpts(..), queryFromFlags, rawOptsToReportOpts) import Hledger.Utils import Text.Printf (printf) @@ -228,6 +234,8 @@ definputopts = InputOpts , strict_ = False } +-- | Parse an InputOpts from a RawOpts and the current date. +-- This will fail with a usage error if the forecast period expression cannot be parsed. rawOptsToInputOpts :: RawOpts -> IO InputOpts rawOptsToInputOpts rawopts = do d <- getCurrentDay @@ -250,16 +258,25 @@ rawOptsToInputOpts rawopts = do } where noinferprice = boolopt "strict" rawopts || stringopt "args" rawopts == "balancednoautoconversion" --- | get period expression from --forecast option +-- | Get period expression from --forecast option. +-- This will fail with a usage error if the forecast period expression cannot be parsed. forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan -forecastPeriodFromRawOpts d opts = - case maybestringopt "forecast" opts - of +forecastPeriodFromRawOpts d rawopts = case maybestringopt "forecast" rawopts of Nothing -> Nothing - Just "" -> Just nulldatespan - Just str -> - either (\e -> usageError $ "could not parse forecast period : "++customErrorBundlePretty e) (Just . snd) $ - parsePeriodExpr d $ stripquotes $ T.pack str + Just "" -> Just forecastspanDefault + Just str -> either (\e -> usageError $ "could not parse forecast period : "++customErrorBundlePretty e) + (\(_,requestedspan) -> Just $ requestedspan `spanDefaultsFrom` forecastspanDefault) $ + parsePeriodExpr d $ stripquotes $ T.pack str + where + -- "They end on or before the specified report end date, or 180 days from today if unspecified." + mspecifiedend = dbg2 "specifieddates" $ queryEndDate False datequery + forecastendDefault = dbg2 "forecastendDefault" $ addDays 180 d + forecastspanDefault = DateSpan Nothing $ mspecifiedend <|> Just forecastendDefault + -- Do we really need to do all this work just to get the requested end date? This is duplicating + -- much of reportOptsToSpec. + ropts = rawOptsToReportOpts d rawopts + argsquery = lefts . rights . map (parseQueryTerm d) $ querystring_ ropts + datequery = simplifyQuery . filterQuery queryIsDate . And $ queryFromFlags ropts : argsquery --- ** parsing utilities @@ -338,6 +355,8 @@ parseAndFinaliseJournal' parser iopts f txt = do -- -- - save misc info and reverse transactions into their original parse order, -- +-- - add forecast transactions, +-- -- - evaluate balance assignments and balance each transaction, -- -- - apply transaction modifiers (auto postings) if enabled, @@ -347,41 +366,64 @@ parseAndFinaliseJournal' parser iopts f txt = do -- - infer transaction-implied market prices from transaction prices -- journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal -journalFinalise InputOpts{auto_,balancingopts_,strict_} f txt pj' = do - t <- liftIO getClockTime - d <- liftIO getCurrentDay - liftEither $ do +journalFinalise InputOpts{forecast_,auto_,balancingopts_,strict_} f txt pj = do + t <- liftIO getClockTime + 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. - pj <- journalApplyCommodityStyles $ - pj'{jglobalcommoditystyles=fromMaybe M.empty $ commodity_styles_ balancingopts_} -- save any global commodity styles - & journalAddFile (f, txt) -- save the main file's info - & journalSetLastReadTime t -- save the last read time - & journalReverse -- convert all lists to the order they were parsed + liftEither $ checkAddAndBalance d <=< 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 + & journalReverse -- convert all lists to the order they were parsed + where + checkAddAndBalance d j = do + when strict_ $ do + -- If in strict mode, check all postings are to declared accounts + journalCheckAccountsDeclared j + -- and using declared commodities + journalCheckCommoditiesDeclared j - when strict_ $ do - -- If in strict mode, check all postings are to declared accounts - journalCheckAccountsDeclared pj - -- and using declared commodities - journalCheckCommoditiesDeclared pj - - -- infer market prices from commodity-exchanging transactions - journalInferMarketPricesFromTransactions <$> - if not auto_ || null (jtxnmodifiers pj) - then - -- Auto postings are not active. - -- Balance all transactions and maybe check balance assertions. - journalBalanceTransactions balancingopts_ pj - else - -- Auto postings are active. - -- Balance all transactions without checking balance assertions, - journalBalanceTransactions balancingopts_{ignore_assertions_=True} pj - -- then add the auto postings - -- (Note adding auto postings after balancing means #893b fails; - -- adding them before balancing probably means #893a, #928, #938 fail.) - >>= journalModifyTransactions d - -- then check balance assertions. + -- Add forecast transactions if enabled + journalAddForecast d forecast_ 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. >>= journalBalanceTransactions balancingopts_ + -- infer market prices from commodity-exchanging transactions + <&> journalInferMarketPricesFromTransactions + +journalAddAutoPostings :: Day -> BalancingOpts -> Journal -> Either String Journal +journalAddAutoPostings d bopts = + -- Balance all transactions without checking balance assertions, + journalBalanceTransactions bopts{ignore_assertions_=True} + -- then add the auto postings + -- (Note adding auto postings after balancing means #893b fails; + -- adding them before balancing probably means #893a, #928, #938 fail.) + >=> journalModifyTransactions d + +-- | Generate periodic transactions from all periodic transaction rules in the journal. +-- These transactions are added to the in-memory Journal (but not the on-disk file). +-- +-- The start & end date for generated periodic transactions are determined in +-- a somewhat complicated way; see the hledger manual -> Periodic transactions. +journalAddForecast :: Day -> Maybe DateSpan -> Journal -> Journal +journalAddForecast _ Nothing j = j +journalAddForecast d (Just requestedspan) j = j{jtxns = jtxns j ++ forecasttxns} + where + forecasttxns = + map (txnTieKnot . transactionTransformPostings (postingApplyCommodityStyles $ journalCommodityStyles j)) + . filter (spanContainsDate forecastspan . tdate) + . concatMap (`runPeriodicTransaction` forecastspan) + $ jperiodictxns j + + -- "They can start no earlier than: the day following the latest normal transaction in the journal (or today if there are none)." + mjournalend = dbg2 "journalEndDate" $ journalEndDate False j -- ignore secondary dates + forecastbeginDefault = dbg2 "forecastbeginDefault" $ mjournalend <|> Just d + + -- "They end on or before the specified report end date, or 180 days from today if unspecified." + forecastspan = dbg2 "forecastspan" $ dbg2 "forecastspan flag" requestedspan + `spanDefaultsFrom` DateSpan forecastbeginDefault (Just $ addDays 180 d) -- | Check that all the journal's transactions have payees declared with -- payee directives, returning an error message otherwise. diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index cad046a51..f88b063f7 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -195,20 +195,24 @@ defreportopts = ReportOpts , transpose_ = False } -rawOptsToReportOpts :: RawOpts -> IO ReportOpts -rawOptsToReportOpts rawopts = do - d <- getCurrentDay +-- | Generate a ReportOpts from raw command-line input, given a day. +-- This will fail with a usage error if it is passed +-- - an invalid --format argument, +-- - an invalid --value argument, +-- - if --valuechange is called with a valuation type other than -V/--value=end. +rawOptsToReportOpts :: Day -> RawOpts -> ReportOpts +rawOptsToReportOpts d rawopts = let formatstring = T.pack <$> maybestringopt "format" rawopts querystring = map T.pack $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right (costing, valuation) = valuationTypeFromRawOpts rawopts - format <- case parseStringFormat <$> formatstring of - Nothing -> return defaultBalanceLineFormat - Just (Right x) -> return x - Just (Left err) -> fail $ "could not parse format option: " ++ err + format = case parseStringFormat <$> formatstring of + Nothing -> defaultBalanceLineFormat + Just (Right x) -> x + Just (Left err) -> usageError $ "could not parse format option: " ++ err - return defreportopts + in defreportopts {period_ = periodFromRawOpts d rawopts ,interval_ = intervalFromRawOpts rawopts ,statuses_ = statusesFromRawOpts rawopts @@ -291,7 +295,7 @@ updateReportSpecWith = overWithReport reportOpts rawOptsToReportSpec :: RawOpts -> IO ReportSpec rawOptsToReportSpec rawopts = do d <- getCurrentDay - ropts <- rawOptsToReportOpts rawopts + let ropts = rawOptsToReportOpts d rawopts either fail return $ reportOptsToSpec d ropts accountlistmodeopt :: RawOpts -> AccountListMode @@ -443,6 +447,9 @@ reportOptsToggleStatus s ropts@ReportOpts{statuses_=ss} -- specified by -B/--cost, -V, -X/--exchange, or --value flags. It is -- allowed to combine -B/--cost with any other valuation type. If -- there's more than one valuation type, the rightmost flag wins. +-- This will fail with a usage error if an invalid argument is passed +-- to --value, or if --valuechange is called with a valuation type +-- other than -V/--value=end. valuationTypeFromRawOpts :: RawOpts -> (Costing, Maybe ValuationType) valuationTypeFromRawOpts rawopts = (costing, valuation) where diff --git a/hledger-web/Hledger/Web/Test.hs b/hledger-web/Hledger/Web/Test.hs index 4662dc23c..a6b673873 100644 --- a/hledger-web/Hledger/Web/Test.hs +++ b/hledger-web/Hledger/Web/Test.hs @@ -4,6 +4,7 @@ module Hledger.Web.Test ( hledgerWebTest ) where +import Control.Monad.Except (runExceptT) import qualified Data.Text as T import Test.Hspec (hspec) import Yesod.Default.Config @@ -80,13 +81,17 @@ hledgerWebTest = do -- yit "can add transactions" $ do let - copts = defcliopts{reportspec_=defreportspec, file_=[""]} -- non-empty, see file_ note above + -- Have forecasting on for testing + iopts = definputopts{forecast_=Just nulldatespan} + copts = defcliopts{inputopts_=iopts, file_=[""]} -- non-empty, see file_ note above wopts = defwebopts{cliopts_=copts} - j <- fmap (either error id . journalTransform copts) $ readJournal' (T.pack $ unlines -- PARTIAL: readJournal' should not fail + pj <- readJournal' (T.pack $ unlines -- PARTIAL: readJournal' should not fail ["~ monthly" ," assets 10" ," income" ]) + -- Have to give a non-null filename "fake" so forecast transactions get index 0 + j <- fmap (either error id) . runExceptT $ journalFinalise iopts "fake" "" pj -- PARTIAL: journalFinalise should not fail runHspecTestsWith conf wopts j $ do ydescribe "hledger-web --forecast" $ do @@ -95,4 +100,3 @@ hledgerWebTest = do statusIs 200 bodyContains "id=\"transaction-0-1\"" -- 0 indicates a fileless (forecasted) txn bodyContains "id=\"transaction-0-2\"" -- etc. - diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 900ce3b75..d6cd96499 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -15,7 +15,6 @@ module Hledger.Cli.Utils writeOutput, writeOutputLazyText, journalTransform, - journalAddForecast, journalReload, journalReloadIfChanged, journalFileIsNewer, @@ -38,7 +37,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL -import Data.Time (UTCTime, Day, addDays) +import Data.Time (UTCTime, Day) import Safe (readMay, headMay) import System.Console.CmdArgs import System.Directory (getModificationTime, getDirectoryContents, copyFile, doesFileExist) @@ -75,7 +74,7 @@ withJournalDo opts cmd = do -- to let the add command work. journalpaths <- journalFilePathFromOpts opts files <- readJournalFiles (inputopts_ opts) journalpaths - let transformed = journalTransform opts =<< files + let transformed = journalTransform opts <$> files either error' cmd transformed -- PARTIAL: -- | Apply some extra post-parse transformations to the journal, if @@ -88,13 +87,12 @@ withJournalDo opts cmd = do -- -- This will return an error message if the query in any auto posting rule fails -- to parse, or the generated transactions are not balanced. -journalTransform :: CliOpts -> Journal -> Either String Journal +journalTransform :: CliOpts -> Journal -> Journal journalTransform opts = - fmap (anonymiseByOpts opts) + anonymiseByOpts opts -- - converting amounts to market value (--value) -- . journalApplyValue ropts - . fmap (pivotByOpts opts) - . journalAddForecast opts + . pivotByOpts opts -- | Apply the pivot transformation on a journal, if option is present. pivotByOpts :: CliOpts -> Journal -> Journal @@ -110,48 +108,6 @@ anonymiseByOpts opts = then anon else id --- | Generate periodic transactions from all periodic transaction rules in the journal. --- These transactions are added to the in-memory Journal (but not the on-disk file). --- --- When --auto is active, auto posting rules will be applied to the --- generated transactions. If the query in any auto posting rule fails --- to parse, or the generated transactions are not balanced, this function will --- return an error message. --- --- The start & end date for generated periodic transactions are determined in --- a somewhat complicated way; see the hledger manual -> Periodic transactions. --- -journalAddForecast :: CliOpts -> Journal -> Either String Journal -journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j = - case forecast_ iopts of - Nothing -> return j - Just _ -> do - forecasttxns <- addAutoTxns =<< mapM (balanceTransaction (balancingopts_ iopts)) - [ txnTieKnot $ transactionTransformPostings (postingApplyCommodityStyles styles) t - | pt <- jperiodictxns j - , t <- runPeriodicTransaction pt forecastspan - , spanContainsDate forecastspan (tdate t) - ] - journalBalanceTransactions (balancingopts_ iopts) j{ jtxns = concat [jtxns j, forecasttxns] } - where - today = _rsDay rspec - styles = journalCommodityStyles j - - -- "They can start no earlier than: the day following the latest normal transaction in the journal (or today if there are none)." - mjournalend = dbg2 "journalEndDate" $ journalEndDate False j -- ignore secondary dates - forecastbeginDefault = dbg2 "forecastbeginDefault" $ fromMaybe today mjournalend - - -- "They end on or before the specified report end date, or 180 days from today if unspecified." - mspecifiedend = dbg2 "specifieddates" $ addDays 1 <$> reportPeriodLastDay rspec - forecastendDefault = dbg2 "forecastendDefault" $ fromMaybe (addDays 180 today) mspecifiedend - - forecastspan = dbg2 "forecastspan" $ - spanDefaultsFrom - (fromMaybe nulldatespan $ dbg2 "forecastspan flag" $ forecast_ iopts) - (DateSpan (Just forecastbeginDefault) (Just forecastendDefault)) - - addAutoTxns = if auto_ iopts then modifyTransactions styles today (jtxnmodifiers j) else return - -- | Write some output to stdout or to a file selected by --output-file. -- If the file exists it will be overwritten. writeOutput :: CliOpts -> String -> IO () @@ -199,7 +155,7 @@ journalReload :: CliOpts -> IO (Either String Journal) journalReload opts = do journalpaths <- dbg6 "reloading files" <$> journalFilePathFromOpts opts files <- readJournalFiles (inputopts_ opts) journalpaths - return $ journalTransform opts =<< files + return $ journalTransform opts <$> files -- | Has the specified file changed since the journal was last read ? -- Typically this is one of the journal's journalFilePaths. These are diff --git a/hledger/test/forecast.test b/hledger/test/forecast.test index 0670d37f8..7ceba00db 100644 --- a/hledger/test/forecast.test +++ b/hledger/test/forecast.test @@ -235,3 +235,36 @@ hledger -f - reg -b 2021-01-01 -e 2021-01-05 --forecast 2021-01-04 (a) 1 1003 >>>2 >>>=0 + +# 12. Forecast transactions work with balance assignments +hledger -f - print -x --forecast -e 2021-11 +<<< +2021-09-01 Normal Balance Assertion Works + Checking = -60 + Costs + +~ 2021-10-01 explicit forecasted assertion + Checking = -100 + Costs 40 + +~ 2021-10-02 auto-deduced forecasted assertion + Checking = -120 + Costs + +>>> +2021-09-01 Normal Balance Assertion Works + Checking -60 = -60 + Costs 60 + +2021-10-01 explicit forecasted assertion + ; generated-transaction: ~ 2021-10-01 + Checking -40 = -100 + Costs 40 + +2021-10-02 auto-deduced forecasted assertion + ; generated-transaction: ~ 2021-10-02 + Checking -20 = -120 + Costs 20 + +>>>2 +>>>=0