hledger-lib 1.22.1 → 1.22.2

raw patch · 7 files changed

+153/−97 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGES.md +10/−0
• Hledger/Data/Posting.hs +9/−0
• Hledger/Query.hs +1/−0
• Hledger/Read/Common.hs +111/−61
• Hledger/Reports/AccountTransactionsReport.hs +5/−11
• Hledger/Reports/ReportOptions.hs +16/−24
• hledger-lib.cabal +1/−1

@@ -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

@@ -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.

@@ -20,6 +20,7 @@   -- * parsing   parseQuery,   parseQueryList,+  parseQueryTerm,   simplifyQuery,   filterQuery,   -- * accessors

@@ -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.

@@ -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 

@@ -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

@@ -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