{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
module Language.Haskell.GHC.ExactPrint.Parsers (
Parser
, ParseResult
, withDynFlags
, CppOptions(..)
, defaultCppOptions
, parseModule
, parseModuleFromString
, parseModuleWithOptions
, parseModuleWithCpp
, parseExpr
, parseImport
, parseType
, parseDecl
, parsePattern
, parseStmt
, parseWith
, ghcWrapper
, initDynFlags
, initDynFlagsPure
, parseModuleFromStringInternal
, parseModuleApiAnnsWithCpp
, parseModuleApiAnnsWithCppInternal
, postParseTransform
) where
import Language.Haskell.GHC.ExactPrint.Annotate
import Language.Haskell.GHC.ExactPrint.Delta
import Language.Haskell.GHC.ExactPrint.Preprocess
import Language.Haskell.GHC.ExactPrint.Types
import Control.Exception (IOException, catch)
import Control.Monad.RWS
#if __GLASGOW_HASKELL__ >= 900
#elif __GLASGOW_HASKELL__ > 806
import Data.Data (Data)
#endif
import Data.Maybe (fromMaybe)
import GHC.Paths (libdir)
import System.Environment (lookupEnv)
import qualified GHC hiding (parseModule)
#if __GLASGOW_HASKELL__ >= 900
import qualified Control.Monad.IO.Class as GHC
import qualified GHC.Data.FastString as GHC
import qualified GHC.Data.StringBuffer as GHC
import qualified GHC.Driver.Session as GHC
import qualified GHC.Parser as GHC
import qualified GHC.Parser.Header as GHC
import qualified GHC.Parser.Lexer as GHC
import qualified GHC.Parser.PostProcess as GHC
import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.Utils.Error as GHC
#else
import qualified DynFlags as GHC
#if __GLASGOW_HASKELL__ > 808
import qualified ErrUtils as GHC
#endif
import qualified FastString as GHC
import qualified HeaderInfo as GHC
import qualified Lexer as GHC
import qualified MonadUtils as GHC
#if __GLASGOW_HASKELL__ <= 808
import qualified Outputable as GHC
#endif
import qualified Parser as GHC
#if __GLASGOW_HASKELL__ > 808
import qualified RdrHsSyn as GHC
#endif
import qualified SrcLoc as GHC
import qualified StringBuffer as GHC
#endif
#if __GLASGOW_HASKELL__ <= 710
import qualified OrdList as OL
#else
import qualified GHC.LanguageExtensions as LangExt
#endif
import qualified Data.Map as Map
{-# ANN module "HLint: ignore Eta reduce" #-}
{-# ANN module "HLint: ignore Redundant do" #-}
{-# ANN module "HLint: ignore Reduce duplication" #-}
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
parseWith :: (Data (GHC.SrcSpanLess w), Annotate w, GHC.HasSrcSpan w)
=> GHC.DynFlags
-> FilePath
-> GHC.P w
-> String
-> ParseResult w
#else
parseWith :: Annotate w
=> GHC.DynFlags
-> FilePath
-> GHC.P (GHC.Located w)
-> String
-> ParseResult (GHC.Located w)
#endif
parseWith :: forall w.
Annotate w =>
DynFlags
-> FilePath -> P (Located w) -> FilePath -> ParseResult (Located w)
parseWith DynFlags
dflags FilePath
fileName P (Located w)
parser FilePath
s =
case P (Located w)
-> DynFlags -> FilePath -> FilePath -> ParseResult (Located w)
forall a. P a -> DynFlags -> FilePath -> FilePath -> ParseResult a
runParser P (Located w)
parser DynFlags
dflags FilePath
fileName FilePath
s of
#if __GLASGOW_HASKELL__ > 808
GHC.PFailed PState
pst -> ErrorMessages -> ParseResult (Located w)
forall a b. a -> Either a b
Left (PState -> DynFlags -> ErrorMessages
GHC.getErrorMessages PState
pst DynFlags
dflags)
#elif __GLASGOW_HASKELL__ >= 804
GHC.PFailed _ ss m -> Left (ss, GHC.showSDoc dflags m)
#else
GHC.PFailed ss m -> Left (ss, GHC.showSDoc dflags m)
#endif
GHC.POk (PState -> ApiAnns
mkApiAnns -> ApiAnns
apianns) Located w
pmod -> (Anns, Located w) -> ParseResult (Located w)
forall a b. b -> Either a b
Right (Anns
as, Located w
pmod)
where as :: Anns
as = Located w -> ApiAnns -> Anns
forall ast. Annotate ast => Located ast -> ApiAnns -> Anns
relativiseApiAnns Located w
pmod ApiAnns
apianns
#if __GLASGOW_HASKELL__ > 808
parseWithECP :: (GHC.DisambECP w, Annotate (GHC.Body w GHC.GhcPs))
=> GHC.DynFlags
-> FilePath
-> GHC.P GHC.ECP
-> String
-> ParseResult (GHC.Located w)
parseWithECP :: forall w.
(DisambECP w, Annotate (Body w GhcPs)) =>
DynFlags
-> FilePath -> P ECP -> FilePath -> ParseResult (Located w)
parseWithECP DynFlags
dflags FilePath
fileName P ECP
parser FilePath
s =
case P (Located w)
-> DynFlags -> FilePath -> FilePath -> ParseResult (Located w)
forall a. P a -> DynFlags -> FilePath -> FilePath -> ParseResult a
runParser (P ECP
parser P ECP -> (ECP -> P (Located w)) -> P (Located w)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ECP
p -> ECP -> P (Located w)
forall b. DisambECP b => ECP -> P (Located b)
GHC.runECP_P ECP
p) DynFlags
dflags FilePath
fileName FilePath
s of
GHC.PFailed PState
pst -> ErrorMessages -> ParseResult (Located w)
forall a b. a -> Either a b
Left (PState -> DynFlags -> ErrorMessages
GHC.getErrorMessages PState
pst DynFlags
dflags)
GHC.POk (PState -> ApiAnns
mkApiAnns -> ApiAnns
apianns) Located w
pmod -> (Anns, Located w) -> ParseResult (Located w)
forall a b. b -> Either a b
Right (Anns
as, Located w
pmod)
where as :: Anns
as = Located w -> ApiAnns -> Anns
forall ast. Annotate ast => Located ast -> ApiAnns -> Anns
relativiseApiAnns Located w
pmod ApiAnns
apianns
#endif
runParser :: GHC.P a -> GHC.DynFlags -> FilePath -> String -> GHC.ParseResult a
runParser :: forall a. P a -> DynFlags -> FilePath -> FilePath -> ParseResult a
runParser P a
parser DynFlags
flags FilePath
filename FilePath
str = P a -> PState -> ParseResult a
forall a. P a -> PState -> ParseResult a
GHC.unP P a
parser PState
parseState
where
location :: RealSrcLoc
location = FastString -> Int -> Int -> RealSrcLoc
GHC.mkRealSrcLoc (FilePath -> FastString
GHC.mkFastString FilePath
filename) Int
1 Int
1
buffer :: StringBuffer
buffer = FilePath -> StringBuffer
GHC.stringToStringBuffer FilePath
str
parseState :: PState
parseState = DynFlags -> StringBuffer -> RealSrcLoc -> PState
GHC.mkPState DynFlags
flags StringBuffer
buffer RealSrcLoc
location
withDynFlags :: (GHC.DynFlags -> a) -> IO a
withDynFlags :: forall a. (DynFlags -> a) -> IO a
withDynFlags DynFlags -> a
action = Ghc a -> IO a
forall a. Ghc a -> IO a
ghcWrapper (Ghc a -> IO a) -> Ghc a -> IO a
forall a b. (a -> b) -> a -> b
$ do
DynFlags
dflags <- Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
Ghc () -> Ghc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ghc () -> Ghc ()) -> Ghc () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Ghc ()
forall (m :: * -> *). GhcMonad m => DynFlags -> m ()
GHC.setSessionDynFlags DynFlags
dflags
a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags -> a
action DynFlags
dflags)
#if __GLASGOW_HASKELL__ >= 900
parseFile :: GHC.DynFlags -> FilePath -> String -> GHC.ParseResult (GHC.Located GHC.HsModule)
#else
parseFile :: GHC.DynFlags -> FilePath -> String -> GHC.ParseResult (GHC.Located (GHC.HsModule GhcPs))
#endif
parseFile :: DynFlags -> FilePath -> FilePath -> ParseResult (Located HsModule)
parseFile = P (Located HsModule)
-> DynFlags
-> FilePath
-> FilePath
-> ParseResult (Located HsModule)
forall a. P a -> DynFlags -> FilePath -> FilePath -> ParseResult a
runParser P (Located HsModule)
GHC.parseModule
#if __GLASGOW_HASKELL__ > 808
type ParseResult a = Either GHC.ErrorMessages (Anns, a)
#else
type ParseResult a = Either (GHC.SrcSpan, String) (Anns, a)
#endif
type Parser a = GHC.DynFlags -> FilePath -> String
-> ParseResult a
parseExpr :: Parser (GHC.LHsExpr GhcPs)
#if __GLASGOW_HASKELL__ > 808
parseExpr :: Parser (LHsExpr GhcPs)
parseExpr DynFlags
df FilePath
fp = DynFlags
-> FilePath -> P ECP -> FilePath -> ParseResult (LHsExpr GhcPs)
forall w.
(DisambECP w, Annotate (Body w GhcPs)) =>
DynFlags
-> FilePath -> P ECP -> FilePath -> ParseResult (Located w)
parseWithECP DynFlags
df FilePath
fp P ECP
GHC.parseExpression
#else
parseExpr df fp = parseWith df fp GHC.parseExpression
#endif
parseImport :: Parser (GHC.LImportDecl GhcPs)
parseImport :: Parser (LImportDecl GhcPs)
parseImport DynFlags
df FilePath
fp = DynFlags
-> FilePath
-> P (LImportDecl GhcPs)
-> FilePath
-> ParseResult (LImportDecl GhcPs)
forall w.
Annotate w =>
DynFlags
-> FilePath -> P (Located w) -> FilePath -> ParseResult (Located w)
parseWith DynFlags
df FilePath
fp P (LImportDecl GhcPs)
GHC.parseImport
parseType :: Parser (GHC.LHsType GhcPs)
parseType :: Parser (LHsType GhcPs)
parseType DynFlags
df FilePath
fp = DynFlags
-> FilePath
-> P (LHsType GhcPs)
-> FilePath
-> ParseResult (LHsType GhcPs)
forall w.
Annotate w =>
DynFlags
-> FilePath -> P (Located w) -> FilePath -> ParseResult (Located w)
parseWith DynFlags
df FilePath
fp P (LHsType GhcPs)
GHC.parseType
parseDecl :: Parser (GHC.LHsDecl GhcPs)
#if __GLASGOW_HASKELL__ <= 710
parseDecl df fp = parseWith df fp (head . OL.fromOL <$> GHC.parseDeclaration)
#else
parseDecl :: Parser (LHsDecl GhcPs)
parseDecl DynFlags
df FilePath
fp = DynFlags
-> FilePath
-> P (LHsDecl GhcPs)
-> FilePath
-> ParseResult (LHsDecl GhcPs)
forall w.
Annotate w =>
DynFlags
-> FilePath -> P (Located w) -> FilePath -> ParseResult (Located w)
parseWith DynFlags
df FilePath
fp P (LHsDecl GhcPs)
GHC.parseDeclaration
#endif
parseStmt :: Parser (GHC.ExprLStmt GhcPs)
parseStmt :: Parser (ExprLStmt GhcPs)
parseStmt DynFlags
df FilePath
fp = DynFlags
-> FilePath
-> P (ExprLStmt GhcPs)
-> FilePath
-> ParseResult (ExprLStmt GhcPs)
forall w.
Annotate w =>
DynFlags
-> FilePath -> P (Located w) -> FilePath -> ParseResult (Located w)
parseWith DynFlags
df FilePath
fp P (ExprLStmt GhcPs)
GHC.parseStatement
parsePattern :: Parser (GHC.LPat GhcPs)
parsePattern :: Parser (LPat GhcPs)
parsePattern DynFlags
df FilePath
fp = DynFlags
-> FilePath
-> P (Located (Pat GhcPs))
-> FilePath
-> ParseResult (Located (Pat GhcPs))
forall w.
Annotate w =>
DynFlags
-> FilePath -> P (Located w) -> FilePath -> ParseResult (Located w)
parseWith DynFlags
df FilePath
fp P (Located (Pat GhcPs))
GHC.parsePattern
parseModule :: FilePath -> IO (ParseResult GHC.ParsedSource)
parseModule :: FilePath -> IO (ParseResult (Located HsModule))
parseModule = CppOptions
-> DeltaOptions -> FilePath -> IO (ParseResult (Located HsModule))
parseModuleWithCpp CppOptions
defaultCppOptions DeltaOptions
normalLayout
parseModuleFromString
:: FilePath
-> String
-> IO (ParseResult GHC.ParsedSource)
parseModuleFromString :: FilePath -> FilePath -> IO (ParseResult (Located HsModule))
parseModuleFromString FilePath
fp FilePath
s = Ghc (ParseResult (Located HsModule))
-> IO (ParseResult (Located HsModule))
forall a. Ghc a -> IO a
ghcWrapper (Ghc (ParseResult (Located HsModule))
-> IO (ParseResult (Located HsModule)))
-> Ghc (ParseResult (Located HsModule))
-> IO (ParseResult (Located HsModule))
forall a b. (a -> b) -> a -> b
$ do
DynFlags
dflags <- FilePath -> FilePath -> Ghc DynFlags
forall (m :: * -> *).
GhcMonad m =>
FilePath -> FilePath -> m DynFlags
initDynFlagsPure FilePath
fp FilePath
s
ParseResult (Located HsModule)
-> Ghc (ParseResult (Located HsModule))
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseResult (Located HsModule)
-> Ghc (ParseResult (Located HsModule)))
-> ParseResult (Located HsModule)
-> Ghc (ParseResult (Located HsModule))
forall a b. (a -> b) -> a -> b
$ Parser (Located HsModule)
parseModuleFromStringInternal DynFlags
dflags FilePath
fp FilePath
s
parseModuleFromStringInternal :: Parser GHC.ParsedSource
parseModuleFromStringInternal :: Parser (Located HsModule)
parseModuleFromStringInternal DynFlags
dflags FilePath
fileName FilePath
str =
let (FilePath
str1, [Comment]
lp) = FilePath -> (FilePath, [Comment])
stripLinePragmas FilePath
str
res :: Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
res = case P (Located HsModule)
-> DynFlags
-> FilePath
-> FilePath
-> ParseResult (Located HsModule)
forall a. P a -> DynFlags -> FilePath -> FilePath -> ParseResult a
runParser P (Located HsModule)
GHC.parseModule DynFlags
dflags FilePath
fileName FilePath
str1 of
#if __GLASGOW_HASKELL__ > 808
GHC.PFailed PState
pst -> ErrorMessages
-> Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
forall a b. a -> Either a b
Left (PState -> DynFlags -> ErrorMessages
GHC.getErrorMessages PState
pst DynFlags
dflags)
#elif __GLASGOW_HASKELL__ >= 804
GHC.PFailed _ ss m -> Left (ss, GHC.showSDoc dflags m)
#else
GHC.PFailed ss m -> Left (ss, GHC.showSDoc dflags m)
#endif
GHC.POk PState
x Located HsModule
pmod -> (ApiAnns, [Comment], DynFlags, Located HsModule)
-> Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
forall a b. b -> Either a b
Right (PState -> ApiAnns
mkApiAnns PState
x, [Comment]
lp, DynFlags
dflags, Located HsModule
pmod)
in Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
-> DeltaOptions -> ParseResult (Located HsModule)
forall a.
Either a (ApiAnns, [Comment], DynFlags, Located HsModule)
-> DeltaOptions -> Either a (Anns, Located HsModule)
postParseTransform Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
res DeltaOptions
normalLayout
parseModuleWithOptions :: DeltaOptions
-> FilePath
-> IO (ParseResult GHC.ParsedSource)
parseModuleWithOptions :: DeltaOptions -> FilePath -> IO (ParseResult (Located HsModule))
parseModuleWithOptions DeltaOptions
opts FilePath
fp =
CppOptions
-> DeltaOptions -> FilePath -> IO (ParseResult (Located HsModule))
parseModuleWithCpp CppOptions
defaultCppOptions DeltaOptions
opts FilePath
fp
parseModuleWithCpp
:: CppOptions
-> DeltaOptions
-> FilePath
-> IO (ParseResult GHC.ParsedSource)
parseModuleWithCpp :: CppOptions
-> DeltaOptions -> FilePath -> IO (ParseResult (Located HsModule))
parseModuleWithCpp CppOptions
cpp DeltaOptions
opts FilePath
fp = do
Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
res <- CppOptions
-> FilePath
-> IO
(Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule))
parseModuleApiAnnsWithCpp CppOptions
cpp FilePath
fp
ParseResult (Located HsModule)
-> IO (ParseResult (Located HsModule))
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseResult (Located HsModule)
-> IO (ParseResult (Located HsModule)))
-> ParseResult (Located HsModule)
-> IO (ParseResult (Located HsModule))
forall a b. (a -> b) -> a -> b
$ Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
-> DeltaOptions -> ParseResult (Located HsModule)
forall a.
Either a (ApiAnns, [Comment], DynFlags, Located HsModule)
-> DeltaOptions -> Either a (Anns, Located HsModule)
postParseTransform Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
res DeltaOptions
opts
parseModuleApiAnnsWithCpp
:: CppOptions
-> FilePath
-> IO
( Either
#if __GLASGOW_HASKELL__ > 808
GHC.ErrorMessages
#else
(GHC.SrcSpan, String)
#endif
(GHC.ApiAnns, [Comment], GHC.DynFlags, GHC.ParsedSource)
)
parseModuleApiAnnsWithCpp :: CppOptions
-> FilePath
-> IO
(Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule))
parseModuleApiAnnsWithCpp CppOptions
cppOptions FilePath
file = Ghc
(Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule))
-> IO
(Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule))
forall a. Ghc a -> IO a
ghcWrapper (Ghc
(Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule))
-> IO
(Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)))
-> Ghc
(Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule))
-> IO
(Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule))
forall a b. (a -> b) -> a -> b
$ do
DynFlags
dflags <- FilePath -> Ghc DynFlags
forall (m :: * -> *). GhcMonad m => FilePath -> m DynFlags
initDynFlags FilePath
file
CppOptions
-> DynFlags
-> FilePath
-> Ghc
(Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule))
forall (m :: * -> *).
GhcMonad m =>
CppOptions
-> DynFlags
-> FilePath
-> m (Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule))
parseModuleApiAnnsWithCppInternal CppOptions
cppOptions DynFlags
dflags FilePath
file
ghcWrapper :: GHC.Ghc a -> IO a
ghcWrapper :: forall a. Ghc a -> IO a
ghcWrapper Ghc a
ghc = do
let handler :: IOException -> IO (Maybe FilePath)
handler = Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> (IOException -> Maybe FilePath)
-> IOException
-> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> IOException -> Maybe FilePath
forall a b. a -> b -> a
const Maybe FilePath
forall a. Maybe a
Nothing :: IOException -> IO (Maybe String)
Maybe FilePath
rtLibdir <- IO (Maybe FilePath) -> IO (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> IO (Maybe FilePath))
-> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"GHC_EXACTPRINT_GHC_LIBDIR" IO (Maybe FilePath)
-> (IOException -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOException -> IO (Maybe FilePath)
handler
let libdir' :: FilePath
libdir' = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
libdir Maybe FilePath
rtLibdir
FatalMessager -> FlushOut -> IO a -> IO a
forall (m :: * -> *) a.
ExceptionMonad m =>
FatalMessager -> FlushOut -> m a -> m a
GHC.defaultErrorHandler FatalMessager
GHC.defaultFatalMessager FlushOut
GHC.defaultFlushOut
(IO a -> IO a) -> (Ghc a -> IO a) -> Ghc a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> Ghc a -> IO a
forall a. Maybe FilePath -> Ghc a -> IO a
GHC.runGhc (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
libdir') (Ghc a -> IO a) -> Ghc a -> IO a
forall a b. (a -> b) -> a -> b
$ Ghc a
ghc
parseModuleApiAnnsWithCppInternal
:: GHC.GhcMonad m
=> CppOptions
-> GHC.DynFlags
-> FilePath
-> m
( Either
#if __GLASGOW_HASKELL__ > 808
GHC.ErrorMessages
#else
(GHC.SrcSpan, String)
#endif
(GHC.ApiAnns, [Comment], GHC.DynFlags, GHC.ParsedSource)
)
parseModuleApiAnnsWithCppInternal :: forall (m :: * -> *).
GhcMonad m =>
CppOptions
-> DynFlags
-> FilePath
-> m (Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule))
parseModuleApiAnnsWithCppInternal CppOptions
cppOptions DynFlags
dflags FilePath
file = do
#if __GLASGOW_HASKELL__ <= 710
let useCpp = GHC.xopt GHC.Opt_Cpp dflags
#else
let useCpp :: Bool
useCpp = Extension -> DynFlags -> Bool
GHC.xopt Extension
LangExt.Cpp DynFlags
dflags
#endif
(FilePath
fileContents, [Comment]
injectedComments, DynFlags
dflags') <-
if Bool
useCpp
then do
(FilePath
contents,DynFlags
dflags1) <- CppOptions -> FilePath -> m (FilePath, DynFlags)
forall (m :: * -> *).
GhcMonad m =>
CppOptions -> FilePath -> m (FilePath, DynFlags)
getPreprocessedSrcDirect CppOptions
cppOptions FilePath
file
[Comment]
cppComments <- CppOptions -> FilePath -> m [Comment]
forall (m :: * -> *).
GhcMonad m =>
CppOptions -> FilePath -> m [Comment]
getCppTokensAsComments CppOptions
cppOptions FilePath
file
(FilePath, [Comment], DynFlags)
-> m (FilePath, [Comment], DynFlags)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
contents,[Comment]
cppComments,DynFlags
dflags1)
else do
FilePath
txt <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
GHC.liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFileGhc FilePath
file
let (FilePath
contents1,[Comment]
lp) = FilePath -> (FilePath, [Comment])
stripLinePragmas FilePath
txt
(FilePath, [Comment], DynFlags)
-> m (FilePath, [Comment], DynFlags)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
contents1,[Comment]
lp,DynFlags
dflags)
Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
-> m (Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
-> m (Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)))
-> Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
-> m (Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule))
forall a b. (a -> b) -> a -> b
$
case DynFlags -> FilePath -> FilePath -> ParseResult (Located HsModule)
parseFile DynFlags
dflags' FilePath
file FilePath
fileContents of
#if __GLASGOW_HASKELL__ > 808
GHC.PFailed PState
pst -> ErrorMessages
-> Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
forall a b. a -> Either a b
Left (PState -> DynFlags -> ErrorMessages
GHC.getErrorMessages PState
pst DynFlags
dflags)
#elif __GLASGOW_HASKELL__ >= 804
GHC.PFailed _ ss m -> Left $ (ss, (GHC.showSDoc dflags m))
#else
GHC.PFailed ss m -> Left $ (ss, (GHC.showSDoc dflags m))
#endif
GHC.POk (PState -> ApiAnns
mkApiAnns -> ApiAnns
apianns) Located HsModule
pmod ->
(ApiAnns, [Comment], DynFlags, Located HsModule)
-> Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
forall a b. b -> Either a b
Right ((ApiAnns, [Comment], DynFlags, Located HsModule)
-> Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule))
-> (ApiAnns, [Comment], DynFlags, Located HsModule)
-> Either
ErrorMessages (ApiAnns, [Comment], DynFlags, Located HsModule)
forall a b. (a -> b) -> a -> b
$ (ApiAnns
apianns, [Comment]
injectedComments, DynFlags
dflags', Located HsModule
pmod)
postParseTransform
:: Either a (GHC.ApiAnns, [Comment], GHC.DynFlags, GHC.ParsedSource)
-> DeltaOptions
-> Either a (Anns, GHC.ParsedSource)
postParseTransform :: forall a.
Either a (ApiAnns, [Comment], DynFlags, Located HsModule)
-> DeltaOptions -> Either a (Anns, Located HsModule)
postParseTransform Either a (ApiAnns, [Comment], DynFlags, Located HsModule)
parseRes DeltaOptions
opts = ((ApiAnns, [Comment], DynFlags, Located HsModule)
-> (Anns, Located HsModule))
-> Either a (ApiAnns, [Comment], DynFlags, Located HsModule)
-> Either a (Anns, Located HsModule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ApiAnns, [Comment], DynFlags, Located HsModule)
-> (Anns, Located HsModule)
forall {ast} {c}.
Annotate ast =>
(ApiAnns, [Comment], c, Located ast) -> (Anns, Located ast)
mkAnns Either a (ApiAnns, [Comment], DynFlags, Located HsModule)
parseRes
where
mkAnns :: (ApiAnns, [Comment], c, Located ast) -> (Anns, Located ast)
mkAnns (ApiAnns
apianns, [Comment]
cs, c
_, Located ast
m) =
(DeltaOptions -> [Comment] -> Located ast -> ApiAnns -> Anns
forall ast.
Annotate ast =>
DeltaOptions -> [Comment] -> Located ast -> ApiAnns -> Anns
relativiseApiAnnsWithOptions DeltaOptions
opts [Comment]
cs Located ast
m ApiAnns
apianns, Located ast
m)
initDynFlags :: GHC.GhcMonad m => FilePath -> m GHC.DynFlags
initDynFlags :: forall (m :: * -> *). GhcMonad m => FilePath -> m DynFlags
initDynFlags FilePath
file = do
DynFlags
dflags0 <- m DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
[Located FilePath]
src_opts <- IO [Located FilePath] -> m [Located FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
GHC.liftIO (IO [Located FilePath] -> m [Located FilePath])
-> IO [Located FilePath] -> m [Located FilePath]
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath -> IO [Located FilePath]
GHC.getOptionsFromFile DynFlags
dflags0 FilePath
file
(DynFlags
dflags1, [Located FilePath]
_, [Warn]
_) <- DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
GHC.parseDynamicFilePragma DynFlags
dflags0 [Located FilePath]
src_opts
let dflags2 :: DynFlags
dflags2 = DynFlags
dflags1 DynFlags -> GeneralFlag -> DynFlags
`GHC.gopt_set` GeneralFlag
GHC.Opt_KeepRawTokenStream
(DynFlags
dflags3, [Located FilePath]
_, [Warn]
_) <- DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
GHC.parseDynamicFlagsCmdLine
DynFlags
dflags2
[FilePath -> Located FilePath
forall e. e -> Located e
GHC.noLoc FilePath
"-hide-all-packages"]
()
_ <- DynFlags -> m ()
forall (m :: * -> *). GhcMonad m => DynFlags -> m ()
GHC.setSessionDynFlags DynFlags
dflags3
DynFlags -> m DynFlags
forall (m :: * -> *) a. Monad m => a -> m a
return DynFlags
dflags3
initDynFlagsPure :: GHC.GhcMonad m => FilePath -> String -> m GHC.DynFlags
initDynFlagsPure :: forall (m :: * -> *).
GhcMonad m =>
FilePath -> FilePath -> m DynFlags
initDynFlagsPure FilePath
fp FilePath
s = do
DynFlags
dflags0 <- m DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
let pragmaInfo :: [Located FilePath]
pragmaInfo = DynFlags -> StringBuffer -> FilePath -> [Located FilePath]
GHC.getOptions DynFlags
dflags0 (FilePath -> StringBuffer
GHC.stringToStringBuffer (FilePath -> StringBuffer) -> FilePath -> StringBuffer
forall a b. (a -> b) -> a -> b
$ FilePath
s) FilePath
fp
(DynFlags
dflags1, [Located FilePath]
_, [Warn]
_) <- DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
GHC.parseDynamicFilePragma DynFlags
dflags0 [Located FilePath]
pragmaInfo
let dflags2 :: DynFlags
dflags2 = DynFlags
dflags1 DynFlags -> GeneralFlag -> DynFlags
`GHC.gopt_set` GeneralFlag
GHC.Opt_KeepRawTokenStream
(DynFlags
dflags3, [Located FilePath]
_, [Warn]
_) <- DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
GHC.parseDynamicFlagsCmdLine
DynFlags
dflags2
[FilePath -> Located FilePath
forall e. e -> Located e
GHC.noLoc FilePath
"-hide-all-packages"]
()
_ <- DynFlags -> m ()
forall (m :: * -> *). GhcMonad m => DynFlags -> m ()
GHC.setSessionDynFlags DynFlags
dflags3
DynFlags -> m DynFlags
forall (m :: * -> *) a. Monad m => a -> m a
return DynFlags
dflags3
mkApiAnns :: GHC.PState -> GHC.ApiAnns
#if __GLASGOW_HASKELL__ >= 900
mkApiAnns :: PState -> ApiAnns
mkApiAnns PState
pstate
= ApiAnns :: Map ApiAnnKey [RealSrcSpan]
-> Maybe RealSrcSpan
-> Map RealSrcSpan [RealLocated AnnotationComment]
-> [RealLocated AnnotationComment]
-> ApiAnns
GHC.ApiAnns {
apiAnnItems :: Map ApiAnnKey [RealSrcSpan]
GHC.apiAnnItems = ([RealSrcSpan] -> [RealSrcSpan] -> [RealSrcSpan])
-> [(ApiAnnKey, [RealSrcSpan])] -> Map ApiAnnKey [RealSrcSpan]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [RealSrcSpan] -> [RealSrcSpan] -> [RealSrcSpan]
forall a. [a] -> [a] -> [a]
(++) ([(ApiAnnKey, [RealSrcSpan])] -> Map ApiAnnKey [RealSrcSpan])
-> [(ApiAnnKey, [RealSrcSpan])] -> Map ApiAnnKey [RealSrcSpan]
forall a b. (a -> b) -> a -> b
$ PState -> [(ApiAnnKey, [RealSrcSpan])]
GHC.annotations PState
pstate,
apiAnnEofPos :: Maybe RealSrcSpan
GHC.apiAnnEofPos = PState -> Maybe RealSrcSpan
GHC.eof_pos PState
pstate,
apiAnnComments :: Map RealSrcSpan [RealLocated AnnotationComment]
GHC.apiAnnComments = [(RealSrcSpan, [RealLocated AnnotationComment])]
-> Map RealSrcSpan [RealLocated AnnotationComment]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (PState -> [(RealSrcSpan, [RealLocated AnnotationComment])]
GHC.annotations_comments PState
pstate),
apiAnnRogueComments :: [RealLocated AnnotationComment]
GHC.apiAnnRogueComments = PState -> [RealLocated AnnotationComment]
GHC.comment_q PState
pstate
}
#else
mkApiAnns pstate
= ( Map.fromListWith (++) . GHC.annotations $ pstate
, Map.fromList ((GHC.noSrcSpan, GHC.comment_q pstate) : GHC.annotations_comments pstate))
#endif