{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}

-----------------------------------------------------------------------------
--
-- | Parsing the top of a Haskell source file to get its module name,
-- imports and options.
--
-- (c) Simon Marlow 2005
-- (c) Lemmih 2006
--
-----------------------------------------------------------------------------

module HeaderInfo ( getImports
                  , mkPrelImports -- used by the renamer too
                  , getOptionsFromFile, getOptions
                  , optionsErrorMsgs,
                    checkProcessArgsResult ) where

#include "HsVersions.h"

import GhcPrelude

import GHC.Platform
import HscTypes
import Parser           ( parseHeader )
import Lexer
import FastString
import GHC.Hs
import Module
import PrelNames
import StringBuffer
import SrcLoc
import DynFlags
import ErrUtils
import Util
import Outputable
import Maybes
import Bag              ( emptyBag, listToBag, unitBag )
import MonadUtils
import Exception
import BasicTypes
import qualified GHC.LanguageExtensions as LangExt

import Control.Monad
import System.IO
import System.IO.Unsafe
import Data.List

------------------------------------------------------------------------------

-- | Parse the imports of a source file.
--
-- Throws a 'SourceError' if parsing fails.
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)
           -> IO (Either
               ErrorMessages
               ([(Maybe FastString, Located ModuleName)],
                [(Maybe FastString, Located ModuleName)],
                Located ModuleName))
              -- ^ The source imports, normal imports, and the module name.
getImports :: DynFlags
-> StringBuffer
-> FilePath
-> FilePath
-> IO
     (Either
        ErrorMessages
        ([(Maybe FastString, Located ModuleName)],
         [(Maybe FastString, Located ModuleName)], Located ModuleName))
getImports DynFlags
dflags StringBuffer
buf FilePath
filename FilePath
source_filename = do
  let loc :: RealSrcLoc
loc  = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (FilePath -> FastString
mkFastString FilePath
filename) Int
1 Int
1
  case P (Located (HsModule GhcPs))
-> PState -> ParseResult (Located (HsModule GhcPs))
forall a. P a -> PState -> ParseResult a
unP P (Located (HsModule GhcPs))
parseHeader (DynFlags -> StringBuffer -> RealSrcLoc -> PState
mkPState DynFlags
dflags StringBuffer
buf RealSrcLoc
loc) of
    PFailed PState
pst ->
        -- assuming we're not logging warnings here as per below
      Either
  ErrorMessages
  ([(Maybe FastString, Located ModuleName)],
   [(Maybe FastString, Located ModuleName)], Located ModuleName)
-> IO
     (Either
        ErrorMessages
        ([(Maybe FastString, Located ModuleName)],
         [(Maybe FastString, Located ModuleName)], Located ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   ErrorMessages
   ([(Maybe FastString, Located ModuleName)],
    [(Maybe FastString, Located ModuleName)], Located ModuleName)
 -> IO
      (Either
         ErrorMessages
         ([(Maybe FastString, Located ModuleName)],
          [(Maybe FastString, Located ModuleName)], Located ModuleName)))
-> Either
     ErrorMessages
     ([(Maybe FastString, Located ModuleName)],
      [(Maybe FastString, Located ModuleName)], Located ModuleName)
-> IO
     (Either
        ErrorMessages
        ([(Maybe FastString, Located ModuleName)],
         [(Maybe FastString, Located ModuleName)], Located ModuleName))
forall a b. (a -> b) -> a -> b
$ ErrorMessages
-> Either
     ErrorMessages
     ([(Maybe FastString, Located ModuleName)],
      [(Maybe FastString, Located ModuleName)], Located ModuleName)
forall a b. a -> Either a b
Left (ErrorMessages
 -> Either
      ErrorMessages
      ([(Maybe FastString, Located ModuleName)],
       [(Maybe FastString, Located ModuleName)], Located ModuleName))
-> ErrorMessages
-> Either
     ErrorMessages
     ([(Maybe FastString, Located ModuleName)],
      [(Maybe FastString, Located ModuleName)], Located ModuleName)
forall a b. (a -> b) -> a -> b
$ PState -> DynFlags -> ErrorMessages
getErrorMessages PState
pst DynFlags
dflags
    POk PState
pst Located (HsModule GhcPs)
rdr_module -> (([(Maybe FastString, Located ModuleName)],
  [(Maybe FastString, Located ModuleName)], Located ModuleName)
 -> Either
      ErrorMessages
      ([(Maybe FastString, Located ModuleName)],
       [(Maybe FastString, Located ModuleName)], Located ModuleName))
-> IO
     ([(Maybe FastString, Located ModuleName)],
      [(Maybe FastString, Located ModuleName)], Located ModuleName)
-> IO
     (Either
        ErrorMessages
        ([(Maybe FastString, Located ModuleName)],
         [(Maybe FastString, Located ModuleName)], Located ModuleName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Maybe FastString, Located ModuleName)],
 [(Maybe FastString, Located ModuleName)], Located ModuleName)
-> Either
     ErrorMessages
     ([(Maybe FastString, Located ModuleName)],
      [(Maybe FastString, Located ModuleName)], Located ModuleName)
forall a b. b -> Either a b
Right (IO
   ([(Maybe FastString, Located ModuleName)],
    [(Maybe FastString, Located ModuleName)], Located ModuleName)
 -> IO
      (Either
         ErrorMessages
         ([(Maybe FastString, Located ModuleName)],
          [(Maybe FastString, Located ModuleName)], Located ModuleName)))
-> IO
     ([(Maybe FastString, Located ModuleName)],
      [(Maybe FastString, Located ModuleName)], Located ModuleName)
-> IO
     (Either
        ErrorMessages
        ([(Maybe FastString, Located ModuleName)],
         [(Maybe FastString, Located ModuleName)], Located ModuleName))
forall a b. (a -> b) -> a -> b
$ do
      let _ms :: (ErrorMessages, ErrorMessages)
_ms@(ErrorMessages
_warns, ErrorMessages
errs) = PState -> DynFlags -> (ErrorMessages, ErrorMessages)
getMessages PState
pst DynFlags
dflags
      -- don't log warnings: they'll be reported when we parse the file
      -- for real.  See #2500.
          ms :: (ErrorMessages, ErrorMessages)
ms = (ErrorMessages
forall a. Bag a
emptyBag, ErrorMessages
errs)
      -- logWarnings warns
      if DynFlags -> (ErrorMessages, ErrorMessages) -> Bool
errorsFound DynFlags
dflags (ErrorMessages, ErrorMessages)
ms
        then SourceError
-> IO
     ([(Maybe FastString, Located ModuleName)],
      [(Maybe FastString, Located ModuleName)], Located ModuleName)
forall e a. Exception e => e -> IO a
throwIO (SourceError
 -> IO
      ([(Maybe FastString, Located ModuleName)],
       [(Maybe FastString, Located ModuleName)], Located ModuleName))
-> SourceError
-> IO
     ([(Maybe FastString, Located ModuleName)],
      [(Maybe FastString, Located ModuleName)], Located ModuleName)
forall a b. (a -> b) -> a -> b
$ ErrorMessages -> SourceError
mkSrcErr ErrorMessages
errs
        else
          let   hsmod :: SrcSpanLess (Located (HsModule GhcPs))
hsmod = Located (HsModule GhcPs) -> SrcSpanLess (Located (HsModule GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (HsModule GhcPs)
rdr_module
                mb_mod :: Maybe (Located ModuleName)
mb_mod = HsModule GhcPs -> Maybe (Located ModuleName)
forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodName SrcSpanLess (Located (HsModule GhcPs))
HsModule GhcPs
hsmod
                imps :: [LImportDecl GhcPs]
imps = HsModule GhcPs -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports SrcSpanLess (Located (HsModule GhcPs))
HsModule GhcPs
hsmod
                main_loc :: SrcSpan
main_loc = SrcLoc -> SrcSpan
srcLocSpan (FastString -> Int -> Int -> SrcLoc
mkSrcLoc (FilePath -> FastString
mkFastString FilePath
source_filename)
                                       Int
1 Int
1)
                mod :: Located ModuleName
mod = Maybe (Located ModuleName)
mb_mod Maybe (Located ModuleName)
-> Located ModuleName -> Located ModuleName
forall a. Maybe a -> a -> a
`orElse` SrcSpan -> SrcSpanLess (Located ModuleName) -> Located ModuleName
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
main_loc ModuleName
SrcSpanLess (Located ModuleName)
mAIN_NAME
                ([LImportDecl GhcPs]
src_idecls, [LImportDecl GhcPs]
ord_idecls) = (LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs]
-> ([LImportDecl GhcPs], [LImportDecl GhcPs])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
ideclSource(ImportDecl GhcPs -> Bool)
-> (LImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LImportDecl GhcPs -> ImportDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LImportDecl GhcPs]
imps

               -- GHC.Prim doesn't exist physically, so don't go looking for it.
                ordinary_imps :: [LImportDecl GhcPs]
ordinary_imps = (LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= Module -> ModuleName
moduleName Module
gHC_PRIM) (ModuleName -> Bool)
-> (LImportDecl GhcPs -> ModuleName) -> LImportDecl GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc
                                        (Located ModuleName -> ModuleName)
-> (LImportDecl GhcPs -> Located ModuleName)
-> LImportDecl GhcPs
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName (ImportDecl GhcPs -> Located ModuleName)
-> (LImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs
-> Located ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcPs -> ImportDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
                                       [LImportDecl GhcPs]
ord_idecls

                implicit_prelude :: Bool
implicit_prelude = Extension -> DynFlags -> Bool
xopt Extension
LangExt.ImplicitPrelude DynFlags
dflags
                implicit_imports :: [LImportDecl GhcPs]
implicit_imports = ModuleName
-> SrcSpan -> Bool -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
mkPrelImports (Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
mod) SrcSpan
main_loc
                                                 Bool
implicit_prelude [LImportDecl GhcPs]
imps
                convImport :: a -> (Maybe FastString, Located ModuleName)
convImport (a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess a
i) = ((StringLiteral -> FastString)
-> Maybe StringLiteral -> Maybe FastString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringLiteral -> FastString
sl_fs (ImportDecl pass -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual SrcSpanLess a
ImportDecl pass
i)
                                         , ImportDecl pass -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName SrcSpanLess a
ImportDecl pass
i)
              in
              ([(Maybe FastString, Located ModuleName)],
 [(Maybe FastString, Located ModuleName)], Located ModuleName)
-> IO
     ([(Maybe FastString, Located ModuleName)],
      [(Maybe FastString, Located ModuleName)], Located ModuleName)
forall (m :: * -> *) a. Monad m => a -> m a
return ((LImportDecl GhcPs -> (Maybe FastString, Located ModuleName))
-> [LImportDecl GhcPs] -> [(Maybe FastString, Located ModuleName)]
forall a b. (a -> b) -> [a] -> [b]
map LImportDecl GhcPs -> (Maybe FastString, Located ModuleName)
forall a pass.
(HasSrcSpan a, SrcSpanLess a ~ ImportDecl pass) =>
a -> (Maybe FastString, Located ModuleName)
convImport [LImportDecl GhcPs]
src_idecls,
                      (LImportDecl GhcPs -> (Maybe FastString, Located ModuleName))
-> [LImportDecl GhcPs] -> [(Maybe FastString, Located ModuleName)]
forall a b. (a -> b) -> [a] -> [b]
map LImportDecl GhcPs -> (Maybe FastString, Located ModuleName)
forall a pass.
(HasSrcSpan a, SrcSpanLess a ~ ImportDecl pass) =>
a -> (Maybe FastString, Located ModuleName)
convImport ([LImportDecl GhcPs]
implicit_imports [LImportDecl GhcPs] -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a. [a] -> [a] -> [a]
++ [LImportDecl GhcPs]
ordinary_imps),
                      Located ModuleName
mod)

mkPrelImports :: ModuleName
              -> SrcSpan    -- Attribute the "import Prelude" to this location
              -> Bool -> [LImportDecl GhcPs]
              -> [LImportDecl GhcPs]
-- Construct the implicit declaration "import Prelude" (or not)
--
-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
-- because the former doesn't even look at Prelude.hi for instance
-- declarations, whereas the latter does.
mkPrelImports :: ModuleName
-> SrcSpan -> Bool -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
mkPrelImports ModuleName
this_mod SrcSpan
loc Bool
implicit_prelude [LImportDecl GhcPs]
import_decls
  | ModuleName
this_mod ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
pRELUDE_NAME
   Bool -> Bool -> Bool
|| Bool
explicit_prelude_import
   Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
implicit_prelude
  = []
  | Bool
otherwise = [LImportDecl GhcPs
preludeImportDecl]
  where
      explicit_prelude_import :: Bool
explicit_prelude_import
       = [()] -> Bool
forall a. [a] -> Bool
notNull [ () | (LImportDecl GhcPs -> Located (SrcSpanLess (LImportDecl GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (ImportDecl { ideclName = mod
                                        , ideclPkgQual = Nothing }))
                          <- [LImportDecl GhcPs]
import_decls
                      , Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
mod ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
pRELUDE_NAME ]

      preludeImportDecl :: LImportDecl GhcPs
      preludeImportDecl :: LImportDecl GhcPs
preludeImportDecl
        = SrcSpan -> SrcSpanLess (LImportDecl GhcPs) -> LImportDecl GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (SrcSpanLess (LImportDecl GhcPs) -> LImportDecl GhcPs)
-> SrcSpanLess (LImportDecl GhcPs) -> LImportDecl GhcPs
forall a b. (a -> b) -> a -> b
$ ImportDecl :: forall pass.
XCImportDecl pass
-> SourceText
-> Located ModuleName
-> Maybe StringLiteral
-> Bool
-> Bool
-> ImportDeclQualifiedStyle
-> Bool
-> Maybe (Located ModuleName)
-> Maybe (Bool, Located [LIE pass])
-> ImportDecl pass
ImportDecl { ideclExt :: XCImportDecl GhcPs
ideclExt       = XCImportDecl GhcPs
NoExtField
noExtField,
                                ideclSourceSrc :: SourceText
ideclSourceSrc = SourceText
NoSourceText,
                                ideclName :: Located ModuleName
ideclName      = SrcSpan -> SrcSpanLess (Located ModuleName) -> Located ModuleName
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc ModuleName
SrcSpanLess (Located ModuleName)
pRELUDE_NAME,
                                ideclPkgQual :: Maybe StringLiteral
ideclPkgQual   = Maybe StringLiteral
forall a. Maybe a
Nothing,
                                ideclSource :: Bool
ideclSource    = Bool
False,
                                ideclSafe :: Bool
ideclSafe      = Bool
False,  -- Not a safe import
                                ideclQualified :: ImportDeclQualifiedStyle
ideclQualified = ImportDeclQualifiedStyle
NotQualified,
                                ideclImplicit :: Bool
ideclImplicit  = Bool
True,   -- Implicit!
                                ideclAs :: Maybe (Located ModuleName)
ideclAs        = Maybe (Located ModuleName)
forall a. Maybe a
Nothing,
                                ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding    = Maybe (Bool, Located [LIE GhcPs])
forall a. Maybe a
Nothing  }

--------------------------------------------------------------
-- Get options
--------------------------------------------------------------

-- | Parse OPTIONS and LANGUAGE pragmas of the source file.
--
-- Throws a 'SourceError' if flag parsing fails (including unsupported flags.)
getOptionsFromFile :: DynFlags
                   -> FilePath            -- ^ Input file
                   -> IO [Located String] -- ^ Parsed options, if any.
getOptionsFromFile :: DynFlags -> FilePath -> IO [Located FilePath]
getOptionsFromFile DynFlags
dflags FilePath
filename
    = IO Handle
-> (Handle -> IO ())
-> (Handle -> IO [Located FilePath])
-> IO [Located FilePath]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket
              (FilePath -> IOMode -> IO Handle
openBinaryFile FilePath
filename IOMode
ReadMode)
              (Handle -> IO ()
hClose)
              (\Handle
handle -> do
                  [Located FilePath]
opts <- ([Located Token] -> [Located FilePath])
-> IO [Located Token] -> IO [Located FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DynFlags -> [Located Token] -> [Located FilePath]
getOptions' DynFlags
dflags)
                               (DynFlags -> FilePath -> Handle -> IO [Located Token]
lazyGetToks DynFlags
dflags' FilePath
filename Handle
handle)
                  [Located FilePath]
-> IO [Located FilePath] -> IO [Located FilePath]
forall a b. [a] -> b -> b
seqList [Located FilePath]
opts (IO [Located FilePath] -> IO [Located FilePath])
-> IO [Located FilePath] -> IO [Located FilePath]
forall a b. (a -> b) -> a -> b
$ [Located FilePath] -> IO [Located FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [Located FilePath]
opts)
    where -- We don't need to get haddock doc tokens when we're just
          -- getting the options from pragmas, and lazily lexing them
          -- correctly is a little tricky: If there is "\n" or "\n-"
          -- left at the end of a buffer then the haddock doc may
          -- continue past the end of the buffer, despite the fact that
          -- we already have an apparently-complete token.
          -- We therefore just turn Opt_Haddock off when doing the lazy
          -- lex.
          dflags' :: DynFlags
dflags' = DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
dflags GeneralFlag
Opt_Haddock

blockSize :: Int
-- blockSize = 17 -- for testing :-)
blockSize :: Int
blockSize = Int
1024

lazyGetToks :: DynFlags -> FilePath -> Handle -> IO [Located Token]
lazyGetToks :: DynFlags -> FilePath -> Handle -> IO [Located Token]
lazyGetToks DynFlags
dflags FilePath
filename Handle
handle = do
  StringBuffer
buf <- Handle -> Int -> IO StringBuffer
hGetStringBufferBlock Handle
handle Int
blockSize
  IO [Located Token] -> IO [Located Token]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [Located Token] -> IO [Located Token])
-> IO [Located Token] -> IO [Located Token]
forall a b. (a -> b) -> a -> b
$ Handle -> PState -> Bool -> Int -> IO [Located Token]
lazyLexBuf Handle
handle (DynFlags -> StringBuffer -> RealSrcLoc -> PState
pragState DynFlags
dflags StringBuffer
buf RealSrcLoc
loc) Bool
False Int
blockSize
 where
  loc :: RealSrcLoc
loc  = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (FilePath -> FastString
mkFastString FilePath
filename) Int
1 Int
1

  lazyLexBuf :: Handle -> PState -> Bool -> Int -> IO [Located Token]
  lazyLexBuf :: Handle -> PState -> Bool -> Int -> IO [Located Token]
lazyLexBuf Handle
handle PState
state Bool
eof Int
size = do
    case P (Located Token) -> PState -> ParseResult (Located Token)
forall a. P a -> PState -> ParseResult a
unP (Bool -> (Located Token -> P (Located Token)) -> P (Located Token)
forall a. Bool -> (Located Token -> P a) -> P a
lexer Bool
False Located Token -> P (Located Token)
forall (m :: * -> *) a. Monad m => a -> m a
return) PState
state of
      POk PState
state' Located Token
t -> do
        -- pprTrace "lazyLexBuf" (text (show (buffer state'))) (return ())
        if StringBuffer -> Bool
atEnd (PState -> StringBuffer
buffer PState
state') Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
eof
           -- if this token reached the end of the buffer, and we haven't
           -- necessarily read up to the end of the file, then the token might
           -- be truncated, so read some more of the file and lex it again.
           then Handle -> PState -> Int -> IO [Located Token]
getMore Handle
handle PState
state Int
size
           else case Located Token -> SrcSpanLess (Located Token)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Token
t of
                  SrcSpanLess (Located Token)
ITeof  -> [Located Token] -> IO [Located Token]
forall (m :: * -> *) a. Monad m => a -> m a
return [Located Token
t]
                  SrcSpanLess (Located Token)
_other -> do [Located Token]
rest <- Handle -> PState -> Bool -> Int -> IO [Located Token]
lazyLexBuf Handle
handle PState
state' Bool
eof Int
size
                               [Located Token] -> IO [Located Token]
forall (m :: * -> *) a. Monad m => a -> m a
return (Located Token
t Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: [Located Token]
rest)
      ParseResult (Located Token)
_ | Bool -> Bool
not Bool
eof   -> Handle -> PState -> Int -> IO [Located Token]
getMore Handle
handle PState
state Int
size
        | Bool
otherwise -> [Located Token] -> IO [Located Token]
forall (m :: * -> *) a. Monad m => a -> m a
return [SrcSpan -> SrcSpanLess (Located Token) -> Located Token
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL (RealSrcSpan -> SrcSpan
RealSrcSpan (PState -> RealSrcSpan
last_loc PState
state)) SrcSpanLess (Located Token)
Token
ITeof]
                         -- parser assumes an ITeof sentinel at the end

  getMore :: Handle -> PState -> Int -> IO [Located Token]
  getMore :: Handle -> PState -> Int -> IO [Located Token]
getMore Handle
handle PState
state Int
size = do
     -- pprTrace "getMore" (text (show (buffer state))) (return ())
     let new_size :: Int
new_size = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
       -- double the buffer size each time we read a new block.  This
       -- counteracts the quadratic slowdown we otherwise get for very
       -- large module names (#5981)
     StringBuffer
nextbuf <- Handle -> Int -> IO StringBuffer
hGetStringBufferBlock Handle
handle Int
new_size
     if (StringBuffer -> Int
len StringBuffer
nextbuf Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) then Handle -> PState -> Bool -> Int -> IO [Located Token]
lazyLexBuf Handle
handle PState
state Bool
True Int
new_size else do
       StringBuffer
newbuf <- StringBuffer -> StringBuffer -> IO StringBuffer
appendStringBuffers (PState -> StringBuffer
buffer PState
state) StringBuffer
nextbuf
       IO [Located Token] -> IO [Located Token]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [Located Token] -> IO [Located Token])
-> IO [Located Token] -> IO [Located Token]
forall a b. (a -> b) -> a -> b
$ Handle -> PState -> Bool -> Int -> IO [Located Token]
lazyLexBuf Handle
handle PState
state{buffer :: StringBuffer
buffer=StringBuffer
newbuf} Bool
False Int
new_size


getToks :: DynFlags -> FilePath -> StringBuffer -> [Located Token]
getToks :: DynFlags -> FilePath -> StringBuffer -> [Located Token]
getToks DynFlags
dflags FilePath
filename StringBuffer
buf = PState -> [Located Token]
lexAll (DynFlags -> StringBuffer -> RealSrcLoc -> PState
pragState DynFlags
dflags StringBuffer
buf RealSrcLoc
loc)
 where
  loc :: RealSrcLoc
loc  = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (FilePath -> FastString
mkFastString FilePath
filename) Int
1 Int
1

  lexAll :: PState -> [Located Token]
lexAll PState
state = case P (Located Token) -> PState -> ParseResult (Located Token)
forall a. P a -> PState -> ParseResult a
unP (Bool -> (Located Token -> P (Located Token)) -> P (Located Token)
forall a. Bool -> (Located Token -> P a) -> P a
lexer Bool
False Located Token -> P (Located Token)
forall (m :: * -> *) a. Monad m => a -> m a
return) PState
state of
                   POk PState
_      t :: Located Token
t@(Located Token -> Located (SrcSpanLess (Located Token))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located Token)
ITeof) -> [Located Token
t]
                   POk PState
state' Located Token
t -> Located Token
t Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: PState -> [Located Token]
lexAll PState
state'
                   ParseResult (Located Token)
_ -> [SrcSpan -> SrcSpanLess (Located Token) -> Located Token
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL (RealSrcSpan -> SrcSpan
RealSrcSpan (PState -> RealSrcSpan
last_loc PState
state)) SrcSpanLess (Located Token)
Token
ITeof]


-- | Parse OPTIONS and LANGUAGE pragmas of the source file.
--
-- Throws a 'SourceError' if flag parsing fails (including unsupported flags.)
getOptions :: DynFlags
           -> StringBuffer -- ^ Input Buffer
           -> FilePath     -- ^ Source filename.  Used for location info.
           -> [Located String] -- ^ Parsed options.
getOptions :: DynFlags -> StringBuffer -> FilePath -> [Located FilePath]
getOptions DynFlags
dflags StringBuffer
buf FilePath
filename
    = DynFlags -> [Located Token] -> [Located FilePath]
getOptions' DynFlags
dflags (DynFlags -> FilePath -> StringBuffer -> [Located Token]
getToks DynFlags
dflags FilePath
filename StringBuffer
buf)

-- The token parser is written manually because Happy can't
-- return a partial result when it encounters a lexer error.
-- We want to extract options before the buffer is passed through
-- CPP, so we can't use the same trick as 'getImports'.
getOptions' :: DynFlags
            -> [Located Token]      -- Input buffer
            -> [Located String]     -- Options.
getOptions' :: DynFlags -> [Located Token] -> [Located FilePath]
getOptions' DynFlags
dflags [Located Token]
toks
    = [Located Token] -> [Located FilePath]
parseToks [Located Token]
toks
    where
          parseToks :: [Located Token] -> [Located FilePath]
parseToks (Located Token
open:Located Token
close:[Located Token]
xs)
              | IToptions_prag str <- Located Token -> SrcSpanLess (Located Token)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Token
open
              , SrcSpanLess (Located Token)
ITclose_prag       <- Located Token -> SrcSpanLess (Located Token)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Token
close
              = case FilePath -> Either FilePath [FilePath]
toArgs FilePath
str of
                  Left FilePath
_err -> FilePath -> DynFlags -> SrcSpan -> [Located FilePath]
forall a. FilePath -> DynFlags -> SrcSpan -> a
optionsParseError FilePath
str DynFlags
dflags (SrcSpan -> [Located FilePath]) -> SrcSpan -> [Located FilePath]
forall a b. (a -> b) -> a -> b
$   -- #15053
                                 SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (Located Token -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located Token
open) (Located Token -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located Token
close)
                  Right [FilePath]
args -> (FilePath -> Located FilePath) -> [FilePath] -> [Located FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> SrcSpanLess (Located FilePath) -> Located FilePath
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL (Located Token -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located Token
open)) [FilePath]
args [Located FilePath] -> [Located FilePath] -> [Located FilePath]
forall a. [a] -> [a] -> [a]
++ [Located Token] -> [Located FilePath]
parseToks [Located Token]
xs
          parseToks (Located Token
open:Located Token
close:[Located Token]
xs)
              | ITinclude_prag str <- Located Token -> SrcSpanLess (Located Token)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Token
open
              , SrcSpanLess (Located Token)
ITclose_prag       <- Located Token -> SrcSpanLess (Located Token)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Token
close
              = (FilePath -> Located FilePath) -> [FilePath] -> [Located FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> SrcSpanLess (Located FilePath) -> Located FilePath
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL (Located Token -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located Token
open)) [FilePath
"-#include",FilePath -> FilePath
removeSpaces FilePath
str] [Located FilePath] -> [Located FilePath] -> [Located FilePath]
forall a. [a] -> [a] -> [a]
++
                [Located Token] -> [Located FilePath]
parseToks [Located Token]
xs
          parseToks (Located Token
open:Located Token
close:[Located Token]
xs)
              | ITdocOptions str <- Located Token -> SrcSpanLess (Located Token)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Token
open
              , SrcSpanLess (Located Token)
ITclose_prag     <- Located Token -> SrcSpanLess (Located Token)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Token
close
              = (FilePath -> Located FilePath) -> [FilePath] -> [Located FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> SrcSpanLess (Located FilePath) -> Located FilePath
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL (Located Token -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located Token
open)) [FilePath
"-haddock-opts", FilePath -> FilePath
removeSpaces FilePath
str]
                [Located FilePath] -> [Located FilePath] -> [Located FilePath]
forall a. [a] -> [a] -> [a]
++ [Located Token] -> [Located FilePath]
parseToks [Located Token]
xs
          parseToks (Located Token
open:[Located Token]
xs)
              | SrcSpanLess (Located Token)
ITlanguage_prag <- Located Token -> SrcSpanLess (Located Token)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Token
open
              = [Located Token] -> [Located FilePath]
parseLanguage [Located Token]
xs
          parseToks (Located Token
comment:[Located Token]
xs) -- Skip over comments
              | Token -> Bool
isComment (Located Token -> SrcSpanLess (Located Token)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Token
comment)
              = [Located Token] -> [Located FilePath]
parseToks [Located Token]
xs
          parseToks [Located Token]
_ = []
          parseLanguage :: [Located Token] -> [Located FilePath]
parseLanguage ((Located Token -> Located (SrcSpanLess (Located Token))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (ITconid fs)):[Located Token]
rest)
              = DynFlags -> Located FastString -> Located FilePath
checkExtension DynFlags
dflags (SrcSpan -> SrcSpanLess (Located FastString) -> Located FastString
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc FastString
SrcSpanLess (Located FastString)
fs) Located FilePath -> [Located FilePath] -> [Located FilePath]
forall a. a -> [a] -> [a]
:
                case [Located Token]
rest of
                  (Located Token -> Located (SrcSpanLess (Located Token))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_loc SrcSpanLess (Located Token)
ITcomma):[Located Token]
more -> [Located Token] -> [Located FilePath]
parseLanguage [Located Token]
more
                  (Located Token -> Located (SrcSpanLess (Located Token))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_loc SrcSpanLess (Located Token)
ITclose_prag):[Located Token]
more -> [Located Token] -> [Located FilePath]
parseToks [Located Token]
more
                  (Located Token -> Located (SrcSpanLess (Located Token))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (Located Token)
_):[Located Token]
_ -> DynFlags -> SrcSpan -> [Located FilePath]
forall a. DynFlags -> SrcSpan -> a
languagePragParseError DynFlags
dflags SrcSpan
loc
                  [] -> FilePath -> [Located FilePath]
forall a. FilePath -> a
panic FilePath
"getOptions'.parseLanguage(1) went past eof token"
          parseLanguage (Located Token
tok:[Located Token]
_)
              = DynFlags -> SrcSpan -> [Located FilePath]
forall a. DynFlags -> SrcSpan -> a
languagePragParseError DynFlags
dflags (Located Token -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located Token
tok)
          parseLanguage []
              = FilePath -> [Located FilePath]
forall a. FilePath -> a
panic FilePath
"getOptions'.parseLanguage(2) went past eof token"

          isComment :: Token -> Bool
          isComment :: Token -> Bool
isComment Token
c =
            case Token
c of
              (ITlineComment {})     -> Bool
True
              (ITblockComment {})    -> Bool
True
              (ITdocCommentNext {})  -> Bool
True
              (ITdocCommentPrev {})  -> Bool
True
              (ITdocCommentNamed {}) -> Bool
True
              (ITdocSection {})      -> Bool
True
              Token
_                      -> Bool
False

-----------------------------------------------------------------------------

-- | Complain about non-dynamic flags in OPTIONS pragmas.
--
-- Throws a 'SourceError' if the input list is non-empty claiming that the
-- input flags are unknown.
checkProcessArgsResult :: MonadIO m => DynFlags -> [Located String] -> m ()
checkProcessArgsResult :: DynFlags -> [Located FilePath] -> m ()
checkProcessArgsResult DynFlags
dflags [Located FilePath]
flags
  = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Located FilePath] -> Bool
forall a. [a] -> Bool
notNull [Located FilePath]
flags) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SourceError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SourceError -> IO ()) -> SourceError -> IO ()
forall a b. (a -> b) -> a -> b
$ ErrorMessages -> SourceError
mkSrcErr (ErrorMessages -> SourceError) -> ErrorMessages -> SourceError
forall a b. (a -> b) -> a -> b
$ [ErrMsg] -> ErrorMessages
forall a. [a] -> Bag a
listToBag ([ErrMsg] -> ErrorMessages) -> [ErrMsg] -> ErrorMessages
forall a b. (a -> b) -> a -> b
$ (Located FilePath -> ErrMsg) -> [Located FilePath] -> [ErrMsg]
forall a b. (a -> b) -> [a] -> [b]
map Located FilePath -> ErrMsg
mkMsg [Located FilePath]
flags
    where mkMsg :: Located FilePath -> ErrMsg
mkMsg (Located FilePath -> Located (SrcSpanLess (Located FilePath))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (Located FilePath)
flag)
              = DynFlags -> SrcSpan -> MsgDoc -> ErrMsg
mkPlainErrMsg DynFlags
dflags SrcSpan
loc (MsgDoc -> ErrMsg) -> MsgDoc -> ErrMsg
forall a b. (a -> b) -> a -> b
$
                  (FilePath -> MsgDoc
text FilePath
"unknown flag in  {-# OPTIONS_GHC #-} pragma:" MsgDoc -> MsgDoc -> MsgDoc
<+>
                   FilePath -> MsgDoc
text FilePath
SrcSpanLess (Located FilePath)
flag)

-----------------------------------------------------------------------------

checkExtension :: DynFlags -> Located FastString -> Located String
checkExtension :: DynFlags -> Located FastString -> Located FilePath
checkExtension DynFlags
dflags (Located FastString -> Located (SrcSpanLess (Located FastString))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (Located FastString)
ext)
-- Checks if a given extension is valid, and if so returns
-- its corresponding flag. Otherwise it throws an exception.
  = if FilePath
ext' FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
supported
    then SrcSpan -> SrcSpanLess (Located FilePath) -> Located FilePath
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (FilePath
"-X"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
ext')
    else DynFlags -> SrcSpan -> FilePath -> Located FilePath
forall a. DynFlags -> SrcSpan -> FilePath -> a
unsupportedExtnError DynFlags
dflags SrcSpan
l FilePath
ext'
  where
    ext' :: FilePath
ext' = FastString -> FilePath
unpackFS FastString
SrcSpanLess (Located FastString)
ext
    supported :: [FilePath]
supported = PlatformMini -> [FilePath]
supportedLanguagesAndExtensions (PlatformMini -> [FilePath]) -> PlatformMini -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Platform -> PlatformMini
platformMini (Platform -> PlatformMini) -> Platform -> PlatformMini
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags

languagePragParseError :: DynFlags -> SrcSpan -> a
languagePragParseError :: DynFlags -> SrcSpan -> a
languagePragParseError DynFlags
dflags SrcSpan
loc =
    DynFlags -> SrcSpan -> MsgDoc -> a
forall a. DynFlags -> SrcSpan -> MsgDoc -> a
throwErr DynFlags
dflags SrcSpan
loc (MsgDoc -> a) -> MsgDoc -> a
forall a b. (a -> b) -> a -> b
$
       [MsgDoc] -> MsgDoc
vcat [ FilePath -> MsgDoc
text FilePath
"Cannot parse LANGUAGE pragma"
            , FilePath -> MsgDoc
text FilePath
"Expecting comma-separated list of language options,"
            , FilePath -> MsgDoc
text FilePath
"each starting with a capital letter"
            , Int -> MsgDoc -> MsgDoc
nest Int
2 (FilePath -> MsgDoc
text FilePath
"E.g. {-# LANGUAGE TemplateHaskell, GADTs #-}") ]

unsupportedExtnError :: DynFlags -> SrcSpan -> String -> a
unsupportedExtnError :: DynFlags -> SrcSpan -> FilePath -> a
unsupportedExtnError DynFlags
dflags SrcSpan
loc FilePath
unsup =
    DynFlags -> SrcSpan -> MsgDoc -> a
forall a. DynFlags -> SrcSpan -> MsgDoc -> a
throwErr DynFlags
dflags SrcSpan
loc (MsgDoc -> a) -> MsgDoc -> a
forall a b. (a -> b) -> a -> b
$
        FilePath -> MsgDoc
text FilePath
"Unsupported extension: " MsgDoc -> MsgDoc -> MsgDoc
<> FilePath -> MsgDoc
text FilePath
unsup MsgDoc -> MsgDoc -> MsgDoc
$$
        if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
suggestions then MsgDoc
Outputable.empty else FilePath -> MsgDoc
text FilePath
"Perhaps you meant" MsgDoc -> MsgDoc -> MsgDoc
<+> [MsgDoc] -> MsgDoc
quotedListWithOr ((FilePath -> MsgDoc) -> [FilePath] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> MsgDoc
text [FilePath]
suggestions)
  where
     supported :: [FilePath]
supported = PlatformMini -> [FilePath]
supportedLanguagesAndExtensions (PlatformMini -> [FilePath]) -> PlatformMini -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Platform -> PlatformMini
platformMini (Platform -> PlatformMini) -> Platform -> PlatformMini
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags
     suggestions :: [FilePath]
suggestions = FilePath -> [FilePath] -> [FilePath]
fuzzyMatch FilePath
unsup [FilePath]
supported


optionsErrorMsgs :: DynFlags -> [String] -> [Located String] -> FilePath -> Messages
optionsErrorMsgs :: DynFlags
-> [FilePath]
-> [Located FilePath]
-> FilePath
-> (ErrorMessages, ErrorMessages)
optionsErrorMsgs DynFlags
dflags [FilePath]
unhandled_flags [Located FilePath]
flags_lines FilePath
_filename
  = (ErrorMessages
forall a. Bag a
emptyBag, [ErrMsg] -> ErrorMessages
forall a. [a] -> Bag a
listToBag ((Located FilePath -> ErrMsg) -> [Located FilePath] -> [ErrMsg]
forall a b. (a -> b) -> [a] -> [b]
map Located FilePath -> ErrMsg
mkMsg [Located FilePath]
unhandled_flags_lines))
  where unhandled_flags_lines :: [Located String]
        unhandled_flags_lines :: [Located FilePath]
unhandled_flags_lines = [ SrcSpan -> SrcSpanLess (Located FilePath) -> Located FilePath
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l FilePath
SrcSpanLess (Located FilePath)
f
                                | FilePath
f <- [FilePath]
unhandled_flags
                                , (Located FilePath -> Located (SrcSpanLess (Located FilePath))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (Located FilePath)
f') <- [Located FilePath]
flags_lines
                                , FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
SrcSpanLess (Located FilePath)
f' ]
        mkMsg :: Located FilePath -> ErrMsg
mkMsg (Located FilePath -> Located (SrcSpanLess (Located FilePath))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
flagSpan SrcSpanLess (Located FilePath)
flag) =
            DynFlags -> SrcSpan -> MsgDoc -> ErrMsg
ErrUtils.mkPlainErrMsg DynFlags
dflags SrcSpan
flagSpan (MsgDoc -> ErrMsg) -> MsgDoc -> ErrMsg
forall a b. (a -> b) -> a -> b
$
                    FilePath -> MsgDoc
text FilePath
"unknown flag in  {-# OPTIONS_GHC #-} pragma:" MsgDoc -> MsgDoc -> MsgDoc
<+> FilePath -> MsgDoc
text FilePath
SrcSpanLess (Located FilePath)
flag

optionsParseError :: String -> DynFlags -> SrcSpan -> a     -- #15053
optionsParseError :: FilePath -> DynFlags -> SrcSpan -> a
optionsParseError FilePath
str DynFlags
dflags SrcSpan
loc =
  DynFlags -> SrcSpan -> MsgDoc -> a
forall a. DynFlags -> SrcSpan -> MsgDoc -> a
throwErr DynFlags
dflags SrcSpan
loc (MsgDoc -> a) -> MsgDoc -> a
forall a b. (a -> b) -> a -> b
$
      [MsgDoc] -> MsgDoc
vcat [ FilePath -> MsgDoc
text FilePath
"Error while parsing OPTIONS_GHC pragma."
           , FilePath -> MsgDoc
text FilePath
"Expecting whitespace-separated list of GHC options."
           , FilePath -> MsgDoc
text FilePath
"  E.g. {-# OPTIONS_GHC -Wall -O2 #-}"
           , FilePath -> MsgDoc
text (FilePath
"Input was: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
str) ]

throwErr :: DynFlags -> SrcSpan -> SDoc -> a                -- #15053
throwErr :: DynFlags -> SrcSpan -> MsgDoc -> a
throwErr DynFlags
dflags SrcSpan
loc MsgDoc
doc =
  SourceError -> a
forall a e. Exception e => e -> a
throw (SourceError -> a) -> SourceError -> a
forall a b. (a -> b) -> a -> b
$ ErrorMessages -> SourceError
mkSrcErr (ErrorMessages -> SourceError) -> ErrorMessages -> SourceError
forall a b. (a -> b) -> a -> b
$ ErrMsg -> ErrorMessages
forall a. a -> Bag a
unitBag (ErrMsg -> ErrorMessages) -> ErrMsg -> ErrorMessages
forall a b. (a -> b) -> a -> b
$ DynFlags -> SrcSpan -> MsgDoc -> ErrMsg
mkPlainErrMsg DynFlags
dflags SrcSpan
loc MsgDoc
doc