dev: journalApplyCommodityStyles -> journalStyleAmounts

This commit is contained in:
Simon Michael 2023-09-19 07:47:44 +01:00
parent f8027abb44
commit 94ab8b1ed7
4 changed files with 19 additions and 14 deletions

View File

@ -441,11 +441,12 @@ updateTransactionB t = withRunningBalance $ \BalancingState{bsTransactions} ->
-- and (optional) check that all balance assertions pass. -- and (optional) check that all balance assertions pass.
-- Or, return an error message (just the first error encountered). -- Or, return an error message (just the first error encountered).
-- --
-- Assumes journalInferCommodityStyles has been called, since those -- Assumes journalStyleAmounts has been called, since amount styles
-- affect transaction balancing. -- affect transaction balancing.
-- --
-- This does multiple things at once because amount inferring, balance -- This does multiple things at once because amount inferring, balance
-- assignments, balance assertions and posting dates are interdependent. -- assignments, balance assertions and posting dates are interdependent.
--
journalBalanceTransactions :: BalancingOpts -> Journal -> Either String Journal journalBalanceTransactions :: BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions bopts' j' = journalBalanceTransactions bopts' j' =
let let

View File

@ -23,7 +23,7 @@ module Hledger.Data.Journal (
addTransaction, addTransaction,
journalInferMarketPricesFromTransactions, journalInferMarketPricesFromTransactions,
journalInferCommodityStyles, journalInferCommodityStyles,
journalApplyCommodityStyles, journalStyleAmounts,
commodityStylesFromAmounts, commodityStylesFromAmounts,
journalCommodityStyles, journalCommodityStyles,
journalToCost, journalToCost,
@ -793,18 +793,19 @@ journalModifyTransactions verbosetags d j =
Right ts -> Right j{jtxns=ts} Right ts -> Right j{jtxns=ts}
Left err -> Left err Left err -> Left err
-- | Choose and apply a consistent display style to the posting -- | Apply this journal's commodity display styles to all of its amounts.
-- amounts in each commodity (see journalCommodityStyles), -- This does soft rounding (adding/removing decimal zeros, but not losing significant decimal digits);
-- keeping all display precisions unchanged. -- it is suitable for an early cleanup pass before calculations.
-- Can return an error message eg if inconsistent number formats are found. -- Reports may want to do additional rounding/styling at render time.
journalApplyCommodityStyles :: Journal -> Either String Journal -- This can return an error message eg if inconsistent number formats are found.
journalApplyCommodityStyles = fmap fixjournal . journalInferCommodityStyles journalStyleAmounts :: Journal -> Either String Journal
journalStyleAmounts = fmap journalapplystyles . journalInferCommodityStyles
where where
fixjournal j@Journal{jpricedirectives=pds} = journalapplystyles j@Journal{jpricedirectives=pds} =
journalMapPostings (postingApplyCommodityStylesExceptPrecision styles) j{jpricedirectives=map fixpricedirective pds} journalMapPostings (postingStyleAmounts styles) j{jpricedirectives=map fixpricedirective pds}
where where
styles = journalCommodityStyles j styles = journalCommodityStylesWith NoRounding j -- defer rounding, in case of print --round=none
fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=amountSetStylesExceptPrecision styles a} fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmounts styles a}
-- | Get the canonical amount styles for this journal, whether (in order of precedence): -- | Get the canonical amount styles for this journal, whether (in order of precedence):
-- set globally in InputOpts, -- set globally in InputOpts,

View File

@ -24,6 +24,7 @@ Some of these might belong in Hledger.Read.JournalReader or Hledger.Read.
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
--- ** exports --- ** exports
module Hledger.Read.Common ( module Hledger.Read.Common (
@ -317,12 +318,13 @@ journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT Str
journalFinalise iopts@InputOpts{..} f txt pj = do journalFinalise iopts@InputOpts{..} f txt pj = do
t <- liftIO getPOSIXTime t <- liftIO getPOSIXTime
liftEither $ do liftEither $ do
{-# HLINT ignore "Functor law" #-}
j <- pj{jglobalcommoditystyles=fromMaybe mempty $ commodity_styles_ balancingopts_} j <- pj{jglobalcommoditystyles=fromMaybe mempty $ commodity_styles_ balancingopts_}
& journalSetLastReadTime t -- save the last read time & journalSetLastReadTime t -- save the last read time
& journalAddFile (f, txt) -- save the main file's info & journalAddFile (f, txt) -- save the main file's info
& journalReverse -- convert all lists to the order they were parsed & journalReverse -- convert all lists to the order they were parsed
& journalAddAccountTypes -- build a map of all known account types & journalAddAccountTypes -- build a map of all known account types
& journalApplyCommodityStyles -- Infer and apply commodity styles - should be done early & journalStyleAmounts -- Infer and apply commodity styles - should be done early
<&> journalAddForecast (verbose_tags_) (forecastPeriod iopts pj) -- Add forecast transactions if enabled <&> journalAddForecast (verbose_tags_) (forecastPeriod iopts pj) -- Add forecast transactions if enabled
<&> journalPostingsAddAccountTags -- Add account tags to postings, so they can be matched by auto postings. <&> journalPostingsAddAccountTags -- Add account tags to postings, so they can be matched by auto postings.
>>= (if auto_ && not (null $ jtxnmodifiers pj) >>= (if auto_ && not (null $ jtxnmodifiers pj)
@ -370,6 +372,7 @@ journalAddForecast :: Bool -> Maybe DateSpan -> Journal -> Journal
journalAddForecast _ Nothing j = j journalAddForecast _ Nothing j = j
journalAddForecast verbosetags (Just forecastspan) j = j{jtxns = jtxns j ++ forecasttxns} journalAddForecast verbosetags (Just forecastspan) j = j{jtxns = jtxns j ++ forecasttxns}
where where
{-# HLINT ignore "Move concatMap out" #-}
forecasttxns = forecasttxns =
map (txnTieKnot . transactionTransformPostings (postingApplyCommodityStyles $ journalCommodityStyles j)) map (txnTieKnot . transactionTransformPostings (postingApplyCommodityStyles $ journalCommodityStyles j))
. filter (spanContainsDate forecastspan . tdate) . filter (spanContainsDate forecastspan . tdate)

View File

@ -110,7 +110,7 @@ budgetReport rspec bopts reportspan j = dbg4 "sortedbudgetreport" budgetreport
journalAddBudgetGoalTransactions :: BalancingOpts -> ReportOpts -> DateSpan -> Journal -> Journal journalAddBudgetGoalTransactions :: BalancingOpts -> ReportOpts -> DateSpan -> Journal -> Journal
journalAddBudgetGoalTransactions bopts ropts reportspan j = journalAddBudgetGoalTransactions bopts ropts reportspan j =
either error' id $ -- PARTIAL: either error' id $ -- PARTIAL:
(journalApplyCommodityStyles >=> journalBalanceTransactions bopts) j{ jtxns = budgetts } (journalStyleAmounts >=> journalBalanceTransactions bopts) j{ jtxns = budgetts }
where where
budgetspan = dbg3 "budget span" $ DateSpan (Exact <$> mbudgetgoalsstartdate) (Exact <$> spanEnd reportspan) budgetspan = dbg3 "budget span" $ DateSpan (Exact <$> mbudgetgoalsstartdate) (Exact <$> spanEnd reportspan)
where where