Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
4e78c8a0
Commit
4e78c8a0
authored
Jun 12, 2012
by
Ian Lynagh
Browse files
GhcApiError now contains a String, not an SDoc
parent
af9f0170
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/main/GHC.hs
View file @
4e78c8a0
...
...
@@ -719,9 +719,11 @@ getModSummary :: GhcMonad m => ModuleName -> m ModSummary
getModSummary
mod
=
do
mg
<-
liftM
hsc_mod_graph
getSession
case
[
ms
|
ms
<-
mg
,
ms_mod_name
ms
==
mod
,
not
(
isBootSummary
ms
)
]
of
[]
->
throw
$
mkApiErr
(
text
"Module not part of module graph"
)
[]
->
do
dflags
<-
getDynFlags
throw
$
mkApiErr
dflags
(
text
"Module not part of module graph"
)
[
ms
]
->
return
ms
multiple
->
throw
$
mkApiErr
(
text
"getModSummary is ambiguous: "
<+>
ppr
multiple
)
multiple
->
do
dflags
<-
getDynFlags
throw
$
mkApiErr
dflags
(
text
"getModSummary is ambiguous: "
<+>
ppr
multiple
)
-- | Parse a module.
--
...
...
@@ -1182,7 +1184,8 @@ getModuleSourceAndFlags :: GhcMonad m => Module -> m (String, StringBuffer, DynF
getModuleSourceAndFlags
mod
=
do
m
<-
getModSummary
(
moduleName
mod
)
case
ml_hs_file
$
ms_location
m
of
Nothing
->
throw
$
mkApiErr
(
text
"No source available for module "
<+>
ppr
mod
)
Nothing
->
do
dflags
<-
getDynFlags
throw
$
mkApiErr
dflags
(
text
"No source available for module "
<+>
ppr
mod
)
Just
sourceFile
->
do
source
<-
liftIO
$
hGetStringBuffer
sourceFile
return
(
sourceFile
,
source
,
ms_hspp_opts
m
)
...
...
compiler/main/HscTypes.lhs
View file @
4e78c8a0
...
...
@@ -181,8 +181,8 @@ mkSrcErr = SourceError
srcErrorMessages :: SourceError -> ErrorMessages
srcErrorMessages (SourceError msgs) = msgs
mkApiErr :: SDoc -> GhcApiError
mkApiErr = GhcApiError
mkApiErr ::
DynFlags ->
SDoc -> GhcApiError
mkApiErr
_ msg
= GhcApiError
(showSDoc msg)
throwOneError :: MonadIO m => ErrMsg -> m ab
throwOneError err = liftIO $ throwIO $ mkSrcErr $ unitBag err
...
...
@@ -221,11 +221,11 @@ handleSourceError handler act =
gcatch act (\(e :: SourceError) -> handler e)
-- | An error thrown if the GHC API is used in an incorrect fashion.
newtype GhcApiError = GhcApiError S
Doc
newtype GhcApiError = GhcApiError S
tring
deriving Typeable
instance Show GhcApiError where
show (GhcApiError msg) =
showSDoc
msg
show (GhcApiError msg) = msg
instance Exception GhcApiError
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment