simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-11-07 21:15:19 +03:00
Code Issues Projects Releases Wiki Activity

journal: infer and balance amounts with standard amount styles (fix #737)

Browse Source 
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:
Simon Michael 2018-04-20 12:18:28 -07:00
parent 45973eca7e
commit 3d4f5600ae
6 changed files with 68 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
hledger-lib/Hledger/Data/Amount.hs
View File

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

44
hledger-lib/Hledger/Data/Journal.hs
View File

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

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

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

2
hledger-lib/Hledger/Data/Types.hs
View File

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

16
tests/budget/budget.test
View File

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

23
tests/journal/precision.test
View File

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