{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
module Language.Haskell.Meta.Parse (parseExp, parseExpWithExts, parseExpWithFlags, parseHsExpr) where
#if MIN_VERSION_ghc(9,4,0)
import GHC.Parser.Errors.Ppr ()
import GHC.Parser.Annotation (LocatedA)
import GHC.Utils.Outputable
#elif MIN_VERSION_ghc(9,2,0)
import qualified GHC.Parser.Errors.Ppr as ParserErrorPpr
import GHC.Parser.Annotation (LocatedA)
#endif
#if MIN_VERSION_ghc(9,4,0)
import GHC.Driver.Config.Parser (initParserOpts)
#elif MIN_VERSION_ghc(9,2,0)
import GHC.Driver.Config (initParserOpts)
#endif
#if MIN_VERSION_ghc(9,0,0)
import GHC.Parser.PostProcess
import qualified GHC.Types.SrcLoc as SrcLoc
import GHC.Driver.Session
import GHC.Data.StringBuffer
import GHC.Parser.Lexer
import qualified GHC.Parser.Lexer as Lexer
import qualified GHC.Parser as Parser
import GHC.Data.FastString
import GHC.Types.SrcLoc
#else
import qualified SrcLoc
import DynFlags (DynFlags)
import Lexer (ParseResult (..), PState (..))
import StringBuffer
import Lexer
import qualified Parser
import FastString
import SrcLoc
import RdrName
import RdrHsSyn (runECP_P)
#endif
import GHC.Hs.Extension (GhcPs)
#if MIN_VERSION_ghc(9,2,0)
import Language.Haskell.Syntax (HsExpr(..))
#else
import GHC.Hs.Expr (HsExpr(..))
#endif
import Language.Haskell.TH (Extension(..))
import qualified Language.Haskell.TH.Syntax as TH
import qualified Language.Haskell.Meta.Settings as Settings
import Language.Haskell.Meta.Translate (toExp)
parseExp :: String -> Either (Int, Int, String) TH.Exp
#if MIN_VERSION_ghc(9,2,0)
parseExp :: String -> Either (Int, Int, String) Exp
parseExp = [Extension] -> String -> Either (Int, Int, String) Exp
parseExpWithExts
[ Extension
TypeApplications
, Extension
OverloadedRecordDot
, Extension
OverloadedLabels
, Extension
OverloadedRecordUpdate
]
#else
parseExp = parseExpWithExts
[ TypeApplications
, OverloadedLabels
]
#endif
parseExpWithExts :: [Extension] -> String -> Either (Int, Int, String) TH.Exp
parseExpWithExts :: [Extension] -> String -> Either (Int, Int, String) Exp
parseExpWithExts [Extension]
exts = DynFlags -> String -> Either (Int, Int, String) Exp
parseExpWithFlags ([Extension] -> DynFlags
Settings.baseDynFlags [Extension]
exts)
parseExpWithFlags :: DynFlags -> String -> Either (Int, Int, String) TH.Exp
parseExpWithFlags :: DynFlags -> String -> Either (Int, Int, String) Exp
parseExpWithFlags DynFlags
flags String
expStr = do
HsExpr GhcPs
hsExpr <- DynFlags -> String -> Either (Int, Int, String) (HsExpr GhcPs)
parseHsExpr DynFlags
flags String
expStr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
flags HsExpr GhcPs
hsExpr)
parseHsExpr :: DynFlags -> String -> Either (Int, Int, String) (HsExpr GhcPs)
parseHsExpr :: DynFlags -> String -> Either (Int, Int, String) (HsExpr GhcPs)
parseHsExpr DynFlags
dynFlags String
s =
case DynFlags -> String -> ParseResult (LocatedA (HsExpr GhcPs))
runParser DynFlags
dynFlags String
s of
POk PState
_ LocatedA (HsExpr GhcPs)
locatedExpr ->
let expr :: HsExpr GhcPs
expr = forall l e. GenLocated l e -> e
SrcLoc.unLoc LocatedA (HsExpr GhcPs)
locatedExpr
in forall a b. b -> Either a b
Right
HsExpr GhcPs
expr
#if MIN_VERSION_ghc(9,4,0)
PFailed PState{loc=SrcLoc.psRealLoc -> srcLoc, errors=errorMessages} ->
let
err = renderWithContext defaultSDocContext (ppr errorMessages)
line = SrcLoc.srcLocLine srcLoc
col = SrcLoc.srcLocCol srcLoc
in Left (line, col, err)
#elif MIN_VERSION_ghc(9,2,0)
PFailed PState{loc :: PState -> PsLoc
loc=PsLoc -> RealSrcLoc
SrcLoc.psRealLoc -> RealSrcLoc
srcLoc, errors :: PState -> Bag PsError
errors=Bag PsError
errorMessages} ->
let
psErrToString :: PsError -> String
psErrToString PsError
e = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ PsError -> MsgEnvelope DecoratedSDoc
ParserErrorPpr.pprError PsError
e
err :: String
err = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PsError -> String
psErrToString Bag PsError
errorMessages
line :: Int
line = RealSrcLoc -> Int
SrcLoc.srcLocLine RealSrcLoc
srcLoc
col :: Int
col = RealSrcLoc -> Int
SrcLoc.srcLocCol RealSrcLoc
srcLoc
in forall a b. a -> Either a b
Left (Int
line, Int
col, String
err)
#else
#if MIN_VERSION_ghc(9,0,0)
PFailed PState{loc=SrcLoc.psRealLoc -> srcLoc, messages=msgs} ->
#elif MIN_VERSION_ghc(8,10,0)
PFailed PState{loc=srcLoc, messages=msgs} ->
#endif
let
(_warnMessages, errorMessages) = msgs dynFlags
err = concatMap show errorMessages
line = SrcLoc.srcLocLine srcLoc
col = SrcLoc.srcLocCol srcLoc
in Left (line, col, err)
#endif
parse :: P a -> String -> DynFlags -> ParseResult a
parse :: forall a. P a -> String -> DynFlags -> ParseResult a
parse P a
p String
str DynFlags
flags =
forall a. P a -> PState -> ParseResult a
Lexer.unP P a
p PState
parseState
where
location :: RealSrcLoc
location = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (String -> FastString
mkFastString String
"<string>") Int
1 Int
1
strBuffer :: StringBuffer
strBuffer = String -> StringBuffer
stringToStringBuffer String
str
parseState :: PState
parseState =
#if MIN_VERSION_ghc(9, 2, 0)
ParserOpts -> StringBuffer -> RealSrcLoc -> PState
initParserState (DynFlags -> ParserOpts
initParserOpts DynFlags
flags) StringBuffer
strBuffer RealSrcLoc
location
#else
mkPState flags strBuffer location
#endif
#if MIN_VERSION_ghc(9, 2, 0)
runParser :: DynFlags -> String -> ParseResult (LocatedA (HsExpr GhcPs))
runParser :: DynFlags -> String -> ParseResult (LocatedA (HsExpr GhcPs))
runParser DynFlags
flags String
str =
case forall a. P a -> String -> DynFlags -> ParseResult a
parse P ECP
Parser.parseExpression String
str DynFlags
flags of
POk PState
s ECP
e -> forall a. P a -> PState -> ParseResult a
unP (forall a. PV a -> P a
runPV (ECP -> forall b. DisambECP b => PV (LocatedA b)
unECP ECP
e)) PState
s
PFailed PState
ps -> forall a. PState -> ParseResult a
PFailed PState
ps
#elif MIN_VERSION_ghc(8, 10, 0)
runParser :: DynFlags -> String -> ParseResult (Located (HsExpr GhcPs))
runParser flags str =
case parse Parser.parseExpression str flags of
POk s e -> unP (runECP_P e) s
PFailed ps -> PFailed ps
#else
parseExpression = parse Parser.parseExpression
#endif