diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -9,6 +9,16 @@ Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. For user-visible changes, see the hledger package changelog. +# 1.22.2 2021-08-07 + +- forecast_ has moved from ReportOpts to InputOpts. (Stephen Morgan) + +- Generate forecast transactions at journal finalisation, rather than as a postprocessing step. + This allows us to have a uniform procedure for balancing transactions, + whether they are normal transactions or forecast transactions, including + dealing with balance assignments, balance assertions, and auto postings. + ([#1638](https://github.com/simonmichael/hledger/issues/1638), Stephen Morgan) + # 1.22.1 2021-08-02 - Allow megaparsec 9.1 diff --git a/Hledger/Data/Posting.hs b/Hledger/Data/Posting.hs --- a/Hledger/Data/Posting.hs +++ b/Hledger/Data/Posting.hs @@ -38,6 +38,7 @@ relatedPostings, postingStripPrices, postingApplyAliases, + postingApplyCommodityStyles, -- * date operations postingDate, postingDate2, @@ -297,6 +298,14 @@ where err = "problem while applying account aliases:\n" ++ pshow aliases ++ "\n to account name: "++T.unpack paccount++"\n "++e + +-- | Choose and apply a consistent display style to the posting +-- amounts in each commodity (see journalCommodityStyles). +postingApplyCommodityStyles :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting +postingApplyCommodityStyles styles p = p{pamount=styleMixedAmount styles $ pamount p + ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p} + where + fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba} -- | Rewrite an account name using all matching aliases from the given list, in sequence. -- Each alias sees the result of applying the previous aliases. diff --git a/Hledger/Query.hs b/Hledger/Query.hs --- a/Hledger/Query.hs +++ b/Hledger/Query.hs @@ -20,6 +20,7 @@ -- * parsing parseQuery, parseQueryList, + parseQueryTerm, simplifyQuery, filterQuery, -- * accessors diff --git a/Hledger/Read/Common.hs b/Hledger/Read/Common.hs --- a/Hledger/Read/Common.hs +++ b/Hledger/Read/Common.hs @@ -32,6 +32,7 @@ InputOpts (..), definputopts, rawOptsToInputOpts, + forecastPeriodFromRawOpts, -- * parsing utilities runTextParser, @@ -48,6 +49,8 @@ journalCheckAccountsDeclared, journalCheckCommoditiesDeclared, journalCheckPayeesDeclared, + journalAddForecast, + journalAddAutoPostings, setYear, getYear, setDefaultCommodityAndStyle, @@ -127,13 +130,15 @@ import "base-compat-batteries" Prelude.Compat hiding (fail, readFile) import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault) import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail) -import Control.Monad.Except (ExceptT(..), runExceptT, throwError) +import Control.Monad.Except (ExceptT(..), liftEither, runExceptT, throwError) import Control.Monad.State.Strict hiding (fail) 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(..)) @@ -142,7 +147,7 @@ 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) @@ -154,6 +159,8 @@ 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) @@ -203,6 +210,7 @@ ,new_ :: Bool -- ^ read only new transactions since this file was last read ,new_save_ :: Bool -- ^ save latest new transactions state for next time ,pivot_ :: String -- ^ use the given field's value as the account name + ,forecast_ :: Maybe DateSpan -- ^ span in which to generate forecast transactions ,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) @@ -219,29 +227,56 @@ , new_ = False , new_save_ = True , pivot_ = "" + , forecast_ = Nothing , auto_ = False , balancingopts_ = def , strict_ = False } -rawOptsToInputOpts :: RawOpts -> InputOpts -rawOptsToInputOpts rawopts = InputOpts{ - -- files_ = listofstringopt "file" rawopts - mformat_ = Nothing - ,mrules_file_ = maybestringopt "rules-file" rawopts - ,aliases_ = listofstringopt "alias" rawopts - ,anon_ = boolopt "anon" rawopts - ,new_ = boolopt "new" rawopts - ,new_save_ = True - ,pivot_ = stringopt "pivot" rawopts - ,auto_ = boolopt "auto" rawopts - ,balancingopts_ = def{ ignore_assertions_ = boolopt "ignore-assertions" rawopts - , infer_prices_ = not noinferprice - } - ,strict_ = boolopt "strict" rawopts - } +-- | 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 + + return InputOpts{ + -- files_ = listofstringopt "file" rawopts + mformat_ = Nothing + ,mrules_file_ = maybestringopt "rules-file" rawopts + ,aliases_ = listofstringopt "alias" rawopts + ,anon_ = boolopt "anon" rawopts + ,new_ = boolopt "new" rawopts + ,new_save_ = True + ,pivot_ = stringopt "pivot" rawopts + ,forecast_ = forecastPeriodFromRawOpts d rawopts + ,auto_ = boolopt "auto" rawopts + ,balancingopts_ = def{ ignore_assertions_ = boolopt "ignore-assertions" rawopts + , infer_prices_ = not noinferprice + } + ,strict_ = boolopt "strict" rawopts + } where noinferprice = boolopt "strict" rawopts || stringopt "args" rawopts == "balancednoautoconversion" +-- | 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 rawopts = case maybestringopt "forecast" rawopts of + Nothing -> Nothing + 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 -- | Run a text parser in the identity monad. See also: parseWithState. @@ -319,6 +354,8 @@ -- -- - 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, @@ -328,52 +365,65 @@ -- - 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 - let pj' = - 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 +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. + 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 - -- If in strict mode, check all postings are to declared accounts - case if strict_ then journalCheckAccountsDeclared pj' else Right () of - Left e -> throwError e - Right () -> + -- 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 - -- and using declared commodities - case if strict_ then journalCheckCommoditiesDeclared pj' else Right () of - Left e -> throwError e - Right () -> +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 + >=> journalApplyCommodityStyles - -- Infer and apply canonical styles for each commodity (or throw an error). - -- This affects transaction balancing/assertions/assignments, so needs to be done early. - case journalApplyCommodityStyles pj' of - Left e -> throwError e - Right pj'' -> either throwError return $ - pj'' - & (if not auto_ || null (jtxnmodifiers pj'') - then - -- Auto postings are not active. - -- Balance all transactions and maybe check balance assertions. - journalBalanceTransactions balancingopts_ - else \j -> do -- Either monad - -- Auto postings are active. - -- Balance all transactions without checking balance assertions, - j' <- journalBalanceTransactions balancingopts_{ignore_assertions_=True} j - -- then add the auto postings - -- (Note adding auto postings after balancing means #893b fails; - -- adding them before balancing probably means #893a, #928, #938 fail.) - case journalModifyTransactions d j' of - Left e -> throwError e - Right j'' -> do - -- then apply commodity styles once more, to style the auto posting amounts. (XXX inefficient ?) - j''' <- journalApplyCommodityStyles j'' - -- then check balance assertions. - journalBalanceTransactions balancingopts_ j''' - ) - & fmap journalInferMarketPricesFromTransactions -- infer market prices from commodity-exchanging transactions +-- | 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/Reports/AccountTransactionsReport.hs b/Hledger/Reports/AccountTransactionsReport.hs --- a/Hledger/Reports/AccountTransactionsReport.hs +++ b/Hledger/Reports/AccountTransactionsReport.hs @@ -21,7 +21,7 @@ import Data.Ord (Down(..), comparing) import Data.Text (Text) import qualified Data.Text as T -import Data.Time.Calendar (Day, addDays) +import Data.Time.Calendar (Day) import Hledger.Data import Hledger.Query @@ -83,17 +83,11 @@ where -- A depth limit should not affect the account transactions report; it should show all transactions in/below this account. -- Queries on currency or amount are also ignored at this stage; they are handled earlier, before valuation. - reportq = simplifyQuery $ And [aregisterq, periodq, excludeforecastq (forecast_ ropts)] + reportq = simplifyQuery $ And [aregisterq, periodq] where aregisterq = filterQuery (not . queryIsCurOrAmt) $ filterQuery (not . queryIsDepth) reportq' periodq = Date . periodAsDateSpan $ period_ ropts - -- Except in forecast mode, exclude future/forecast transactions. - excludeforecastq (Just _) = Any - excludeforecastq Nothing = -- not:date:tomorrow- not:tag:generated-transaction - And [ Not . Date $ DateSpan (Just . addDays 1 $ rsToday rspec) Nothing - , Not generatedTransactionTag - ] - amtq = filterQuery queryIsCurOrAmt reportq' + amtq = filterQuery queryIsCurOrAmt $ rsQuery rspec queryIsCurOrAmt q = queryIsSym q || queryIsAmt q -- Note that within this functions, we are only allowed limited @@ -138,9 +132,9 @@ items = accountTransactionsReportItems reportq thisacctq startbal maNegate - -- sort by the transaction's register date, for accurate starting balance + -- sort by the transaction's register date, then index, for accurate starting balance . ptraceAtWith 5 (("ts4:\n"++).pshowTransactions.map snd) - . sortBy (comparing $ Down . fst) + . sortBy (comparing (Down . fst) <> comparing (Down . tindex . snd)) . map (\t -> (transactionRegisterDate reportq thisacctq t, t)) $ jtxns acctJournal diff --git a/Hledger/Reports/ReportOptions.hs b/Hledger/Reports/ReportOptions.hs --- a/Hledger/Reports/ReportOptions.hs +++ b/Hledger/Reports/ReportOptions.hs @@ -33,7 +33,6 @@ mixedAmountApplyValuationAfterSumFromOptsWith, valuationAfterSum, intervalFromRawOpts, - forecastPeriodFromRawOpts, queryFromFlags, transactionDateFn, postingDateFn, @@ -138,7 +137,6 @@ -- Influenced by the --color/colour flag (cf CliOptions), -- whether stdout is an interactive terminal, and the value of -- TERM and existence of NO_COLOR environment variables. - ,forecast_ :: Maybe DateSpan ,transpose_ :: Bool } deriving (Show) @@ -175,24 +173,27 @@ , invert_ = False , normalbalance_ = Nothing , color_ = False - , forecast_ = Nothing , 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 @@ -221,7 +222,6 @@ ,invert_ = boolopt "invert" rawopts ,pretty_tables_ = boolopt "pretty-tables" rawopts ,color_ = useColorOnStdout -- a lower-level helper - ,forecast_ = forecastPeriodFromRawOpts d rawopts ,transpose_ = boolopt "transpose" rawopts } @@ -275,7 +275,7 @@ 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 @@ -388,17 +388,6 @@ | n == "yearly" = Just $ Years 1 | otherwise = Nothing --- | get period expression from --forecast option -forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan -forecastPeriodFromRawOpts d opts = - case maybestringopt "forecast" opts - 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 - -- | Extract the interval from the parsed -p/--period expression. -- Return Nothing if an interval is not explicitly defined. extractIntervalOrNothing :: (Interval, DateSpan) -> Maybe Interval @@ -435,6 +424,9 @@ -- 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-lib.cabal b/hledger-lib.cabal --- a/hledger-lib.cabal +++ b/hledger-lib.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hledger-lib -version: 1.22.1 +version: 1.22.2 synopsis: A reusable library providing the core functionality of hledger description: A reusable library containing hledger's core functionality. This is used by most hledger* packages so that they support the same