;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.
+-- amounts as in hledger < 0.28. Can return an error message
-journalApplyCommodityStyles :: Journal -> Journal
+-- eg if inconsistent number formats are found.
-journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} = j''
+journalApplyCommodityStyles :: Journal -> Either String Journal
-    where
+journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} =
-      j' = journalInferCommodityStyles j
+  case journalInferCommodityStyles j of
-      styles = journalCommodityStyles j'
+    Left e   -> Left e
-      j'' = j'{jtxns=map fixtransaction ts, jpricedirectives=map fixpricedirective pds}
+    Right j' -> Right j''
-      fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
+      where
-      fixposting p = p{pamount=styleMixedAmount styles $ pamount p
+        styles = journalCommodityStyles j'
-                      ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p}
+        j'' = j'{jtxns=map fixtransaction ts, jpricedirectives=map fixpricedirective pds}
-      fixbalanceassertion ba = ba{baamount=styleAmount styles $ baamount ba}
+        fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
-      fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmount styles a}
+        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
+-- | Given a list of parsed amounts, in parse order, build a map from
--- to standard commodity display formats.
+-- their commodity names to standard commodity display formats. Can
-commodityStylesFromAmounts :: [Amount] -> M.Map CommoditySymbol AmountStyle
+-- return an error message eg if inconsistent number formats are
-commodityStylesFromAmounts amts = M.fromList commstyles
+-- 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
+        -- Infer and apply canonical styles for each commodity (or fail).
-        -- 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
+        case journalApplyCommodityStyles pj of
-        -- (#1091).
+          Left e    -> throwError e
-        --
+          Right pj' -> 
-        let fj = if auto_ iopts && (not . null . jtxnmodifiers) 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
+                  else
-                 then
+                    -- automatic postings are not active
-                   -- first pass, doing most of the work
+                    journalBalanceTransactions (not $ ignore_assertions_ iopts) $
-                     (
+                    journalReverse $
-                      (journalModifyTransactions <$>) $  -- add auto postings after balancing ? #893b fails
+                    journalAddFile (f, txt) $
-                      journalBalanceTransactions False $
+                    journalSetLastReadTime t $
-                      -- journalModifyTransactions <$>   -- add auto postings before balancing ? probably #893a, #928, #938 fail
+                    pj'
-                      journalReverse $
+            in
-                      journalAddFile (f, txt) $
+              case fj of
-                      journalApplyCommodityStyles pj)
+                Left e  -> throwError e
-                   -- second pass, checking balance assertions
+                Right j -> return j
-                   >>= (\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
 
 -- 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:
+      case journalApplyCommodityStyles pj of
-      -- once before and once after. However, if we are running it
+        Left e    -> throwError e
-      -- twice, we don't check assertions the first time (they might
+        Right pj' -> 
-      -- be false pending modifiers) and we don't reorder the second
+          let fj = if auto_ iopts && (not . null . jtxnmodifiers) pj
-      -- time. If we are only running once, we reorder and follow the
+                   then journalModifyTransactions <$>
-      -- options for checking assertions.
+                        (journalBalanceTransactions False $
-      let fj = if auto_ iopts && (not . null . jtxnmodifiers) pj
+                         journalReverse $
-               then journalModifyTransactions <$>
+                         pj') >>=
-                    (journalBalanceTransactions False $
+                        (\j -> journalBalanceTransactions (not $ ignore_assertions_ iopts) $
-                     journalReverse $
+                               journalAddFile (f, txt) $
-                     journalApplyCommodityStyles pj) >>=
+                               journalSetLastReadTime t $
-                    (\j -> journalBalanceTransactions (not $ ignore_assertions_ iopts) $
+                               j)
-                           journalAddFile (f, txt) $
+                   else journalBalanceTransactions (not $ ignore_assertions_ iopts) $
-                           journalSetLastReadTime t $
+                        journalReverse $
-                           j)
+                        journalAddFile (f, txt) $
-               else journalBalanceTransactions (not $ ignore_assertions_ iopts) $
+                        journalSetLastReadTime t $
-                    journalReverse $
+                        pj'
-                    journalAddFile (f, txt) $
+          in
-                    journalApplyCommodityStyles $
+            case fj of
-                    journalSetLastReadTime t $
+              Left e  -> throwError e
-                    pj
+              Right j -> return j
-      in
-        case fj of
-          Right j -> return j
-          Left e  -> throwError e
 
 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