{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
module Language.Haskell.GHC.ExactPrint.Parsers (
Parser
, 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.Monad.RWS
#if __GLASGOW_HASKELL__ > 806
import Data.Data (Data)
#endif
import GHC.Paths (libdir)
import qualified ApiAnnotation as GHC
import qualified DynFlags as GHC
import qualified FastString as GHC
import qualified GHC as GHC hiding (parseModule)
import qualified HeaderInfo as GHC
import qualified Lexer as GHC
import qualified MonadUtils as GHC
import qualified Outputable as GHC
import qualified Parser as GHC
import qualified SrcLoc as GHC
import qualified StringBuffer as GHC
#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
parseWith :: (Data (GHC.SrcSpanLess w), Annotate w, GHC.HasSrcSpan w)
=> GHC.DynFlags
-> FilePath
-> GHC.P w
-> String
-> Either (GHC.SrcSpan, String) (Anns, w)
#else
parseWith :: Annotate w
=> GHC.DynFlags
-> FilePath
-> GHC.P (GHC.Located w)
-> String
-> Either (GHC.SrcSpan, String) (Anns, GHC.Located w)
#endif
parseWith :: DynFlags
-> FilePath
-> P w
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, w)
parseWith dflags :: DynFlags
dflags fileName :: FilePath
fileName parser :: P w
parser s :: FilePath
s =
case P w -> DynFlags -> FilePath -> FilePath -> ParseResult w
forall a. P a -> DynFlags -> FilePath -> FilePath -> ParseResult a
runParser P w
parser DynFlags
dflags FilePath
fileName FilePath
s of
#if __GLASGOW_HASKELL__ >= 804
GHC.PFailed _ ss :: SrcSpan
ss m :: MsgDoc
m -> (SrcSpan, FilePath) -> Either (SrcSpan, FilePath) (Anns, w)
forall a b. a -> Either a b
Left (SrcSpan
ss, DynFlags -> MsgDoc -> FilePath
GHC.showSDoc DynFlags
dflags MsgDoc
m)
#else
GHC.PFailed ss m -> Left (ss, GHC.showSDoc dflags m)
#endif
GHC.POk (PState -> ApiAnns
mkApiAnns -> ApiAnns
apianns) pmod :: w
pmod -> (Anns, w) -> Either (SrcSpan, FilePath) (Anns, w)
forall a b. b -> Either a b
Right (Anns
as, w
pmod)
where as :: Anns
as = w -> ApiAnns -> Anns
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> ApiAnns -> Anns
relativiseApiAnns w
pmod ApiAnns
apianns
runParser :: GHC.P a -> GHC.DynFlags -> FilePath -> String -> GHC.ParseResult a
runParser :: P a -> DynFlags -> FilePath -> FilePath -> ParseResult a
runParser parser :: P a
parser flags :: DynFlags
flags filename :: FilePath
filename str :: 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) 1 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 :: (DynFlags -> a) -> IO a
withDynFlags action :: 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 [InstalledUnitId] -> Ghc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ghc [InstalledUnitId] -> Ghc ())
-> Ghc [InstalledUnitId] -> Ghc ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Ghc [InstalledUnitId]
forall (m :: * -> *). GhcMonad m => DynFlags -> m [InstalledUnitId]
GHC.setSessionDynFlags DynFlags
dflags
a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags -> a
action DynFlags
dflags)
parseFile :: GHC.DynFlags -> FilePath -> String -> GHC.ParseResult (GHC.Located (GHC.HsModule GhcPs))
parseFile :: DynFlags
-> FilePath -> FilePath -> ParseResult (Located (HsModule GhcPs))
parseFile = P (Located (HsModule GhcPs))
-> DynFlags
-> FilePath
-> FilePath
-> ParseResult (Located (HsModule GhcPs))
forall a. P a -> DynFlags -> FilePath -> FilePath -> ParseResult a
runParser P (Located (HsModule GhcPs))
GHC.parseModule
type Parser a = GHC.DynFlags -> FilePath -> String
-> Either (GHC.SrcSpan, String)
(Anns, a)
parseExpr :: Parser (GHC.LHsExpr GhcPs)
parseExpr :: Parser (LHsExpr GhcPs)
parseExpr df :: DynFlags
df fp :: FilePath
fp = DynFlags
-> FilePath
-> P (LHsExpr GhcPs)
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, LHsExpr GhcPs)
forall w.
(Data (SrcSpanLess w), Annotate w, HasSrcSpan w) =>
DynFlags
-> FilePath
-> P w
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, w)
parseWith DynFlags
df FilePath
fp P (LHsExpr GhcPs)
GHC.parseExpression
parseImport :: Parser (GHC.LImportDecl GhcPs)
parseImport :: Parser (LImportDecl GhcPs)
parseImport df :: DynFlags
df fp :: FilePath
fp = DynFlags
-> FilePath
-> P (LImportDecl GhcPs)
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, LImportDecl GhcPs)
forall w.
(Data (SrcSpanLess w), Annotate w, HasSrcSpan w) =>
DynFlags
-> FilePath
-> P w
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, w)
parseWith DynFlags
df FilePath
fp P (LImportDecl GhcPs)
GHC.parseImport
parseType :: Parser (GHC.LHsType GhcPs)
parseType :: Parser (LHsType GhcPs)
parseType df :: DynFlags
df fp :: FilePath
fp = DynFlags
-> FilePath
-> P (LHsType GhcPs)
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, LHsType GhcPs)
forall w.
(Data (SrcSpanLess w), Annotate w, HasSrcSpan w) =>
DynFlags
-> FilePath
-> P w
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, 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 df :: DynFlags
df fp :: FilePath
fp = DynFlags
-> FilePath
-> P (LHsDecl GhcPs)
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, LHsDecl GhcPs)
forall w.
(Data (SrcSpanLess w), Annotate w, HasSrcSpan w) =>
DynFlags
-> FilePath
-> P w
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, w)
parseWith DynFlags
df FilePath
fp P (LHsDecl GhcPs)
GHC.parseDeclaration
#endif
parseStmt :: Parser (GHC.ExprLStmt GhcPs)
parseStmt :: Parser (ExprLStmt GhcPs)
parseStmt df :: DynFlags
df fp :: FilePath
fp = DynFlags
-> FilePath
-> P (ExprLStmt GhcPs)
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, ExprLStmt GhcPs)
forall w.
(Data (SrcSpanLess w), Annotate w, HasSrcSpan w) =>
DynFlags
-> FilePath
-> P w
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, w)
parseWith DynFlags
df FilePath
fp P (ExprLStmt GhcPs)
GHC.parseStatement
parsePattern :: Parser (GHC.LPat GhcPs)
parsePattern :: Parser (LPat GhcPs)
parsePattern df :: DynFlags
df fp :: FilePath
fp = DynFlags
-> FilePath
-> P (LPat GhcPs)
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, LPat GhcPs)
forall w.
(Data (SrcSpanLess w), Annotate w, HasSrcSpan w) =>
DynFlags
-> FilePath
-> P w
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, w)
parseWith DynFlags
df FilePath
fp P (LPat GhcPs)
GHC.parsePattern
parseModule
:: FilePath -> IO (Either (GHC.SrcSpan, String) (Anns, GHC.ParsedSource))
parseModule :: FilePath
-> IO (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
parseModule = CppOptions
-> DeltaOptions
-> FilePath
-> IO (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
parseModuleWithCpp CppOptions
defaultCppOptions DeltaOptions
normalLayout
parseModuleFromString
:: FilePath
-> String
-> IO (Either (GHC.SrcSpan, String) (Anns, GHC.ParsedSource))
parseModuleFromString :: FilePath
-> FilePath
-> IO (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
parseModuleFromString fp :: FilePath
fp s :: FilePath
s = Ghc (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
-> IO (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
forall a. Ghc a -> IO a
ghcWrapper (Ghc (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
-> IO
(Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs))))
-> Ghc
(Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
-> IO (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
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
Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs))
-> Ghc
(Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs))
-> Ghc
(Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs))))
-> Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs))
-> Ghc
(Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
forall a b. (a -> b) -> a -> b
$ DynFlags
-> FilePath
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs))
parseModuleFromStringInternal DynFlags
dflags FilePath
fp FilePath
s
parseModuleFromStringInternal
:: GHC.DynFlags
-> FilePath
-> String
-> Either (GHC.SrcSpan, String) (Anns, GHC.ParsedSource)
parseModuleFromStringInternal :: DynFlags
-> FilePath
-> FilePath
-> Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs))
parseModuleFromStringInternal dflags :: DynFlags
dflags fileName :: FilePath
fileName str :: FilePath
str =
let (str1 :: FilePath
str1, lp :: [Comment]
lp) = FilePath -> (FilePath, [Comment])
stripLinePragmas FilePath
str
res :: Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
res = case P (Located (HsModule GhcPs))
-> DynFlags
-> FilePath
-> FilePath
-> ParseResult (Located (HsModule GhcPs))
forall a. P a -> DynFlags -> FilePath -> FilePath -> ParseResult a
runParser P (Located (HsModule GhcPs))
GHC.parseModule DynFlags
dflags FilePath
fileName FilePath
str1 of
#if __GLASGOW_HASKELL__ >= 804
GHC.PFailed _ ss :: SrcSpan
ss m :: MsgDoc
m -> (SrcSpan, FilePath)
-> Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
forall a b. a -> Either a b
Left (SrcSpan
ss, DynFlags -> MsgDoc -> FilePath
GHC.showSDoc DynFlags
dflags MsgDoc
m)
#else
GHC.PFailed ss m -> Left (ss, GHC.showSDoc dflags m)
#endif
GHC.POk x :: PState
x pmod :: Located (HsModule GhcPs)
pmod -> (ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
forall a b. b -> Either a b
Right ((ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
-> (ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
forall a b. (a -> b) -> a -> b
$ (PState -> ApiAnns
mkApiAnns PState
x, [Comment]
lp, DynFlags
dflags, Located (HsModule GhcPs)
pmod)
in Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> DeltaOptions
-> Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs))
forall a.
Either a (ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> DeltaOptions -> Either a (Anns, Located (HsModule GhcPs))
postParseTransform Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
res DeltaOptions
normalLayout
parseModuleWithOptions :: DeltaOptions
-> FilePath
-> IO (Either (GHC.SrcSpan, String)
(Anns, GHC.ParsedSource))
parseModuleWithOptions :: DeltaOptions
-> FilePath
-> IO (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
parseModuleWithOptions opts :: DeltaOptions
opts fp :: FilePath
fp =
CppOptions
-> DeltaOptions
-> FilePath
-> IO (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
parseModuleWithCpp CppOptions
defaultCppOptions DeltaOptions
opts FilePath
fp
parseModuleWithCpp
:: CppOptions
-> DeltaOptions
-> FilePath
-> IO (Either (GHC.SrcSpan, String) (Anns, GHC.ParsedSource))
parseModuleWithCpp :: CppOptions
-> DeltaOptions
-> FilePath
-> IO (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
parseModuleWithCpp cpp :: CppOptions
cpp opts :: DeltaOptions
opts fp :: FilePath
fp = do
Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
res <- CppOptions
-> FilePath
-> IO
(Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
parseModuleApiAnnsWithCpp CppOptions
cpp FilePath
fp
Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs))
-> IO (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs))
-> IO
(Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs))))
-> Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs))
-> IO (Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs)))
forall a b. (a -> b) -> a -> b
$ Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> DeltaOptions
-> Either (SrcSpan, FilePath) (Anns, Located (HsModule GhcPs))
forall a.
Either a (ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> DeltaOptions -> Either a (Anns, Located (HsModule GhcPs))
postParseTransform Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
res DeltaOptions
opts
parseModuleApiAnnsWithCpp
:: CppOptions
-> FilePath
-> IO
( Either
(GHC.SrcSpan, String)
(GHC.ApiAnns, [Comment], GHC.DynFlags, GHC.ParsedSource)
)
parseModuleApiAnnsWithCpp :: CppOptions
-> FilePath
-> IO
(Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
parseModuleApiAnnsWithCpp cppOptions :: CppOptions
cppOptions file :: FilePath
file = Ghc
(Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
-> IO
(Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
forall a. Ghc a -> IO a
ghcWrapper (Ghc
(Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
-> IO
(Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))))
-> Ghc
(Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
-> IO
(Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
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
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
forall (m :: * -> *).
GhcMonad m =>
CppOptions
-> DynFlags
-> FilePath
-> m (Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
parseModuleApiAnnsWithCppInternal CppOptions
cppOptions DynFlags
dflags FilePath
file
ghcWrapper :: GHC.Ghc a -> IO a
ghcWrapper :: Ghc a -> IO a
ghcWrapper =
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)
parseModuleApiAnnsWithCppInternal
:: GHC.GhcMonad m
=> CppOptions
-> GHC.DynFlags
-> FilePath
-> m
( Either
(GHC.SrcSpan, String)
(GHC.ApiAnns, [Comment], GHC.DynFlags, GHC.ParsedSource)
)
parseModuleApiAnnsWithCppInternal :: CppOptions
-> DynFlags
-> FilePath
-> m (Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
parseModuleApiAnnsWithCppInternal cppOptions :: CppOptions
cppOptions dflags :: DynFlags
dflags file :: 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
(fileContents :: FilePath
fileContents, injectedComments :: [Comment]
injectedComments, dflags' :: DynFlags
dflags') <-
if Bool
useCpp
then do
(contents :: FilePath
contents,dflags1 :: 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 (contents1 :: FilePath
contents1,lp :: [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
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> m (Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> m (Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))))
-> Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> m (Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
forall a b. (a -> b) -> a -> b
$
case DynFlags
-> FilePath -> FilePath -> ParseResult (Located (HsModule GhcPs))
parseFile DynFlags
dflags' FilePath
file FilePath
fileContents of
#if __GLASGOW_HASKELL__ >= 804
GHC.PFailed _ ss :: SrcSpan
ss m :: MsgDoc
m -> (SrcSpan, FilePath)
-> Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
forall a b. a -> Either a b
Left ((SrcSpan, FilePath)
-> Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
-> (SrcSpan, FilePath)
-> Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
forall a b. (a -> b) -> a -> b
$ (SrcSpan
ss, (DynFlags -> MsgDoc -> FilePath
GHC.showSDoc DynFlags
dflags MsgDoc
m))
#else
GHC.PFailed ss m -> Left $ (ss, (GHC.showSDoc dflags m))
#endif
GHC.POk (PState -> ApiAnns
mkApiAnns -> ApiAnns
apianns) pmod :: Located (HsModule GhcPs)
pmod ->
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
forall a b. b -> Either a b
Right ((ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs)))
-> (ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> Either
(SrcSpan, FilePath)
(ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
forall a b. (a -> b) -> a -> b
$ (ApiAnns
apianns, [Comment]
injectedComments, DynFlags
dflags', Located (HsModule GhcPs)
pmod)
postParseTransform
:: Either a (GHC.ApiAnns, [Comment], GHC.DynFlags, GHC.ParsedSource)
-> DeltaOptions
-> Either a (Anns, GHC.ParsedSource)
postParseTransform :: Either a (ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> DeltaOptions -> Either a (Anns, Located (HsModule GhcPs))
postParseTransform parseRes :: Either a (ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
parseRes opts :: DeltaOptions
opts = (a -> Either a (Anns, Located (HsModule GhcPs)))
-> ((ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> Either a (Anns, Located (HsModule GhcPs)))
-> Either
a (ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> Either a (Anns, Located (HsModule GhcPs))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either a (Anns, Located (HsModule GhcPs))
forall a b. a -> Either a b
Left (ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
-> Either a (Anns, Located (HsModule GhcPs))
forall b c a.
(Annotate b, HasSrcSpan b, Data (SrcSpanLess b)) =>
(ApiAnns, [Comment], c, b) -> Either a (Anns, b)
mkAnns Either a (ApiAnns, [Comment], DynFlags, Located (HsModule GhcPs))
parseRes
where
mkAnns :: (ApiAnns, [Comment], c, b) -> Either a (Anns, b)
mkAnns (apianns :: ApiAnns
apianns, cs :: [Comment]
cs, _, m :: b
m) =
(Anns, b) -> Either a (Anns, b)
forall a b. b -> Either a b
Right (DeltaOptions -> [Comment] -> b -> ApiAnns -> Anns
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
DeltaOptions -> [Comment] -> ast -> ApiAnns -> Anns
relativiseApiAnnsWithOptions DeltaOptions
opts [Comment]
cs b
m ApiAnns
apianns, b
m)
initDynFlags :: GHC.GhcMonad m => FilePath -> m GHC.DynFlags
initDynFlags :: FilePath -> m DynFlags
initDynFlags file :: 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
(dflags1 :: DynFlags
dflags1, _, _) <- 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
(dflags3 :: DynFlags
dflags3, _, _) <- DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
GHC.parseDynamicFlagsCmdLine
DynFlags
dflags2
[SrcSpanLess (Located FilePath) -> Located FilePath
forall a. HasSrcSpan a => SrcSpanLess a -> a
GHC.noLoc SrcSpanLess (Located FilePath)
"-hide-all-packages"]
[InstalledUnitId]
_ <- DynFlags -> m [InstalledUnitId]
forall (m :: * -> *). GhcMonad m => DynFlags -> m [InstalledUnitId]
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 :: FilePath -> FilePath -> m DynFlags
initDynFlagsPure fp :: FilePath
fp s :: 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
(dflags1 :: DynFlags
dflags1, _, _) <- 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
(dflags3 :: DynFlags
dflags3, _, _) <- DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
GHC.parseDynamicFlagsCmdLine
DynFlags
dflags2
[SrcSpanLess (Located FilePath) -> Located FilePath
forall a. HasSrcSpan a => SrcSpanLess a -> a
GHC.noLoc SrcSpanLess (Located FilePath)
"-hide-all-packages"]
[InstalledUnitId]
_ <- DynFlags -> m [InstalledUnitId]
forall (m :: * -> *). GhcMonad m => DynFlags -> m [InstalledUnitId]
GHC.setSessionDynFlags DynFlags
dflags3
DynFlags -> m DynFlags
forall (m :: * -> *) a. Monad m => a -> m a
return DynFlags
dflags3
mkApiAnns :: GHC.PState -> GHC.ApiAnns
mkApiAnns :: PState -> ApiAnns
mkApiAnns pstate :: PState
pstate
= ( ([SrcSpan] -> [SrcSpan] -> [SrcSpan])
-> [(ApiAnnKey, [SrcSpan])] -> Map ApiAnnKey [SrcSpan]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
(++) ([(ApiAnnKey, [SrcSpan])] -> Map ApiAnnKey [SrcSpan])
-> (PState -> [(ApiAnnKey, [SrcSpan])])
-> PState
-> Map ApiAnnKey [SrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PState -> [(ApiAnnKey, [SrcSpan])]
GHC.annotations (PState -> Map ApiAnnKey [SrcSpan])
-> PState -> Map ApiAnnKey [SrcSpan]
forall a b. (a -> b) -> a -> b
$ PState
pstate
, [(SrcSpan, [Located AnnotationComment])]
-> Map SrcSpan [Located AnnotationComment]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((SrcSpan
GHC.noSrcSpan, PState -> [Located AnnotationComment]
GHC.comment_q PState
pstate) (SrcSpan, [Located AnnotationComment])
-> [(SrcSpan, [Located AnnotationComment])]
-> [(SrcSpan, [Located AnnotationComment])]
forall a. a -> [a] -> [a]
: PState -> [(SrcSpan, [Located AnnotationComment])]
GHC.annotations_comments PState
pstate))