{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
module Language.Haskell.Meta.Parse (parseExp, parseExpWithExts, parseExpWithFlags, parseHsExpr) where
#if MIN_VERSION_ghc(9,2,0)
import qualified GHC.Parser.Errors.Ppr as ParserErrorPpr
import GHC.Driver.Config (initParserOpts)
import GHC.Parser.Annotation (LocatedA)
#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 = parseExpWithExts
[ TypeApplications
, OverloadedRecordDot
, OverloadedLabels
, OverloadedRecordUpdate
]
#else
parseExp :: String -> Either (Int, Int, String) Exp
parseExp = [Extension] -> String -> Either (Int, Int, String) Exp
parseExpWithExts
[ Extension
TypeApplications
]
#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
Exp -> Either (Int, Int, String) Exp
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 (Located (HsExpr GhcPs))
runParser DynFlags
dynFlags String
s of
POk PState
_ Located (HsExpr GhcPs)
locatedExpr ->
let expr :: HsExpr GhcPs
expr = Located (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
SrcLoc.unLoc Located (HsExpr GhcPs)
locatedExpr
in HsExpr GhcPs -> Either (Int, Int, String) (HsExpr GhcPs)
forall a b. b -> Either a b
Right
HsExpr GhcPs
expr
#if MIN_VERSION_ghc(9,2,0)
PFailed PState{loc=SrcLoc.psRealLoc -> srcLoc, errors=errorMessages} ->
let
psErrToString e = show $ ParserErrorPpr.pprError e
err = concatMap psErrToString errorMessages
line = SrcLoc.srcLocLine srcLoc
col = SrcLoc.srcLocCol srcLoc
in Left (line, col, err)
#else
#if MIN_VERSION_ghc(9,0,0)
PFailed PState{loc :: PState -> PsLoc
loc=PsLoc -> RealSrcLoc
SrcLoc.psRealLoc -> RealSrcLoc
srcLoc, messages :: PState -> DynFlags -> Messages
messages=DynFlags -> Messages
msgs} ->
#elif MIN_VERSION_ghc(8,10,0)
PFailed PState{loc=srcLoc, messages=msgs} ->
#endif
let
(WarningMessages
_warnMessages, WarningMessages
errorMessages) = DynFlags -> Messages
msgs DynFlags
dynFlags
err :: String
err = (ErrMsg -> String) -> WarningMessages -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ErrMsg -> String
forall a. Show a => a -> String
show WarningMessages
errorMessages
line :: Int
line = RealSrcLoc -> Int
SrcLoc.srcLocLine RealSrcLoc
srcLoc
col :: Int
col = RealSrcLoc -> Int
SrcLoc.srcLocCol RealSrcLoc
srcLoc
in (Int, Int, String) -> Either (Int, Int, String) (HsExpr GhcPs)
forall a b. a -> Either a b
Left (Int
line, Int
col, String
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 =
P a -> PState -> ParseResult a
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)
initParserState (initParserOpts flags) strBuffer location
#else
DynFlags -> StringBuffer -> RealSrcLoc -> PState
mkPState DynFlags
flags StringBuffer
strBuffer RealSrcLoc
location
#endif
#if MIN_VERSION_ghc(9, 2, 0)
runParser :: DynFlags -> String -> ParseResult (LocatedA (HsExpr GhcPs))
runParser flags str =
case parse Parser.parseExpression str flags of
POk s e -> unP (runPV (unECP e)) s
PFailed ps -> PFailed ps
#elif MIN_VERSION_ghc(8, 10, 0)
runParser :: DynFlags -> String -> ParseResult (Located (HsExpr GhcPs))
runParser :: DynFlags -> String -> ParseResult (Located (HsExpr GhcPs))
runParser DynFlags
flags String
str =
case P ECP -> String -> DynFlags -> ParseResult ECP
forall a. P a -> String -> DynFlags -> ParseResult a
parse P ECP
Parser.parseExpression String
str DynFlags
flags of
POk PState
s ECP
e -> P (Located (HsExpr GhcPs))
-> PState -> ParseResult (Located (HsExpr GhcPs))
forall a. P a -> PState -> ParseResult a
unP (ECP -> P (Located (HsExpr GhcPs))
forall b. DisambECP b => ECP -> P (Located b)
runECP_P ECP
e) PState
s
PFailed PState
ps -> PState -> ParseResult (Located (HsExpr GhcPs))
forall a. PState -> ParseResult a
PFailed PState
ps
#else
parseExpression = parse Parser.parseExpression
#endif