Commit 8d5bc740 authored by ian@well-typed.com's avatar ian@well-typed.com

Add throwGhcExceptionIO and change a few uses of throwGhcException to use it

parent 43cc231a
......@@ -230,14 +230,14 @@ readPackageConfig dflags conf_file = do
else do
isfile <- doesFileExist conf_file
when (not isfile) $
throwGhcException $ InstallationError $
throwGhcExceptionIO $ InstallationError $
"can't find a package database at " ++ conf_file
debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file)
str <- readFile conf_file
case reads str of
[(configs, rest)]
| all isSpace rest -> return (map installedPackageInfoToPackageConfig configs)
_ -> throwGhcException $ InstallationError $
_ -> throwGhcExceptionIO $ InstallationError $
"invalid package database file " ++ conf_file
let
......@@ -410,12 +410,13 @@ packageFlagErr :: DynFlags
-- for missing DPH package we emit a more helpful error message, because
-- this may be the result of using -fdph-par or -fdph-seq.
packageFlagErr dflags (ExposePackage pkg) [] | is_dph_package pkg
= throwGhcException (CmdLineError (showSDoc dflags $ dph_err))
= throwGhcExceptionIO (CmdLineError (showSDoc dflags $ dph_err))
where dph_err = text "the " <> text pkg <> text " package is not installed."
$$ text "To install it: \"cabal install dph\"."
is_dph_package pkg = "dph" `isPrefixOf` pkg
packageFlagErr dflags flag reasons = throwGhcException (CmdLineError (showSDoc dflags $ err))
packageFlagErr dflags flag reasons
= throwGhcExceptionIO (CmdLineError (showSDoc dflags $ err))
where err = text "cannot satisfy " <> ppr_flag <>
(if null reasons then empty else text ": ") $$
nest 4 (ppr_reasons $$
......@@ -983,7 +984,7 @@ closeDeps dflags pkg_map ipid_map ps
throwErr :: DynFlags -> MaybeErr MsgDoc a -> IO a
throwErr dflags m
= case m of
Failed e -> throwGhcException (CmdLineError (showSDoc dflags e))
Failed e -> throwGhcExceptionIO (CmdLineError (showSDoc dflags e))
Succeeded r -> return r
closeDepsErr :: PackageConfigMap
......@@ -1017,7 +1018,7 @@ add_package pkg_db ipid_map ps (p, mb_parent)
missingPackageErr :: DynFlags -> String -> IO a
missingPackageErr dflags p
= throwGhcException (CmdLineError (showSDoc dflags (missingPackageMsg p)))
= throwGhcExceptionIO (CmdLineError (showSDoc dflags (missingPackageMsg p)))
missingPackageMsg :: String -> SDoc
missingPackageMsg p = ptext (sLit "unknown package:") <+> text p
......
......@@ -9,7 +9,9 @@ some unnecessary loops in the module dependency graph.
\begin{code}
module Panic (
GhcException(..), showGhcException, throwGhcException, handleGhcException,
GhcException(..), showGhcException,
throwGhcException, throwGhcExceptionIO,
handleGhcException,
progName,
pgmError,
......@@ -176,6 +178,9 @@ showGhcException exception
throwGhcException :: GhcException -> a
throwGhcException = Exception.throw
throwGhcExceptionIO :: GhcException -> IO a
throwGhcExceptionIO = Exception.throwIO
handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a
handleGhcException = ghandle
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment