diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 8027219b1af..91415797c40 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -74,6 +74,7 @@ module Hledger.Data.Amount ( noPrice, oneLine, amountstyle, + commodityStylesFromAmounts, styleAmount, styleAmountExceptPrecision, amountUnstyled, @@ -153,12 +154,14 @@ import Data.Semigroup ((<>)) import qualified Data.Text as T import qualified Data.Text.Lazy.Builder as TB import Data.Word (Word8) -import Safe (headDef, lastDef, lastMay) +import Safe (headDef, lastDef, lastMay, headMay) import Text.Printf (printf) import Hledger.Data.Types import Hledger.Data.Commodity import Hledger.Utils +import Data.List.Extra (groupSort) +import Data.Maybe (mapMaybe) deriving instance Show MarketPrice @@ -202,6 +205,53 @@ oneLine = def{displayOneLine=True, displayPrice=False} -- | Default amount style amountstyle = AmountStyle L False (Precision 0) (Just '.') Nothing +-- | Given an ordered list of amounts (typically in parse order), +-- build a map from their commodity names to standard commodity +-- display styles, inferring styles as per docs, eg: +-- "the format of the first amount, adjusted to the highest precision of all amounts". +-- Can return an error message eg if inconsistent number formats are found. +-- (Though, these amounts may have come from multiple files, so we +-- shouldn't assume they use consistent number formats. +-- Currently we don't enforce that even within a single file, +-- and this function never reports an error.) +commodityStylesFromAmounts :: [Amount] -> Either String (M.Map CommoditySymbol AmountStyle) +commodityStylesFromAmounts amts = + Right $ M.fromList commstyles + where + commamts = groupSort [(acommodity as, as) | as <- amts] + commstyles = [(c, canonicalStyleFrom $ map astyle as) | (c,as) <- commamts] + +-- TODO: should probably detect and report inconsistencies here. +-- Though, we don't have the info for a good error message, so maybe elsewhere. +-- | Given a list of amount styles (assumed to be from parsed amounts +-- in a single commodity), in parse order, choose a canonical style. +-- This is: +-- the general style of the first amount, +-- with the first digit group style seen, +-- with the maximum precision of all. +-- +canonicalStyleFrom :: [AmountStyle] -> AmountStyle +canonicalStyleFrom [] = amountstyle +canonicalStyleFrom ss@(s:_) = + s{asprecision=prec, asdecimalpoint=Just decmark, asdigitgroups=mgrps} + where + -- precision is maximum of all precisions + prec = maximumStrict $ map asprecision ss + -- identify the digit group mark (& group sizes) + mgrps = headMay $ mapMaybe asdigitgroups ss + -- if a digit group mark was identified above, we can rely on that; + -- make sure the decimal mark is different. If not, default to period. + defdecmark = + case mgrps of + Just (DigitGroups '.' _) -> ',' + _ -> '.' + -- identify the decimal mark: the first one used, or the above default, + -- but never the same character as the digit group mark. + -- urgh.. refactor.. + decmark = case mgrps of + Just _ -> defdecmark + _ -> headDef defdecmark $ mapMaybe asdecimalpoint ss + ------------------------------------------------------------------------------- -- Amount @@ -953,6 +1003,41 @@ tests_Amount = tests "Amount" [ ,usd (-10) @@ eur 7 ]) + ,tests "commodityStylesFromAmounts" $ [ + + -- Journal similar to the one on #1091: + -- 2019/09/24 + -- (a) 1,000.00 + -- + -- 2019/09/26 + -- (a) 1000,000 + -- + test "1091a" $ do + commodityStylesFromAmounts [ + nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing} + ,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))} + ] + @?= + -- The commodity style should have period as decimal mark + -- and comma as digit group mark. + Right (M.fromList [ + ("", AmountStyle L False (Precision 3) (Just '.') (Just (DigitGroups ',' [3]))) + ]) + -- same journal, entries in reverse order + ,test "1091b" $ do + commodityStylesFromAmounts [ + nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))} + ,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing} + ] + @?= + -- The commodity style should have period as decimal mark + -- and comma as digit group mark. + Right (M.fromList [ + ("", AmountStyle L False (Precision 3) (Just '.') (Just (DigitGroups ',' [3]))) + ]) + + ] + ] ] diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 56d9007b04e..4f19befe306 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -1040,54 +1040,6 @@ journalInferCommodityStyles j = Left e -> Left e Right cs -> Right j{jinferredcommodities = dbg7 "journalInferCommodityStyles" cs} --- | Given a list of amounts, in parse order (roughly speaking; see journalStyleInfluencingAmounts), --- build a map from their commodity names to standard commodity --- display formats. Can return an error message eg if inconsistent --- number formats are found. --- --- Though, these amounts may have come from multiple files, so we --- shouldn't assume they use consistent number formats. --- Currently we don't enforce that even within a single file, --- and this function never reports an error. --- -commodityStylesFromAmounts :: [Amount] -> Either String (M.Map CommoditySymbol AmountStyle) -commodityStylesFromAmounts amts = - Right $ M.fromList commstyles - where - commamts = groupSort [(acommodity as, as) | as <- amts] - commstyles = [(c, canonicalStyleFrom $ map astyle as) | (c,as) <- commamts] - --- TODO: should probably detect and report inconsistencies here. --- Though, we don't have the info for a good error message, so maybe elsewhere. --- | Given a list of amount styles (assumed to be from parsed amounts --- in a single commodity), in parse order, choose a canonical style. --- This is: --- the general style of the first amount, --- with the first digit group style seen, --- with the maximum precision of all. --- -canonicalStyleFrom :: [AmountStyle] -> AmountStyle -canonicalStyleFrom [] = amountstyle -canonicalStyleFrom ss@(s:_) = - s{asprecision=prec, asdecimalpoint=Just decmark, asdigitgroups=mgrps} - where - -- precision is maximum of all precisions - prec = maximumStrict $ map asprecision ss - -- identify the digit group mark (& group sizes) - mgrps = headMay $ mapMaybe asdigitgroups ss - -- if a digit group mark was identified above, we can rely on that; - -- make sure the decimal mark is different. If not, default to period. - defdecmark = - case mgrps of - Just (DigitGroups '.' _) -> ',' - _ -> '.' - -- identify the decimal mark: the first one used, or the above default, - -- but never the same character as the digit group mark. - -- urgh.. refactor.. - decmark = case mgrps of - Just _ -> defdecmark - _ -> headDef defdecmark $ mapMaybe asdecimalpoint ss - -- -- | Apply this journal's historical price records to unpriced amounts where possible. -- journalApplyPriceDirectives :: Journal -> Journal -- journalApplyPriceDirectives j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} @@ -1160,31 +1112,6 @@ journalToCost j@Journal{jtxns=ts} = j{jtxns=map (transactionToCost styles) ts} -- Just (UnitPrice ma) -> c:(concatMap amountCommodities $ amounts ma) -- Just (TotalPrice ma) -> c:(concatMap amountCommodities $ amounts ma) --- | Get an ordered list of amounts in this journal which can --- influence canonical amount display styles. Those amounts are, in --- the following order: --- --- * amounts in market price (P) directives (in parse order) --- * posting amounts in transactions (in parse order) --- * the amount in the final default commodity (D) directive --- --- Transaction price amounts (posting amounts' aprice field) are not included. --- -journalStyleInfluencingAmounts :: Journal -> [Amount] -journalStyleInfluencingAmounts j = - dbg7 "journalStyleInfluencingAmounts" $ - catMaybes $ concat [ - [mdefaultcommodityamt] - ,map (Just . pdamount) $ jpricedirectives j - ,map Just $ concatMap amounts $ map pamount $ journalPostings j - ] - where - -- D's amount style isn't actually stored as an amount, make it into one - mdefaultcommodityamt = - case jparsedefaultcommodity j of - Just (symbol,style) -> Just nullamt{acommodity=symbol,astyle=style} - Nothing -> Nothing - -- overcomplicated/unused amount traversal stuff -- -- | Get an ordered list of 'AmountStyle's from the amounts in this @@ -1536,39 +1463,4 @@ tests_Journal = tests "Journal" [ ] - ,tests "commodityStylesFromAmounts" $ [ - - -- Journal similar to the one on #1091: - -- 2019/09/24 - -- (a) 1,000.00 - -- - -- 2019/09/26 - -- (a) 1000,000 - -- - test "1091a" $ do - commodityStylesFromAmounts [ - nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing} - ,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))} - ] - @?= - -- The commodity style should have period as decimal mark - -- and comma as digit group mark. - Right (M.fromList [ - ("", AmountStyle L False (Precision 3) (Just '.') (Just (DigitGroups ',' [3]))) - ]) - -- same journal, entries in reverse order - ,test "1091b" $ do - commodityStylesFromAmounts [ - nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))} - ,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing} - ] - @?= - -- The commodity style should have period as decimal mark - -- and comma as digit group mark. - Right (M.fromList [ - ("", AmountStyle L False (Precision 3) (Just '.') (Just (DigitGroups ',' [3]))) - ]) - - ] - ]