;lib: let commodityStylesFromAmounts & co. return an error (#793, #1091)

And if they did, the stats command would now throw an error.

Changed:
journalApplyCommodityStyles
journalInferCommodityStyles
commodityStylesFromAmounts

hledger-lib/Hledger/Data/Journal.hs

@@ -905,18 +905,21 @@ checkBalanceAssignmentUnassignableAccountB p = do
 -- | 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
--- amounts as in hledger < 0.28.
-journalApplyCommodityStyles :: Journal -> Journal
-journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} = j''
-    where
-      j' = journalInferCommodityStyles j
-      styles = journalCommodityStyles j'
-      j'' = j'{jtxns=map fixtransaction ts, jpricedirectives=map fixpricedirective pds}
-      fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
-      fixposting p = p{pamount=styleMixedAmount styles $ pamount p
-                      ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p}
-      fixbalanceassertion ba = ba{baamount=styleAmount styles $ baamount ba}
-      fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmount styles a}
+-- amounts as in hledger < 0.28. Can return an error message
+-- eg if inconsistent number formats are found.
+journalApplyCommodityStyles :: Journal -> Either String Journal
+journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} =
+  case journalInferCommodityStyles j of
+    Left e   -> Left e
+    Right j' -> Right j''
+      where
+        styles = journalCommodityStyles j'
+        j'' = j'{jtxns=map fixtransaction ts, jpricedirectives=map fixpricedirective pds}
+        fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
+        fixposting p = p{pamount=styleMixedAmount styles $ pamount p
+                        ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p}
+        fixbalanceassertion ba = ba{baamount=styleAmount styles $ baamount ba}
+        fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmount styles a}
 
 -- | Get all the amount styles defined in this journal, either declared by
 -- a commodity directive or inferred from amounts, as a map from symbol to style.
@@ -931,16 +934,29 @@ journalCommodityStyles j = declaredstyles <> inferredstyles
 -- | Collect and save inferred amount styles for each commodity based on
 -- the posting amounts in that commodity (excluding price amounts), ie:
 -- "the format of the first amount, adjusted to the highest precision of all amounts".
-journalInferCommodityStyles :: Journal -> Journal
+-- Can return an error message eg if inconsistent number formats are found.
+journalInferCommodityStyles :: Journal -> Either String Journal
 journalInferCommodityStyles j =
-  j{jinferredcommodities =
+  case
     commodityStylesFromAmounts $
-    dbg8 "journalInferCommmodityStyles using amounts" $ journalAmounts j}
+    dbg8 "journalInferCommmodityStyles using amounts" $
+    journalAmounts j
+  of
+    Left e   -> Left e
+    Right cs -> Right j{jinferredcommodities = cs}
 
--- | Given a list of amounts in parse order, build a map from their commodity names
--- to standard commodity display formats.
-commodityStylesFromAmounts :: [Amount] -> M.Map CommoditySymbol AmountStyle
-commodityStylesFromAmounts amts = M.fromList commstyles
+-- | Given a list of parsed amounts, in parse order, 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.
+-- And currently we don't enforce that even within a single file.
+--
+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]
@@ -1377,9 +1393,9 @@ tests_Journal = tests "Journal" [
          `is`
           -- The commodity style should have period as decimal mark
           -- and comma as digit group mark.
-          M.fromList [
+          Right (M.fromList [
             ("", AmountStyle L False 3 (Just '.') (Just (DigitGroups ',' [3])))
-          ]
+          ])
 
      ]
 

hledger-lib/Hledger/Read/Common.hs

@@ -239,6 +239,7 @@ parseAndFinaliseJournal parser iopts f txt = do
         , jincludefilestack = [f] }
   eep <- liftIO $ runExceptT $
     runParserT (evalStateT parser initJournal) f txt
+  -- TODO: urgh.. clean this up somehow
   case eep of
     Left finalParseError ->
       throwError $ finalErrorBundlePretty $ attachSource f txt finalParseError
@@ -247,51 +248,54 @@ parseAndFinaliseJournal parser iopts f txt = do
       Left e -> throwError $ customErrorBundlePretty e
 
       Right pj ->
-        -- If we are using automated transactions, we finalize twice:
-        -- once before and once after. However, if we are running it
-        -- twice, we don't check assertions the first time (they might
-        -- be false pending modifiers) and we don't reorder the second
-        -- time. If we are only running once, we reorder and follow
-        -- the options for checking assertions.
-        --
+
+        -- Infer and apply canonical styles for each commodity (or fail).
         -- TODO: since #903's refactoring for hledger 1.12,
         -- journalApplyCommodityStyles here is seeing the
         -- transactions before they get reversesd to normal order.
-        -- And this can trigger a bug in commodityStylesFromAmounts
-        -- (#1091).
-        --
-        let fj = if auto_ iopts && (not . null . jtxnmodifiers) pj
+        case journalApplyCommodityStyles pj of
+          Left e    -> throwError e
+          Right pj' -> 
+            -- Finalise the parsed journal.
+            let fj =
+                  if auto_ iopts && (not . null . jtxnmodifiers) pj
+                  then
+                    -- When automatic postings are active, we finalise twice:
+                    -- once before and once after. However, if we are running it
+                    -- twice, we don't check assertions the first time (they might
+                    -- be false pending modifiers) and we don't reorder the second
+                    -- time. If we are only running once, we reorder and follow
+                    -- the options for checking assertions.
+                    --
+                    -- first pass, doing most of the work
+                    (
+                     (journalModifyTransactions <$>) $  -- add auto postings after balancing ? #893b fails
+                     journalBalanceTransactions False $
+                     -- journalModifyTransactions <$>   -- add auto postings before balancing ? probably #893a, #928, #938 fail
+                     journalReverse $
+                     journalAddFile (f, txt) $
+                     pj')
+                    -- second pass, checking balance assertions
+                    >>= (\j ->
+                       journalBalanceTransactions (not $ ignore_assertions_ iopts) $
+                       journalSetLastReadTime t $
+                       j)
 
-                 -- transaction modifiers are active
-                 then
-                   -- first pass, doing most of the work
-                     (
-                      (journalModifyTransactions <$>) $  -- add auto postings after balancing ? #893b fails
-                      journalBalanceTransactions False $
-                      -- journalModifyTransactions <$>   -- add auto postings before balancing ? probably #893a, #928, #938 fail
-                      journalReverse $
-                      journalAddFile (f, txt) $
-                      journalApplyCommodityStyles pj)
-                   -- second pass, checking balance assertions
-                   >>= (\j ->
-                      journalBalanceTransactions (not $ ignore_assertions_ iopts) $
-                      journalSetLastReadTime t $
-                      j)
-
-                 -- transaction modifiers are not active
-                 else journalBalanceTransactions (not $ ignore_assertions_ iopts) $
-                      journalReverse $
-                      journalAddFile (f, txt) $
-                      journalApplyCommodityStyles $
-                      journalSetLastReadTime t $
-                      pj
-        in
-          case fj of
-            Right j -> return j
-            Left e  -> throwError e
+                  else
+                    -- automatic postings are not active
+                    journalBalanceTransactions (not $ ignore_assertions_ iopts) $
+                    journalReverse $
+                    journalAddFile (f, txt) $
+                    journalSetLastReadTime t $
+                    pj'
+            in
+              case fj of
+                Left e  -> throwError e
+                Right j -> return j
 
 -- Like parseAndFinaliseJournal but takes a (non-Erroring) JournalParser.
--- Used for timeclock/timedot. XXX let them use parseAndFinaliseJournal instead
+-- Used for timeclock/timedot.
+-- TODO: get rid of this, use parseAndFinaliseJournal instead
 parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts
                            -> FilePath -> Text -> ExceptT String IO Journal
 parseAndFinaliseJournal' parser iopts f txt = do
@@ -301,35 +305,31 @@ parseAndFinaliseJournal' parser iopts f txt = do
         { jparsedefaultyear = Just y
         , jincludefilestack = [f] }
   ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt
+  -- see notes above
   case ep of
     Left e   -> throwError $ customErrorBundlePretty e
-
     Right pj ->
-      -- If we are using automated transactions, we finalize twice:
-      -- once before and once after. However, if we are running it
-      -- twice, we don't check assertions the first time (they might
-      -- be false pending modifiers) and we don't reorder the second
-      -- time. If we are only running once, we reorder and follow the
-      -- options for checking assertions.
-      let fj = if auto_ iopts && (not . null . jtxnmodifiers) pj
-               then journalModifyTransactions <$>
-                    (journalBalanceTransactions False $
-                     journalReverse $
-                     journalApplyCommodityStyles pj) >>=
-                    (\j -> journalBalanceTransactions (not $ ignore_assertions_ iopts) $
-                           journalAddFile (f, txt) $
-                           journalSetLastReadTime t $
-                           j)
-               else journalBalanceTransactions (not $ ignore_assertions_ iopts) $
-                    journalReverse $
-                    journalAddFile (f, txt) $
-                    journalApplyCommodityStyles $
-                    journalSetLastReadTime t $
-                    pj
-      in
-        case fj of
-          Right j -> return j
-          Left e  -> throwError e
+      case journalApplyCommodityStyles pj of
+        Left e    -> throwError e
+        Right pj' -> 
+          let fj = if auto_ iopts && (not . null . jtxnmodifiers) pj
+                   then journalModifyTransactions <$>
+                        (journalBalanceTransactions False $
+                         journalReverse $
+                         pj') >>=
+                        (\j -> journalBalanceTransactions (not $ ignore_assertions_ iopts) $
+                               journalAddFile (f, txt) $
+                               journalSetLastReadTime t $
+                               j)
+                   else journalBalanceTransactions (not $ ignore_assertions_ iopts) $
+                        journalReverse $
+                        journalAddFile (f, txt) $
+                        journalSetLastReadTime t $
+                        pj'
+          in
+            case fj of
+              Left e  -> throwError e
+              Right j -> return j
 
 setYear :: Year -> JournalParser m ()
 setYear y = modify' (\j -> j{jparsedefaultyear=Just y})

hledger/Hledger/Cli/Commands/Stats.hs

@@ -81,7 +81,7 @@ showLedgerStats l today span =
              path = journalFilePath j
              ts = sortOn tdate $ filter (spanContainsDate span . tdate) $ jtxns j
              as = nub $ map paccount $ concatMap tpostings ts
-             cs = Map.keys $ commodityStylesFromAmounts $ concatMap (amounts . pamount) $ concatMap tpostings ts
+             cs = either error' Map.keys $ commodityStylesFromAmounts $ concatMap (amounts . pamount) $ concatMap tpostings ts
              lastdate | null ts = Nothing
                       | otherwise = Just $ tdate $ last ts
              lastelapsed = fmap (diffDays today) lastdate