fix: make a few more error messages consistent, hiding call stack [#2367]

Author: simonmichael

hledger-lib/Hledger/Data/Amount.hs

@@ -196,7 +196,7 @@ import Test.Tasty (testGroup)
 import Test.Tasty.HUnit ((@?=), assertBool, testCase)
 
 import Hledger.Data.Types
-import Hledger.Utils (colorB, numDigitsInt, numDigitsInteger)
+import Hledger.Utils (colorB, error', numDigitsInt, numDigitsInteger)
 import Hledger.Utils.Text (textQuoteIfNeeded)
 import Text.WideString (WideBuilder(..), wbFromText, wbToText, wbUnpack)
 import Data.Functor ((<&>))
@@ -333,7 +333,7 @@ similarAmountsOp op Amount{acommodity=_,  aquantity=q1, astyle=AmountStyle{aspre
    -- trace ("a1:"++showAmountDebug a1) $ trace ("a2:"++showAmountDebug a2) $ traceWith (("= :"++).showAmountDebug)
    nullamt{acommodity=c2, aquantity=q1 `op` q2, astyle=s2{asprecision=max p1 p2}}
   --  c1==c2 || q1==0 || q2==0 =
-  --  otherwise = error "tried to do simple arithmetic with amounts in different commodities"
+  --  otherwise = error' "tried to do simple arithmetic with amounts in different commodities"
 
 -- | Convert an amount to the specified commodity, ignoring and discarding
 -- any costs and assuming an exchange rate of 1.
@@ -774,9 +774,9 @@ instance Num MixedAmount where
     fromInteger = mixedAmount . fromInteger
     negate = maNegate
     (+)    = maPlus
-    (*)    = error "error, mixed amounts do not support multiplication" -- PARTIAL:
+    (*)    = error' "error, mixed amounts do not support multiplication" -- PARTIAL:
     abs    = mapMixedAmount (\amt -> amt { aquantity = abs (aquantity amt)})
-    signum = error "error, mixed amounts do not support signum"
+    signum = error' "error, mixed amounts do not support signum"
 
 -- | Calculate the key used to store an Amount within a MixedAmount.
 amountKey :: Amount -> MixedAmountKey

hledger-lib/Hledger/Data/Dates.hs

@@ -285,7 +285,7 @@ dateSpanSplitLimits :: (Day -> Day) -> (Day -> Day) -> DateSpan -> (Day, Day)
 dateSpanSplitLimits start _    (DateSpan (Just s) (Just e)) = (start $ fromEFDay s, fromEFDay e)
 dateSpanSplitLimits start next (DateSpan (Just s) Nothing)  = (start $ fromEFDay s, next $ start $ fromEFDay s)
 dateSpanSplitLimits start next (DateSpan Nothing  (Just e)) = (start $ fromEFDay e, next $ start $ fromEFDay e)
-dateSpanSplitLimits _     _    (DateSpan Nothing   Nothing) = error "dateSpanSplitLimits: should not be nulldatespan"  -- PARTIAL: This case should have been handled in splitSpan
+dateSpanSplitLimits _     _    (DateSpan Nothing   Nothing) = error' "dateSpanSplitLimits: should not be nulldatespan"  -- PARTIAL: This case should have been handled in splitSpan
 
 -- | Construct a list of exact 'DateSpan's from a list of boundaries, which fit within a given range.
 spansFromBoundaries :: Day -> [Day] -> [DateSpan]

hledger-lib/Hledger/Data/Json.hs

@@ -28,6 +28,7 @@ import qualified Data.Text.Lazy.Builder as TB
 import           Text.Megaparsec (Pos, SourcePos, mkPos, unPos)
 
 import           Hledger.Data.Types
+import           Hledger.Utils.IO (error')
 import           Hledger.Data.Amount (amountsRaw, mixed)
 
 -- To JSON
@@ -290,8 +291,8 @@ readJsonFile :: FromJSON a => FilePath -> IO a
 readJsonFile f = do
   bl <- BL.readFile f
   -- PARTIAL:
-  let v = fromMaybe (error $ "could not decode JSON in "++show f++" to target value")
+  let v = fromMaybe (error' $ "could not decode JSON in "++show f++" to target value")
           (decode bl :: Maybe Value)
   case fromJSON v :: FromJSON a => Result a of
-    Error e   -> error e
+    Error e   -> error' e
     Success t -> return t

hledger-lib/Hledger/Query.hs

@@ -309,7 +309,7 @@ parseQueryTerm _ (T.stripPrefix "status:" -> Just s) =
         case parseStatus s of Left e   -> Left $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e
                               Right st -> Right (StatusQ st, [])
 parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Right (Real $ parseBool s || T.null s, [])
-parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Right (Amt ord q, []) where (ord, q) = either error id $ parseAmountQueryTerm s  -- PARTIAL:
+parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Right (Amt ord q, []) where (ord, q) = either error' id $ parseAmountQueryTerm s  -- PARTIAL:
 parseQueryTerm _ (T.stripPrefix "depth:" -> Just s) = (,[]) <$> parseDepthSpecQuery s
 parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = (,[]) . Sym <$> toRegexCI ("^" <> s <> "$") -- support cur: as an alias
 parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = (,[]) <$> parseTag s

hledger-lib/Hledger/Reports/PostingsReport.hs

@@ -106,7 +106,7 @@ postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items
           runningcalc = registerRunningCalculationFn ropts
           startnum = if historical then length precedingps + 1 else 1
           postings | historical = if sortspec_ /= defsortspec 
-                        then error "--historical and --sort should not be used together" 
+                        then error' "--historical and --sort should not be used together" 
                         else sortedps
                    | otherwise = sortedps
 

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -643,7 +643,7 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{_rsReportOpts=ropts} j priceo
     historical = DateSpan Nothing $ (fmap Exact . spanStart) =<< headMay spans
     spans = snd $ reportSpanBothDates j rspec
     styles = journalCommodityStyles j
-    err = error "journalApplyValuationFromOpts: expected all spans to have an end date"
+    err = error' "journalApplyValuationFromOpts: expected all spans to have an end date"
 
 -- | Select the Account valuation functions required for performing valuation after summing
 -- amounts. Used in MultiBalanceReport to value historical and similar reports.
@@ -662,7 +662,7 @@ mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle =
         NoConversionOp -> id
         ToCost         -> styleAmounts styles . mixedAmountCost
     styles = journalCommodityStyles j
-    err = error "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date"
+    err = error' "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date"
 
 -- | If the ReportOpts specify that we are performing valuation after summing amounts,
 -- return Just of the commodity symbol we're converting to, Just Nothing for the default,

hledger-lib/Hledger/Utils/String.hs

@@ -243,5 +243,5 @@ strWidth = realLength
 stripAnsi :: String -> String
 stripAnsi s = either err id $ regexReplace ansire "" s
  where
-   err    = error "stripAnsi: invalid replacement pattern"      -- PARTIAL, shouldn't happen
+   err    = errorWithoutStackTrace "stripAnsi: invalid replacement pattern"      -- PARTIAL, shouldn't happen
    ansire = toRegex' $ T.pack "\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]"  -- PARTIAL, should succeed

hledger-ui/Hledger/UI/ErrorScreen.hs

@@ -63,7 +63,7 @@ esDraw UIState{aScreen=ES ESS{..}
               ,("q", "quit")
               ]
 
-esDraw _ = error "draw function called with wrong screen type, should not happen"  -- PARTIAL:
+esDraw _ = error' "draw function called with wrong screen type, should not happen"  -- PARTIAL:
 
 esHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
 esHandle ev = do

hledger-ui/Hledger/UI/TransactionScreen.hs

@@ -152,7 +152,7 @@ tsHandle ev = do
               liftIO (uiReloadJournal copts d ui) >>= put'
                 -- debugging.. leaving these here because they were hard to find
                 -- \u -> dbguiEv (pshow u) >> put' u  -- doesn't log
-                -- \UIState{aScreen=TS tss} -> error $ pshow $ _tssTransaction tss
+                -- \UIState{aScreen=TS tss} -> error' $ pshow $ _tssTransaction tss
 
             VtyEvent (EvKey (KChar 'I') []) -> put' $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
 

hledger-ui/Hledger/UI/UIScreens.hs

@@ -140,7 +140,7 @@ asUpdateHelper rspec0 d copts roptsModify extraquery j ass = dbgui "asUpdateHelp
       updateReportSpec
         ropts
         rspec0{_rsDay=d}  -- update to the current date, might have changed since program start
-      & either (error "asUpdateHelper: adjusting the query, should not have failed") id -- PARTIAL:
+      & either (error' "asUpdateHelper: adjusting the query, should not have failed") id -- PARTIAL:
       & reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts)  -- include/exclude future & forecast transactions
       & reportSpecAddQuery extraquery  -- add any extra restrictions
 
@@ -265,7 +265,7 @@ rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive, _rssList=oldlist} =
       }
     rspec' =
       updateReportSpec ropts' rspec{_rsDay=d}
-      & either (error "rsUpdate: adjusting the query for register, should not have failed") id -- PARTIAL:
+      & either (error' "rsUpdate: adjusting the query for register, should not have failed") id -- PARTIAL:
       & reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts)
 
     -- gather transactions to display

hledger-ui/Hledger/UI/UIState.hs

@@ -219,7 +219,7 @@ enableForecastPreservingPeriod ui copts = set forecast mforecast copts
 -- | Toggle between showing all and showing only real (non-virtual) items.
 toggleReal :: UIState -> UIState
 toggleReal = fromRight err . overEither real not  -- PARTIAL:
-  where err = error "toggleReal: updating Real should not result in an error"
+  where err = error' "toggleReal: updating Real should not result in an error"
 
 -- | Toggle the ignoring of balance assertions.
 toggleIgnoreBalanceAssertions :: UIState -> UIState
@@ -263,7 +263,7 @@ setReportPeriod p = updateReportPeriod (const p)
 -- | Update report period by a applying a function.
 updateReportPeriod :: (Period -> Period) -> UIState -> UIState
 updateReportPeriod updatePeriod = fromRight err . overEither period updatePeriod  -- PARTIAL:
-  where err = error "updateReportPeriod: updating period should not result in an error"
+  where err = error' "updateReportPeriod: updating period should not result in an error"
 
 -- | Apply a new filter query, or return the failing query.
 setFilter :: String -> UIState -> Either String UIState
@@ -318,7 +318,7 @@ getDepth = dsFlatDepth . (^.depth)
 updateReportDepth :: (DepthSpec -> DepthSpec) -> UIState -> UIState
 updateReportDepth updateDepth ui = over reportSpec update ui
   where
-    update = fromRight (error "updateReportDepth: updating depth should not result in an error")  -- PARTIAL:
+    update = fromRight (error' "updateReportDepth: updating depth should not result in an error")  -- PARTIAL:
            . updateReportSpecWith (\ropts -> ropts{depth_=clipDepth ropts $ updateDepth (depth_ ropts)})
     clipDepth _        (DepthSpec Nothing  _) = mempty
     clipDepth ropts ds@(DepthSpec (Just d) _) | d < 0            = depth_ ropts

hledger-web/Hledger/Web/Handler/RegisterR.hs

@@ -93,7 +93,7 @@ undecorateLinks xs0@(x:_) =
             let (link, xs1) = span (isJust . fst) xs0
                 (comma, xs2) = span (isNothing . fst) xs1
             in (acct, (map snd link, map snd comma)) : undecorateLinks xs2
-        _ -> error "link name not decorated with account"  -- PARTIAL:
+        _ -> error' "link name not decorated with account"  -- PARTIAL:
 
 decorateLinks :: [(acct, ([char], [char]))] -> [(Maybe acct, char)]
 decorateLinks = concatMap $ \(acct, (name, comma)) ->

hledger-web/Hledger/Web/Main.hs

@@ -161,7 +161,7 @@ web opts j = do
                   when (isSocket sockstat) $ removeFile s
               )
               (\sock -> Network.Wai.Handler.Warp.runSettingsSocket warpsettings sock app)
-            else error $ unlines
+            else error' $ unlines
               ["Unix domain sockets are not available on your operating system."
               ,"Please try again without --socket."
               ]

hledger-web/Hledger/Web/Test.hs

@@ -136,7 +136,7 @@ hledgerWebTest = do
     ,"    assets    10"
     ,"    income"
     ])
-  j <- fmap (either error id) . runExceptT $ journalFinalise iopts f "" pj  -- PARTIAL: journalFinalise should not fail
+  j <- fmap (either error' id) . runExceptT $ journalFinalise iopts f "" pj  -- PARTIAL: journalFinalise should not fail
   runTests "hledger-web with --forecast" rawopts j $ do
 
     yit "shows forecasted transactions" $ do

hledger/Hledger/Cli/Anchor.hs

@@ -17,6 +17,7 @@ import qualified Text.URI.QQ as UriQQ
 
 import qualified Hledger.Write.Spreadsheet as Spr
 import Hledger.Write.Spreadsheet (headerCell)
+import Hledger.Utils.IO (error')
 import Hledger.Utils.Text (quoteIfSpaced)
 import Hledger.Data.Dates (showDateSpan, showDate)
 import Hledger.Data.Types (DateSpan)
@@ -28,7 +29,7 @@ registerQueryUrl query =
     [UriQQ.uri|register|] {
         Uri.uriQuery =
             [Uri.QueryParam [UriQQ.queryKey|q|] $
-             fromMaybe (error "register URI query construction failed") $
+             fromMaybe (error' "register URI query construction failed") $
              Uri.mkQueryValue $ Text.unwords $
              map quoteIfSpaced $ filter (not . Text.null) query]
     }

hledger/Hledger/Cli/Commands/Activity.hs

@@ -44,6 +44,6 @@ showHistogram rspec@ReportSpec{_rsQuery=q} j =
     ps = sortOn postingDate $ filter (q `matchesPosting`) $ journalPostings j
 
 printDayWith f (DateSpan (Just b) _, ps) = printf "%s %s\n" (show $ fromEFDay b) (f ps)
-printDayWith _ _ = error "Expected start date for DateSpan"  -- PARTIAL:
+printDayWith _ _ = error' "Expected start date for DateSpan"  -- PARTIAL:
 
 countBar ps = replicate (length ps) barchar

hledger/Hledger/Cli/Commands/Add.hs

@@ -121,7 +121,7 @@ getAndAddTransactions es@EntryState{..} = (do
   let defaultPrevInput = PrevInput{prevDateAndCode=Nothing, prevDescAndCmnt=Nothing, prevAccount=[], prevAmountAndCmnt=[]}
   mt <- runInputT (setComplete noCompletion defaultSettings) (System.Console.Wizard.run $ haskeline $ confirmedTransactionWizard defaultPrevInput es [])
   case mt of
-    Nothing -> error "Could not interpret the input, restarting"  -- caught below causing a restart, I believe  -- PARTIAL:
+    Nothing -> error' "Could not interpret the input, restarting"  -- caught below causing a restart, I believe  -- PARTIAL:
     Just t -> do
       j <- if debug_ esOpts > 0
            then do hPutStrLn stderr "Skipping journal add due to debug mode."

hledger/Hledger/Cli/Commands/Roi.hs

@@ -96,8 +96,8 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO
 
   let (fullPeriod, spans) = reportSpan filteredj rspec
 
-  let processSpan (DateSpan Nothing _) = error "Undefined start of the period - will be unable to compute the rates of return"
-      processSpan (DateSpan _ Nothing) = error "Undefined end of the period - will be unable to compute the rates of return"
+  let processSpan (DateSpan Nothing _) = error' "Undefined start of the period - will be unable to compute the rates of return"
+      processSpan (DateSpan _ Nothing) = error' "Undefined end of the period - will be unable to compute the rates of return"
       processSpan spn@(DateSpan (Just begin) (Just end)) = do
         -- Spans are [begin,end), and end is 1 day after the actual end date we are interested in
         let