diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 0a120c81c..dcb3143f6 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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 diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 79661717e..67c46c1d2 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -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 diff --git a/hledger/Hledger/Cli/Stats.hs b/hledger/Hledger/Cli/Stats.hs index 43a178777..521a5456e 100644 --- a/hledger/Hledger/Cli/Stats.hs +++ b/hledger/Hledger/Cli/Stats.hs @@ -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