slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

dev: equity/cost analysis: process in parse order, better debug output

Browse Source 
More intuitive posting numbering, making troubleshooting easier.
This commit is contained in:
Simon Michael 2023-07-15 16:01:05 -10:00
parent c63fba88b6
commit 516a5cb448
1 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -54,7 +54,7 @@ module Hledger.Data.Transaction
import Control.Monad.Trans.State (StateT(..), evalStateT) import Control.Monad.Trans.State (StateT(..), evalStateT)
import Data.Bifunctor (first) import Data.Bifunctor (first)
import Data.Foldable (foldrM) import Data.Foldable (foldlM)
import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Semigroup (Endo(..)) import Data.Semigroup (Endo(..))
import Data.Text (Text) import Data.Text (Text)
@ -70,6 +70,7 @@ import Hledger.Data.Dates
import Hledger.Data.Posting import Hledger.Data.Posting
import Hledger.Data.Amount import Hledger.Data.Amount
import Hledger.Data.Valuation import Hledger.Data.Valuation
import Data.Functor ((<&>))
nulltransaction :: Transaction nulltransaction :: Transaction
@ -369,17 +370,22 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra
-- Using the provided account types map, sort the given indexed postings -- Using the provided account types map, sort the given indexed postings
-- into three lists of posting numbers (stored in two pairs), like so: -- into three lists of posting numbers (stored in two pairs), like so:
-- (conversion postings, (costful postings, other postings)). -- (conversion postings, (costful other postings, costless other postings)).
-- A true first argument activates its secondary function: check that all -- A true first argument activates its secondary function: check that all
-- conversion postings occur in adjacent pairs, otherwise return an error. -- conversion postings occur in adjacent pairs, otherwise return an error.
partitionAndCheckConversionPostings :: Bool -> M.Map AccountName AccountType -> [IdxPosting] -> Either Text ( [(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]) ) partitionAndCheckConversionPostings :: Bool -> M.Map AccountName AccountType -> [IdxPosting] -> Either Text ( [(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]) )
partitionAndCheckConversionPostings check acctTypes = fmap fst . foldrM select (([], ([], [])), Nothing) partitionAndCheckConversionPostings check acctTypes =
-- Left fold processes postings in parse order, so that eg inferred costs
-- will be added to the first (top-most) posting, not the last one.
foldlM select (([], ([], [])), Nothing)
-- The costless other postings are somehow reversed still; "second (second reverse" fixes that.
<&> fmap (second (second reverse) . fst)
where where
select np@(_, p) ((cs, others@(ps, os)), Nothing) select ((cs, others@(ps, os)), Nothing) np@(_, p)
| isConversion p = Right ((cs, others), Just np) | isConversion p = Right ((cs, others), Just np)
| hasCost p = Right ((cs, (np:ps, os)), Nothing) | hasCost p = Right ((cs, (np:ps, os)), Nothing)
| otherwise = Right ((cs, (ps, np:os)), Nothing) | otherwise = Right ((cs, (ps, np:os)), Nothing)
select np@(_, p) ((cs, others@(ps,os)), Just lst) select ((cs, others@(ps,os)), Just lst) np@(_, p)
| isConversion p = Right (((lst, np):cs, others), Nothing) | isConversion p = Right (((lst, np):cs, others), Nothing)
| check = Left "Conversion postings must occur in adjacent pairs" | check = Left "Conversion postings must occur in adjacent pairs"
| otherwise = Right ((cs, (ps, np:os)), Nothing) | otherwise = Right ((cs, (ps, np:os)), Nothing)