;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,11 +905,14 @@ 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''
+-- 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
-      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}
@@ -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,23 +248,25 @@ parseAndFinaliseJournal parser iopts f txt = do
       Left e -> throwError $ customErrorBundlePretty e
 
       Right pj ->
-        -- If we are using automated transactions, we finalize twice:
+
+        -- 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.
+        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.
                     --
-        -- 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
-
-                 -- transaction modifiers are active
-                 then
                     -- first pass, doing most of the work
                     (
                      (journalModifyTransactions <$>) $  -- add auto postings after balancing ? #893b fails
@@ -271,27 +274,28 @@ parseAndFinaliseJournal parser iopts f txt = do
                      -- journalModifyTransactions <$>   -- add auto postings before balancing ? probably #893a, #928, #938 fail
                      journalReverse $
                      journalAddFile (f, txt) $
-                      journalApplyCommodityStyles pj)
+                     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) $
+                  else
+                    -- automatic postings are not active
+                    journalBalanceTransactions (not $ ignore_assertions_ iopts) $
                     journalReverse $
                     journalAddFile (f, txt) $
-                      journalApplyCommodityStyles $
                     journalSetLastReadTime t $
-                      pj
+                    pj'
             in
               case fj of
-            Right j -> return j
                 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,21 +305,18 @@ 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.
+      case journalApplyCommodityStyles pj of
+        Left e    -> throwError e
+        Right pj' -> 
           let fj = if auto_ iopts && (not . null . jtxnmodifiers) pj
                    then journalModifyTransactions <$>
                         (journalBalanceTransactions False $
                          journalReverse $
-                     journalApplyCommodityStyles pj) >>=
+                         pj') >>=
                         (\j -> journalBalanceTransactions (not $ ignore_assertions_ iopts) $
                                journalAddFile (f, txt) $
                                journalSetLastReadTime t $
@@ -323,13 +324,12 @@ parseAndFinaliseJournal' parser iopts f txt = do
                    else journalBalanceTransactions (not $ ignore_assertions_ iopts) $
                         journalReverse $
                         journalAddFile (f, txt) $
-                    journalApplyCommodityStyles $
                         journalSetLastReadTime t $
-                    pj
+                        pj'
           in
             case fj of
-          Right j -> return j
               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