summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--CHANGES.md10
-rw-r--r--Hledger/Data/Posting.hs9
-rw-r--r--Hledger/Query.hs1
-rw-r--r--Hledger/Read/Common.hs178
-rw-r--r--Hledger/Reports/AccountTransactionsReport.hs16
-rw-r--r--Hledger/Reports/ReportOptions.hs40
-rw-r--r--hledger-lib.cabal2
7 files changed, 156 insertions, 100 deletions
diff --git a/CHANGES.md b/CHANGES.md
index 1934181..dd8fdbb 100644
--- 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
index 4a21622..0459e9f 100644
--- a/Hledger/Data/Posting.hs
+++ b/Hledger/Data/Posting.hs
@@ -38,6 +38,7 @@ module Hledger.Data.Posting (
relatedPostings,
postingStripPrices,
postingApplyAliases,
+ postingApplyCommodityStyles,
-- * date operations
postingDate,
postingDate2,
@@ -298,6 +299,14 @@ postingApplyAliases aliases p@Posting{paccount} =
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.
-- Or, return any error arising from a bad regular expression in the aliases.
diff --git a/Hledger/Query.hs b/Hledger/Query.hs
index 14840d9..05b23f0 100644
--- a/Hledger/Query.hs
+++ b/Hledger/Query.hs
@@ -20,6 +20,7 @@ module Hledger.Query (
-- * parsing
parseQuery,
parseQueryList,
+ parseQueryTerm,
simplifyQuery,
filterQuery,
-- * accessors
diff --git a/Hledger/Read/Common.hs b/Hledger/Read/Common.hs
index 3b106c9..f225a5a 100644
--- a/Hledger/Read/Common.hs
+++ b/Hledger/Read/Common.hs
@@ -32,6 +32,7 @@ module Hledger.Read.Common (
InputOpts (..),
definputopts,
rawOptsToInputOpts,
+ forecastPeriodFromRawOpts,
-- * parsing utilities
runTextParser,
@@ -48,6 +49,8 @@ module Hledger.Read.Common (
journalCheckAccountsDeclared,
journalCheckCommoditiesDeclared,
journalCheckPayeesDeclared,
+ journalAddForecast,
+ journalAddAutoPostings,
setYear,
getYear,
setDefaultCommodityAndStyle,
@@ -127,13 +130,15 @@ import Prelude ()
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.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)
@@ -154,6 +159,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)
@@ -203,6 +210,7 @@ data InputOpts = InputOpts {
,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 @@ definputopts = InputOpts
, 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 @@ 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,
@@ -328,52 +365,65 @@ 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
- 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
-
- -- 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 () ->
-
- -- and using declared commodities
- case if strict_ then journalCheckCommoditiesDeclared pj' else Right () of
- Left e -> throwError e
- Right () ->
-
- -- 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
+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
+
+ -- 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
+ >=> journalApplyCommodityStyles
+
+-- | 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
index 5947ece..de87681 100644
--- a/Hledger/Reports/AccountTransactionsReport.hs
+++ b/Hledger/Reports/AccountTransactionsReport.hs
@@ -21,7 +21,7 @@ import Data.Maybe (catMaybes)
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 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq' thisacctq =
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 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq' thisacctq =
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
index 852ee28..d5423c4 100644
--- a/Hledger/Reports/ReportOptions.hs
+++ b/Hledger/Reports/ReportOptions.hs
@@ -33,7 +33,6 @@ module Hledger.Reports.ReportOptions (
mixedAmountApplyValuationAfterSumFromOptsWith,
valuationAfterSum,
intervalFromRawOpts,
- forecastPeriodFromRawOpts,
queryFromFlags,
transactionDateFn,
postingDateFn,
@@ -138,7 +137,6 @@ data ReportOpts = ReportOpts {
-- 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 @@ defreportopts = ReportOpts
, 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 @@ rawOptsToReportOpts rawopts = do
,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 @@ updateReportSpecWith f rspec = reportOptsToSpec (rsToday rspec) . f $ rsOpts rsp
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 @@ intervalFromRawOpts = lastDef NoInterval . collectopts intervalfromrawopt
| 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 @@ 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-lib.cabal b/hledger-lib.cabal
index f0a3a08..07be8b4 100644
--- a/hledger-lib.cabal
+++ b/hledger-lib.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
-- 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