lib: move commodityStylesFromAmounts to Hledger.Data.Amount

simonmichael · Feb 6, 2021 · 2fa60bb · 2fa60bb
1 parent d865ec5
commit 2fa60bb
Show file tree

Hide file tree

Showing 2 changed files with 86 additions and 109 deletions.
diff --git 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
@@ -1014,54 +1014,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}
@@ -1134,31 +1086,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
@@ -1510,39 +1437,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])))
-          ])
-
-     ]
-
   ]