ref: Refactor journalFinalise to clarify flow.
The only semantic difference is that we now apply journalApplyCommodityStyles before running journalCheckAccountsDeclared and journalCheckCommoditiesDeclared.
This commit is contained in:
parent
c537f9426b
commit
04a36d4942
@ -128,7 +128,7 @@ import Prelude ()
|
|||||||
import "base-compat-batteries" Prelude.Compat hiding (fail, readFile)
|
import "base-compat-batteries" Prelude.Compat hiding (fail, readFile)
|
||||||
import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault)
|
import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault)
|
||||||
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail)
|
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 Control.Monad.State.Strict hiding (fail)
|
||||||
import Data.Bifunctor (bimap, second)
|
import Data.Bifunctor (bimap, second)
|
||||||
import Data.Char (digitToInt, isDigit, isSpace)
|
import Data.Char (digitToInt, isDigit, isSpace)
|
||||||
@ -329,52 +329,43 @@ parseAndFinaliseJournal' parser iopts f txt = do
|
|||||||
-- - infer transaction-implied market prices from transaction prices
|
-- - infer transaction-implied market prices from transaction prices
|
||||||
--
|
--
|
||||||
journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal
|
journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal
|
||||||
journalFinalise InputOpts{auto_,balancingopts_,strict_} f txt pj = do
|
journalFinalise InputOpts{auto_,balancingopts_,strict_} f txt pj' = do
|
||||||
t <- liftIO getClockTime
|
t <- liftIO getClockTime
|
||||||
d <- liftIO getCurrentDay
|
d <- liftIO getCurrentDay
|
||||||
let pj' =
|
liftEither $ do
|
||||||
pj{jglobalcommoditystyles=fromMaybe M.empty $ commodity_styles_ balancingopts_} -- save any global commodity styles
|
-- Infer and apply canonical styles for each commodity (or throw an error).
|
||||||
& journalAddFile (f, txt) -- save the main file's info
|
-- This affects transaction balancing/assertions/assignments, so needs to be done early.
|
||||||
& journalSetLastReadTime t -- save the last read time
|
pj <- journalApplyCommodityStyles $
|
||||||
& journalReverse -- convert all lists to the order they were parsed
|
pj'{jglobalcommoditystyles=fromMaybe M.empty $ commodity_styles_ balancingopts_} -- save any global commodity styles
|
||||||
|
& journalAddFile (f, txt) -- save the main file's info
|
||||||
-- If in strict mode, check all postings are to declared accounts
|
& journalSetLastReadTime t -- save the last read time
|
||||||
case if strict_ then journalCheckAccountsDeclared pj' else Right () of
|
& journalReverse -- convert all lists to the order they were parsed
|
||||||
Left e -> throwError e
|
|
||||||
Right () ->
|
|
||||||
|
|
||||||
|
when strict_ $ do
|
||||||
|
-- If in strict mode, check all postings are to declared accounts
|
||||||
|
journalCheckAccountsDeclared pj
|
||||||
-- and using declared commodities
|
-- and using declared commodities
|
||||||
case if strict_ then journalCheckCommoditiesDeclared pj' else Right () of
|
journalCheckCommoditiesDeclared pj
|
||||||
Left e -> throwError e
|
|
||||||
Right () ->
|
|
||||||
|
|
||||||
-- Infer and apply canonical styles for each commodity (or throw an error).
|
-- infer market prices from commodity-exchanging transactions
|
||||||
-- This affects transaction balancing/assertions/assignments, so needs to be done early.
|
journalInferMarketPricesFromTransactions <$>
|
||||||
case journalApplyCommodityStyles pj' of
|
if not auto_ || null (jtxnmodifiers pj)
|
||||||
Left e -> throwError e
|
then
|
||||||
Right pj'' -> either throwError return $
|
-- Auto postings are not active.
|
||||||
pj''
|
-- Balance all transactions and maybe check balance assertions.
|
||||||
& (if not auto_ || null (jtxnmodifiers pj'')
|
journalBalanceTransactions balancingopts_ pj
|
||||||
then
|
else
|
||||||
-- Auto postings are not active.
|
-- Auto postings are active.
|
||||||
-- Balance all transactions and maybe check balance assertions.
|
-- Balance all transactions without checking balance assertions,
|
||||||
journalBalanceTransactions balancingopts_
|
journalBalanceTransactions balancingopts_{ignore_assertions_=True} pj
|
||||||
else \j -> do -- Either monad
|
-- then add the auto postings
|
||||||
-- Auto postings are active.
|
-- (Note adding auto postings after balancing means #893b fails;
|
||||||
-- Balance all transactions without checking balance assertions,
|
-- adding them before balancing probably means #893a, #928, #938 fail.)
|
||||||
j' <- journalBalanceTransactions balancingopts_{ignore_assertions_=True} j
|
>>= journalModifyTransactions d
|
||||||
-- then add the auto postings
|
-- then apply commodity styles once more, to style the auto posting amounts. (XXX inefficient ?)
|
||||||
-- (Note adding auto postings after balancing means #893b fails;
|
>>= journalApplyCommodityStyles
|
||||||
-- adding them before balancing probably means #893a, #928, #938 fail.)
|
-- then check balance assertions.
|
||||||
case journalModifyTransactions d j' of
|
>>= journalBalanceTransactions balancingopts_
|
||||||
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
|
|
||||||
|
|
||||||
-- | Check that all the journal's transactions have payees declared with
|
-- | Check that all the journal's transactions have payees declared with
|
||||||
-- payee directives, returning an error message otherwise.
|
-- payee directives, returning an error message otherwise.
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user