mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-09 21:22:26 +03:00
journal: infer and balance amounts with standard amount styles (fix #737)
Inferred amounts now have the appropriate standard amount style applied. And when checking for balanced transactions, amount styles declared with commodity directives are also used (previously only inferred amount styles were).
This commit is contained in:
parent
45973eca7e
commit
3d4f5600ae
@ -61,6 +61,7 @@ module Hledger.Data.Amount (
|
||||
amountValue,
|
||||
-- ** rendering
|
||||
amountstyle,
|
||||
styleAmount,
|
||||
showAmount,
|
||||
cshowAmount,
|
||||
showAmountWithZeroCommodity,
|
||||
@ -93,6 +94,7 @@ module Hledger.Data.Amount (
|
||||
isReallyZeroMixedAmountCost,
|
||||
mixedAmountValue,
|
||||
-- ** rendering
|
||||
styleMixedAmount,
|
||||
showMixedAmount,
|
||||
showMixedAmountOneLine,
|
||||
showMixedAmountDebug,
|
||||
@ -131,8 +133,14 @@ import Hledger.Utils
|
||||
|
||||
deriving instance Show MarketPrice
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Amount styles
|
||||
|
||||
-- | Default amount style
|
||||
amountstyle = AmountStyle L False 0 (Just '.') Nothing
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Amount
|
||||
|
||||
@ -265,6 +273,14 @@ showPriceDebug NoPrice = ""
|
||||
showPriceDebug (UnitPrice pa) = " @ " ++ showAmountDebug pa
|
||||
showPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa
|
||||
|
||||
-- | Given a map of standard amount display styles, apply the appropriate one to this amount.
|
||||
-- If there's no standard style for this amount's commodity, return the amount unchanged.
|
||||
styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
|
||||
styleAmount styles a =
|
||||
case M.lookup (acommodity a) styles of
|
||||
Just s -> a{astyle=s}
|
||||
Nothing -> a
|
||||
|
||||
-- | Get the string representation of an amount, based on its
|
||||
-- commodity's display settings. String representations equivalent to
|
||||
-- zero are converted to just \"0\". The special "missing" amount is
|
||||
@ -555,6 +571,10 @@ isReallyZeroMixedAmountCost = isReallyZeroMixedAmount . costOfMixedAmount
|
||||
-- where a' = normaliseMixedAmountSquashPricesForDisplay a
|
||||
-- b' = normaliseMixedAmountSquashPricesForDisplay b
|
||||
|
||||
-- | Given a map of standard amount display styles, apply the appropriate ones to each individual amount.
|
||||
styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
|
||||
styleMixedAmount styles (Mixed as) = Mixed $ map (styleAmount styles) as
|
||||
|
||||
-- | Get the string representation of a mixed amount, after
|
||||
-- normalising it to one amount per commodity. Assumes amounts have
|
||||
-- no or similar prices, otherwise this can show misleading prices.
|
||||
@ -648,6 +668,7 @@ canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styl
|
||||
mixedAmountValue :: Journal -> Day -> MixedAmount -> MixedAmount
|
||||
mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- misc
|
||||
|
||||
|
@ -19,6 +19,7 @@ module Hledger.Data.Journal (
|
||||
journalBalanceTransactions,
|
||||
journalApplyCommodityStyles,
|
||||
commodityStylesFromAmounts,
|
||||
journalCommodityStyles,
|
||||
journalConvertAmountsToCost,
|
||||
journalFinalise,
|
||||
journalPivot,
|
||||
@ -592,7 +593,7 @@ journalBalanceTransactionsST assrt j createStore storeIn extract =
|
||||
let env = Env bals
|
||||
(storeIn txStore)
|
||||
assrt
|
||||
(Just $ jinferredcommodities j)
|
||||
(Just $ journalCommodityStyles j)
|
||||
flip R.runReaderT env $ do
|
||||
dated <- fmap snd . sortBy (comparing fst) . concat
|
||||
<$> mapM' discriminateByDate (jtxns j)
|
||||
@ -722,7 +723,6 @@ storeTransaction tx = liftModifier $ ($tx) . eStoreTx
|
||||
liftModifier :: (Env s -> ST s a) -> CurrentBalancesModifier s a
|
||||
liftModifier f = R.ask >>= lift . lift . f
|
||||
|
||||
|
||||
-- | Choose and apply a consistent display format to the posting
|
||||
-- amounts in each commodity. Each commodity's format is specified by
|
||||
-- a commodity format directive, or otherwise inferred from posting
|
||||
@ -731,28 +731,20 @@ journalApplyCommodityStyles :: Journal -> Journal
|
||||
journalApplyCommodityStyles j@Journal{jtxns=ts, jmarketprices=mps} = j''
|
||||
where
|
||||
j' = journalInferCommodityStyles j
|
||||
styles = journalCommodityStyles j'
|
||||
j'' = j'{jtxns=map fixtransaction ts, jmarketprices=map fixmarketprice mps}
|
||||
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
|
||||
fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
|
||||
fixmarketprice mp@MarketPrice{mpamount=a} = mp{mpamount=fixamount a}
|
||||
fixmixedamount (Mixed as) = Mixed $ map fixamount as
|
||||
fixamount a@Amount{acommodity=c} = a{astyle=journalCommodityStyle j' c}
|
||||
fixposting p@Posting{pamount=a} = p{pamount=styleMixedAmount styles a}
|
||||
fixmarketprice mp@MarketPrice{mpamount=a} = mp{mpamount=styleAmount styles a}
|
||||
|
||||
-- | Get this journal's standard display style for the given
|
||||
-- commodity. That is the style defined by the last corresponding
|
||||
-- commodity format directive if any, otherwise the style inferred
|
||||
-- from the posting amounts (or in some cases, price amounts) in this
|
||||
-- commodity if any, otherwise the default style.
|
||||
journalCommodityStyle :: Journal -> CommoditySymbol -> AmountStyle
|
||||
journalCommodityStyle j = fromMaybe amountstyle{asprecision=2} . journalCommodityStyleLookup j
|
||||
|
||||
journalCommodityStyleLookup :: Journal -> CommoditySymbol -> Maybe AmountStyle
|
||||
journalCommodityStyleLookup j c =
|
||||
listToMaybe $
|
||||
catMaybes [
|
||||
M.lookup c (jcommodities j) >>= cformat
|
||||
,M.lookup c $ jinferredcommodities j
|
||||
]
|
||||
-- | Get all the amount styles defined in this journal, either
|
||||
-- declared by a commodity directive (preferred) or inferred from amounts,
|
||||
-- as a map from symbol to style.
|
||||
journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle
|
||||
journalCommodityStyles j = declaredstyles <> inferredstyles
|
||||
where
|
||||
declaredstyles = M.mapMaybe cformat $ jcommodities j
|
||||
inferredstyles = jinferredcommodities j
|
||||
|
||||
-- | Infer a display format for each commodity based on the amounts parsed.
|
||||
-- "hledger... will use the format of the first posting amount in the
|
||||
@ -760,8 +752,8 @@ journalCommodityStyleLookup j c =
|
||||
journalInferCommodityStyles :: Journal -> Journal
|
||||
journalInferCommodityStyles j =
|
||||
j{jinferredcommodities =
|
||||
commodityStylesFromAmounts $
|
||||
dbg8 "journalChooseCommmodityStyles using amounts" $ journalAmounts j}
|
||||
commodityStylesFromAmounts $
|
||||
dbg8 "journalInferCommmodityStyles using amounts" $ journalAmounts j}
|
||||
|
||||
-- | Given a list of amounts in parse order, build a map from their commodity names
|
||||
-- to standard commodity display formats.
|
||||
@ -817,10 +809,8 @@ journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
|
||||
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
|
||||
fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
|
||||
fixmixedamount (Mixed as) = Mixed $ map fixamount as
|
||||
fixamount = applyJournalStyle . costOfAmount
|
||||
applyJournalStyle a
|
||||
| Just s <- journalCommodityStyleLookup j (acommodity a) = a{astyle=s}
|
||||
| otherwise = a
|
||||
fixamount = styleAmount styles . costOfAmount
|
||||
styles = journalCommodityStyles j
|
||||
|
||||
-- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol.
|
||||
-- journalCanonicalCommodities :: Journal -> M.Map String CommoditySymbol
|
||||
|
@ -278,7 +278,7 @@ tests_inference = [
|
||||
"inferBalancingAmount" ~: do
|
||||
let p `gives` p' = assertEqual (show p) (Right p') $ inferTransaction p
|
||||
inferTransaction :: Transaction -> Either String Transaction
|
||||
inferTransaction = runIdentity . runExceptT . inferBalancingAmount (\_ _ -> return ())
|
||||
inferTransaction = runIdentity . runExceptT . inferBalancingAmount (\_ _ -> return ()) Map.empty
|
||||
nulltransaction `gives` nulltransaction
|
||||
nulltransaction{
|
||||
tpostings=[
|
||||
@ -382,11 +382,11 @@ balanceTransactionUpdate :: MonadError String m
|
||||
-- ^ update function
|
||||
-> Maybe (Map.Map CommoditySymbol AmountStyle)
|
||||
-> Transaction -> m Transaction
|
||||
balanceTransactionUpdate update styles t =
|
||||
finalize =<< inferBalancingAmount update t
|
||||
balanceTransactionUpdate update mstyles t =
|
||||
finalize =<< inferBalancingAmount update (fromMaybe Map.empty mstyles) t
|
||||
where
|
||||
finalize t' = let t'' = inferBalancingPrices t'
|
||||
in if isTransactionBalanced styles t''
|
||||
in if isTransactionBalanced mstyles t''
|
||||
then return $ txnTieKnot t''
|
||||
else throwError $ printerr $ nonzerobalanceerror t''
|
||||
printerr s = intercalate "\n" [s, showTransactionUnelided t]
|
||||
@ -409,11 +409,12 @@ balanceTransactionUpdate update styles t =
|
||||
-- We can infer a missing amount when there are multiple postings and exactly
|
||||
-- one of them is amountless. If the amounts had price(s) the inferred amount
|
||||
-- have the same price(s), and will be converted to the price commodity.
|
||||
inferBalancingAmount :: MonadError String m
|
||||
=> (AccountName -> MixedAmount -> m ())
|
||||
-- ^ update function
|
||||
-> Transaction -> m Transaction
|
||||
inferBalancingAmount update t@Transaction{tpostings=ps}
|
||||
inferBalancingAmount :: MonadError String m =>
|
||||
(AccountName -> MixedAmount -> m ()) -- ^ update function
|
||||
-> Map.Map CommoditySymbol AmountStyle -- ^ standard amount styles
|
||||
-> Transaction
|
||||
-> m Transaction
|
||||
inferBalancingAmount update styles t@Transaction{tpostings=ps}
|
||||
| length amountlessrealps > 1
|
||||
= throwError $ printerr "could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts)"
|
||||
| length amountlessbvps > 1
|
||||
@ -432,8 +433,13 @@ inferBalancingAmount update t@Transaction{tpostings=ps}
|
||||
inferamount p@Posting{ptype=BalancedVirtualPosting}
|
||||
| not (hasAmount p) = updateAmount p bvsum
|
||||
inferamount p = return p
|
||||
updateAmount p amt = update (paccount p) amt' >> return p { pamount=amt', porigin=Just $ originalPosting p }
|
||||
where amt' = normaliseMixedAmount $ costOfMixedAmount (-amt)
|
||||
updateAmount p amt =
|
||||
update (paccount p) amt' >> return p { pamount=amt', porigin=Just $ originalPosting p }
|
||||
where
|
||||
-- Inferred amounts are converted to cost.
|
||||
-- Also, ensure the new amount has the standard style for its commodity
|
||||
-- (the main amount styling pass happened before this balancing pass).
|
||||
amt' = styleMixedAmount styles $ normaliseMixedAmount $ costOfMixedAmount (-amt)
|
||||
|
||||
-- | Infer prices for this transaction's posting amounts, if needed to make
|
||||
-- the postings balance, and if possible. This is done once for the real
|
||||
|
@ -302,7 +302,7 @@ data Journal = Journal {
|
||||
-- principal data
|
||||
,jaccounts :: [(AccountName, Maybe AccountCode)] -- ^ accounts that have been declared by account directives
|
||||
,jcommodities :: M.Map CommoditySymbol Commodity -- ^ commodities and formats declared by commodity directives
|
||||
,jinferredcommodities :: M.Map CommoditySymbol AmountStyle -- ^ commodities and formats inferred from journal amounts
|
||||
,jinferredcommodities :: M.Map CommoditySymbol AmountStyle -- ^ commodities and formats inferred from journal amounts XXX misnamed
|
||||
,jmarketprices :: [MarketPrice]
|
||||
,jmodifiertxns :: [ModifierTransaction]
|
||||
,jperiodictxns :: [PeriodicTransaction]
|
||||
|
@ -95,14 +95,14 @@ Balance changes in 2016/12/01-2016/12/03:
|
||||
$ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget
|
||||
Balance changes in 2016/12/01-2016/12/03:
|
||||
|
||||
|| 2016/12/01 2016/12/02 2016/12/03
|
||||
=======================++=======================================================================================
|
||||
<unbudgeted>:expenses || 0 0 $40
|
||||
assets:cash || $-15 [ 60% of $-25] $-26.0 [ 104% of $-25] $-51 [ 204% of $-25]
|
||||
expenses:food || £10 [ 150% of $10] 20 CAD [ 210% of $10] $11 [ 110% of $10]
|
||||
expenses:leisure || 0 [ 0% of $15] $5 [ 33% of $15] 0 [ 0% of $15]
|
||||
-----------------------++---------------------------------------------------------------------------------------
|
||||
|| $-15, £10 [ 0% of 0] $-21.0, 20 CAD [ 0% of 0] 0 [ 0% of 0]
|
||||
|| 2016/12/01 2016/12/02 2016/12/03
|
||||
=======================++=====================================================================================
|
||||
<unbudgeted>:expenses || 0 0 $40
|
||||
assets:cash || $-15 [ 60% of $-25] $-26 [ 104% of $-25] $-51 [ 204% of $-25]
|
||||
expenses:food || £10 [ 150% of $10] 20 CAD [ 210% of $10] $11 [ 110% of $10]
|
||||
expenses:leisure || 0 [ 0% of $15] $5 [ 33% of $15] 0 [ 0% of $15]
|
||||
-----------------------++-------------------------------------------------------------------------------------
|
||||
|| $-15, £10 [ 0% of 0] $-21, 20 CAD [ 0% of 0] 0 [ 0% of 0]
|
||||
# TODO zero totals ^
|
||||
|
||||
<
|
||||
|
@ -14,24 +14,9 @@ hledger -f - print
|
||||
|
||||
>>>=0
|
||||
|
||||
## 1b. here $'s canonical display precision should be 2 not 4
|
||||
## XXX no, because the inferred amount $1.0049 is observed
|
||||
# hledger -f - print --cost
|
||||
# <<<
|
||||
# 2010/1/1
|
||||
# a $0.00
|
||||
# a 1C @ $1.0049
|
||||
# a
|
||||
# >>>
|
||||
# 2010/01/01
|
||||
# a 0
|
||||
# a $1.00
|
||||
# a $-1.00
|
||||
#
|
||||
# >>>=0
|
||||
|
||||
# 2. and here the price should be printed with its original precision, not
|
||||
# the canonical display precision
|
||||
# 2. here the price should be printed with its original precision, not
|
||||
# the canonical display precision. And the inferred amount should be printed
|
||||
# with the canonical precision (2 digits, inferred from the first posting).
|
||||
hledger -f - print --explicit
|
||||
<<<
|
||||
2010/1/1
|
||||
@ -42,7 +27,7 @@ hledger -f - print --explicit
|
||||
2010/01/01
|
||||
a 0
|
||||
a 1C @ $1.0049
|
||||
a $-1.0049
|
||||
a $-1.00
|
||||
|
||||
>>>=0
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user