lib: refactor amount canonicalisation
Amount display style canonicalisation code and terminology has been clarified a bit. Individual amounts still have styles; from these we derive the standard "commodity styles". In user docs, we might call these "commodity formats" since a Ledger-compatible commodity directive would use the "format" keyword.
This commit is contained in:
		
							parent
							
								
									8c6d53f912
								
							
						
					
					
						commit
						96e1ca7ea1
					
				| @ -16,7 +16,8 @@ module Hledger.Data.Journal ( | ||||
|   addTransaction, | ||||
|   journalApplyAliases, | ||||
|   journalBalanceTransactions, | ||||
|   journalCanonicaliseAmounts, | ||||
|   journalApplyCommodityStyles, | ||||
|   commodityStylesFromAmounts, | ||||
|   journalConvertAmountsToCost, | ||||
|   journalFinalise, | ||||
|   -- * Filtering | ||||
| @ -49,7 +50,7 @@ module Hledger.Data.Journal ( | ||||
|   journalEquityAccountQuery, | ||||
|   journalCashAccountQuery, | ||||
|   -- * Misc | ||||
|   canonicalStyles, | ||||
|   canonicalStyleFrom, | ||||
|   matchpats, | ||||
|   nullctx, | ||||
|   nulljournal, | ||||
| @ -420,7 +421,7 @@ journalApplyAliases aliases j@Journal{jtxns=ts} = | ||||
| journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Bool -> Journal -> Either String Journal | ||||
| journalFinalise tclock tlocal path txt ctx assrt j@Journal{files=fs} = do | ||||
|   (journalBalanceTransactions $ | ||||
|     journalCanonicaliseAmounts $ | ||||
|     journalApplyCommodityStyles $ | ||||
|     journalCloseTimeLogEntries tlocal $ | ||||
|     j{ files=(path,txt):fs | ||||
|      , filereadtime=tclock | ||||
| @ -504,47 +505,62 @@ journalBalanceTransactions j@Journal{jtxns=ts, jcommoditystyles=ss} = | ||||
|                                     Left e    -> Left e | ||||
|       where balance = balanceTransaction (Just ss) | ||||
| 
 | ||||
| -- | Convert all the journal's posting amounts (and historical price | ||||
| -- amounts, but currently not transaction price amounts) to their | ||||
| -- canonical display settings. Ie, all amounts in a given commodity | ||||
| -- will use (a) the display settings of the first, and (b) the | ||||
| -- greatest precision, of the posting amounts in that commodity. | ||||
| journalCanonicaliseAmounts :: Journal -> Journal | ||||
| journalCanonicaliseAmounts j@Journal{jtxns=ts, jmarketprices=mps} = j'' | ||||
| -- | Choose standard display formats for all commodities, and | ||||
| -- adjust all the journal's posting amount styles to use them. | ||||
| journalApplyCommodityStyles :: Journal -> Journal | ||||
| journalApplyCommodityStyles j@Journal{jtxns=ts, jmarketprices=mps} = j'' | ||||
|     where | ||||
|       j' = journalChooseCommodityStyles j | ||||
|       j'' = j'{jtxns=map fixtransaction ts, jmarketprices=map fixmarketprice mps} | ||||
|       j' = j{jcommoditystyles = canonicalStyles $ dbg8 "journalAmounts" $ journalAmounts j} | ||||
|       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} | ||||
| 
 | ||||
| -- | Given a list of amounts in parse order, build a map from commodities | ||||
| -- to canonical display styles for amounts in that commodity. | ||||
| canonicalStyles :: [Amount] -> M.Map Commodity AmountStyle | ||||
| canonicalStyles amts = M.fromList commstyles | ||||
| -- | Get this journal's standard display style for the given commodity, or the null style. | ||||
| journalCommodityStyle :: Journal -> Commodity -> AmountStyle | ||||
| journalCommodityStyle j c = M.findWithDefault amountstyle c $ jcommoditystyles j | ||||
| 
 | ||||
| -- | Choose a standard display style for each commodity. | ||||
| -- "hledger... will use the format of the first posting amount in the | ||||
| -- commodity, and the highest precision of all posting amounts in the commodity." | ||||
| -- | ||||
| -- (In user docs, we may now be calling this "format" for consistency with | ||||
| -- the commodity directive's format keyword; in code, it's mostly "style"). | ||||
| -- | ||||
| journalChooseCommodityStyles :: Journal -> Journal | ||||
| journalChooseCommodityStyles j = | ||||
|   j{jcommoditystyles = | ||||
|         commodityStylesFromAmounts $ | ||||
|         dbg8 "journalChooseCommmodityStyles using amounts" $ journalAmounts j} | ||||
| 
 | ||||
| -- | Given a list of amounts in parse order, build a map from their commodity names | ||||
| -- to standard commodity display formats. | ||||
| commodityStylesFromAmounts :: [Amount] -> M.Map Commodity AmountStyle | ||||
| commodityStylesFromAmounts amts = M.fromList commstyles | ||||
|   where | ||||
|     samecomm = \a1 a2 -> acommodity a1 == acommodity a2 | ||||
|     commamts = [(acommodity $ head as, as) | as <- groupBy samecomm $ sortBy (comparing acommodity) amts] | ||||
|     commstyles = [(c, canonicalStyleFrom $ map astyle as) | (c,as) <- commamts] | ||||
| 
 | ||||
| -- Given an ordered list of amount styles for a commodity, build a canonical style. | ||||
| -- | Given an ordered list of amount styles, choose a canonical style. | ||||
| -- That is: the style of the first, and the | ||||
| -- maximum precision of all. | ||||
| canonicalStyleFrom :: [AmountStyle] -> AmountStyle | ||||
| canonicalStyleFrom [] = amountstyle | ||||
| canonicalStyleFrom ss@(first:_) = | ||||
|   first{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} | ||||
|   where | ||||
|     -- precision is the maximum of all precisions seen | ||||
|     prec = maximum $ map asprecision ss | ||||
|     -- find the first decimal point and the first digit group style seen, | ||||
|     -- or use defaults. | ||||
|     mdec  = Just $ headDef '.' $ catMaybes $ map asdecimalpoint ss | ||||
|     mgrps = maybe Nothing Just $ headMay $ catMaybes $ map asdigitgroups ss | ||||
| 
 | ||||
| -- | Get this journal's canonical amount style for the given commodity, or the null style. | ||||
| journalCommodityStyle :: Journal -> Commodity -> AmountStyle | ||||
| journalCommodityStyle j c = M.findWithDefault amountstyle c $ jcommoditystyles j | ||||
|     -- precision is maximum of all precisions | ||||
|     prec = maximum $ map asprecision ss | ||||
|     mdec  = Just $ headDef '.' $ catMaybes $ map asdecimalpoint ss | ||||
|     -- precision is that of first amount with a decimal point | ||||
|     -- (mdec, prec) = | ||||
|     --   case filter (isJust . asdecimalpoint) ss of | ||||
|     --   (s:_) -> (asdecimalpoint s, asprecision s) | ||||
|     --   []    -> (Just '.', 0) | ||||
| 
 | ||||
| -- -- | Apply this journal's historical price records to unpriced amounts where possible. | ||||
| -- journalApplyMarketPrices :: Journal -> Journal | ||||
| @ -575,7 +591,7 @@ journalCloseTimeLogEntries now j@Journal{jtxns=ts, open_timelog_entries=es} = | ||||
| journalConvertAmountsToCost :: Journal -> Journal | ||||
| journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} | ||||
|     where | ||||
|       -- similar to journalCanonicaliseAmounts | ||||
|       -- similar to journalApplyCommodityStyles | ||||
|       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 | ||||
|  | ||||
| @ -134,7 +134,8 @@ balanceReportValue :: Journal -> Day -> BalanceReport -> BalanceReport | ||||
| balanceReportValue j d r = r' | ||||
|   where | ||||
|     (items,total) = r | ||||
|     r' = ([(n, mixedAmountValue j d a) |(n,a) <- items], mixedAmountValue j d total) | ||||
|     r' = dbg8 "balanceReportValue" $ | ||||
|          ([(n, mixedAmountValue j d a) |(n,a) <- items], mixedAmountValue j d total) | ||||
| 
 | ||||
| mixedAmountValue :: Journal -> Day -> MixedAmount -> MixedAmount | ||||
| mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as | ||||
|  | ||||
| @ -80,7 +80,7 @@ showLedgerStats l today span = | ||||
|              path = journalFilePath j | ||||
|              ts = sortBy (comparing tdate) $ filter (spanContainsDate span . tdate) $ jtxns j | ||||
|              as = nub $ map paccount $ concatMap tpostings ts | ||||
|              cs = Map.keys $ canonicalStyles $ concatMap amounts $ map pamount $ concatMap tpostings ts | ||||
|              cs = Map.keys $ commodityStylesFromAmounts $ concatMap amounts $ map pamount $ concatMap tpostings ts | ||||
|              lastdate | null ts = Nothing | ||||
|                       | otherwise = Just $ tdate $ last ts | ||||
|              lastelapsed = maybe Nothing (Just . diffDays today) lastdate | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user