import Pretty ()
import Maybes
import Bag ( emptyBag, listToBag, unitBag )
-
-import MonadUtils ( MonadIO )
+import MonadUtils
import Exception
+
import Control.Monad
import System.IO
import System.IO.Unsafe
-- | Parse the imports of a source file.
--
-- Throws a 'SourceError' if parsing fails.
-getImports :: GhcMonad m =>
- DynFlags
+getImports :: DynFlags
-> StringBuffer -- ^ Parse this.
-> FilePath -- ^ Filename the buffer came from. Used for
-- reporting parse error locations.
-> FilePath -- ^ The original source filename (used for locations
-- in the function result)
- -> m ([Located (ImportDecl RdrName)], [Located (ImportDecl RdrName)], Located ModuleName)
+ -> IO ([Located (ImportDecl RdrName)], [Located (ImportDecl RdrName)], Located ModuleName)
-- ^ The source imports, normal imports, and the module name.
getImports dflags buf filename source_filename = do
let loc = mkSrcLoc (mkFastString filename) 1 1
ms = (emptyBag, errs)
-- logWarnings warns
if errorsFound dflags ms
- then liftIO $ throwIO $ mkSrcErr errs
+ then throwIO $ mkSrcErr errs
else
case rdr_module of
L _ (HsModule mb_mod _ imps _ _ _) ->
ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc . ideclName . unLoc)
ord_idecls
- implicit_prelude = dopt Opt_ImplicitPrelude dflags
+ implicit_prelude = xopt Opt_ImplicitPrelude dflags
implicit_imports = mkPrelImports (unLoc mod) implicit_prelude imps
in
return (src_idecls, implicit_imports ++ ordinary_imps, mod)
loc = mkGeneralSrcSpan (fsLit "Implicit import declaration")
-parseError :: GhcMonad m => SrcSpan -> Message -> m a
+parseError :: SrcSpan -> Message -> IO a
parseError span err = throwOneError $ mkPlainErrMsg span err
--------------------------------------------------------------
liftIO $ throwIO $ mkSrcErr $ listToBag $ map mkMsg flags
where mkMsg (L loc flag)
= mkPlainErrMsg loc $
- (text "unknown flag in {-# OPTIONS #-} pragma:" <+>
+ (text "unknown flag in {-# OPTIONS_GHC #-} pragma:" <+>
text flag)
-----------------------------------------------------------------------------
-- Checks if a given extension is valid, and if so returns
-- its corresponding flag. Otherwise it throws an exception.
= let ext' = unpackFS ext in
- if ext' `elem` supportedExtensions
+ if ext' `elem` supportedLanguagesAndExtensions
then L l ("-X"++ext')
else unsupportedExtnError l ext'
mkPlainErrMsg loc $
text "Unsupported extension: " <> text unsup $$
if null suggestions then empty else text "Perhaps you meant" <+> quotedListWithOr (map text suggestions)
- where suggestions = fuzzyMatch unsup supportedExtensions
+ where
+ suggestions = fuzzyMatch unsup supportedLanguagesAndExtensions
optionsErrorMsgs :: [String] -> [Located String] -> FilePath -> Messages
L l f' <- flags_lines, f == f' ]
mkMsg (L flagSpan flag) =
ErrUtils.mkPlainErrMsg flagSpan $
- text "unknown flag in {-# OPTIONS #-} pragma:" <+> text flag
+ text "unknown flag in {-# OPTIONS_GHC #-} pragma:" <+> text flag