slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Simon Michael 2025-06-03 09:08:25 -10:00
parent 0799f19271
commit 2a4718d40a
18 changed files with 29 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
hledger-lib/Hledger/Data/Amount.hs
View File

@ -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

2
hledger-lib/Hledger/Data/Dates.hs
View File

@ -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]

5
hledger-lib/Hledger/Data/Json.hs
View File

@ -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

2
hledger-lib/Hledger/Query.hs
View File

@ -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

2
hledger-lib/Hledger/Reports/PostingsReport.hs
View File

@ -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

4
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -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,

2
hledger-lib/Hledger/Utils/String.hs
View File

@ -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

2
hledger-ui/Hledger/UI/ErrorScreen.hs
View File

@ -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

2
hledger-ui/Hledger/UI/TransactionScreen.hs
View File

@ -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)

4
hledger-ui/Hledger/UI/UIScreens.hs
View File

@ -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

6
hledger-ui/Hledger/UI/UIState.hs
View File

@ -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

2
hledger-web/Hledger/Web/Handler/RegisterR.hs
View File

@ -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)) ->

2
hledger-web/Hledger/Web/Main.hs
View File

@ -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."
]

2
hledger-web/Hledger/Web/Test.hs
View File

@ -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

3
hledger/Hledger/Cli/Anchor.hs
View File

@ -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]
}

2
hledger/Hledger/Cli/Commands/Activity.hs
View File

@ -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

2
hledger/Hledger/Cli/Commands/Add.hs
View File

@ -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."

4
hledger/Hledger/Cli/Commands/Roi.hs
View File

@ -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