{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module PyF.Internal.Parser (parseExpression) where
#if MIN_VERSION_ghc(9,6,0)
import GHC.Parser.Errors.Types (PsMessage)
#endif
#if MIN_VERSION_ghc(9,0,0)
import GHC.Parser.Lexer (ParseResult (..), PState (..))
#elif MIN_VERSION_ghc(8,10,0)
import Lexer (ParseResult (..), PState (..))
#else
import Lexer (ParseResult (..))
#endif
#if MIN_VERSION_ghc(9,3,0)
import GHC.Types.Error
import GHC.Utils.Outputable
import GHC.Utils.Error
#endif
#if MIN_VERSION_ghc(9,4,0)
#elif MIN_VERSION_ghc(9,2,0)
import qualified GHC.Parser.Errors.Ppr as ParserErrorPpr
#endif
#if MIN_VERSION_ghc(9,0,0)
import qualified GHC.Types.SrcLoc as SrcLoc
#endif
#if MIN_VERSION_ghc(9,0,0)
import GHC.Driver.Session (DynFlags)
import GHC.Types.SrcLoc
#else
import DynFlags (DynFlags)
import SrcLoc
#endif
#if MIN_VERSION_ghc(8,10,0)
import GHC.Hs.Expr as Expr
import GHC.Hs.Extension as Ext
#else
import HsExpr as Expr
import HsExtension as Ext
import Outputable (showSDoc)
#endif
import qualified PyF.Internal.ParserEx as ParseExp
parseExpression :: RealSrcLoc -> String -> DynFlags -> Either (Int, Int, String) (HsExpr GhcPs)
parseExpression :: RealSrcLoc
-> String -> DynFlags -> Either (Int, Int, String) (HsExpr GhcPs)
parseExpression RealSrcLoc
initLoc String
s DynFlags
dynFlags =
case RealSrcLoc
-> String -> DynFlags -> ParseResult (LocatedA (HsExpr GhcPs))
ParseExp.parseExpression RealSrcLoc
initLoc String
s DynFlags
dynFlags of
POk PState
_ LocatedA (HsExpr GhcPs)
locatedExpr ->
let expr :: HsExpr GhcPs
expr = LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
SrcLoc.unLoc LocatedA (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 :: PState -> PsLoc
loc=PsLoc -> RealSrcLoc
SrcLoc.psRealLoc -> RealSrcLoc
srcLoc, errors :: PState -> Messages PsMessage
errors=Messages PsMessage
errorMessages} ->
#elif 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} ->
#else
PFailed _ (SrcLoc.srcSpanEnd -> SrcLoc.RealSrcLoc srcLoc) doc ->
#endif
#if MIN_VERSION_ghc(9,7,0)
let
err = renderWithContext defaultSDocContext
$ vcat
$ map formatBulleted
$ map (\psMessage -> diagnosticMessage (defaultDiagnosticOpts @PsMessage) psMessage)
$ map errMsgDiagnostic
$ sortMsgBag Nothing
$ getMessages $ errorMessages
line' = SrcLoc.srcLocLine srcLoc
col = SrcLoc.srcLocCol srcLoc
in Left (line', col, err)
#elif MIN_VERSION_ghc(9,6,0)
let
err :: String
err = SDocContext -> SDoc -> String
renderWithContext SDocContext
defaultSDocContext
(SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (DecoratedSDoc -> SDoc) -> [DecoratedSDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDocContext -> DecoratedSDoc -> SDoc
formatBulleted SDocContext
defaultSDocContext)
([DecoratedSDoc] -> [SDoc]) -> [DecoratedSDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (PsMessage -> DecoratedSDoc) -> [PsMessage] -> [DecoratedSDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\PsMessage
psMessage -> DiagnosticOpts PsMessage -> PsMessage -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (forall a. Diagnostic a => DiagnosticOpts a
defaultDiagnosticOpts @PsMessage) PsMessage
psMessage)
([PsMessage] -> [DecoratedSDoc]) -> [PsMessage] -> [DecoratedSDoc]
forall a b. (a -> b) -> a -> b
$ (MsgEnvelope PsMessage -> PsMessage)
-> [MsgEnvelope PsMessage] -> [PsMessage]
forall a b. (a -> b) -> [a] -> [b]
map MsgEnvelope PsMessage -> PsMessage
forall e. MsgEnvelope e -> e
errMsgDiagnostic
([MsgEnvelope PsMessage] -> [PsMessage])
-> [MsgEnvelope PsMessage] -> [PsMessage]
forall a b. (a -> b) -> a -> b
$ Maybe DiagOpts
-> Bag (MsgEnvelope PsMessage) -> [MsgEnvelope PsMessage]
forall e. Maybe DiagOpts -> Bag (MsgEnvelope e) -> [MsgEnvelope e]
sortMsgBag Maybe DiagOpts
forall a. Maybe a
Nothing
(Bag (MsgEnvelope PsMessage) -> [MsgEnvelope PsMessage])
-> Bag (MsgEnvelope PsMessage) -> [MsgEnvelope PsMessage]
forall a b. (a -> b) -> a -> b
$ Messages PsMessage -> Bag (MsgEnvelope PsMessage)
forall e. Messages e -> Bag (MsgEnvelope e)
getMessages (Messages PsMessage -> Bag (MsgEnvelope PsMessage))
-> Messages PsMessage -> Bag (MsgEnvelope PsMessage)
forall a b. (a -> b) -> a -> b
$ Messages PsMessage
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)
#elif MIN_VERSION_ghc(9,3,0)
let
err = renderWithContext defaultSDocContext
$ vcat
$ map (formatBulleted defaultSDocContext)
$ map diagnosticMessage
$ map errMsgDiagnostic
$ sortMsgBag Nothing
$ getMessages $ errorMessages
line = SrcLoc.srcLocLine srcLoc
col = SrcLoc.srcLocCol srcLoc
in Left (line, col, err)
#elif MIN_VERSION_ghc(9,2,0)
let
psErrToString e = show $ ParserErrorPpr.pprError e
err = concatMap psErrToString errorMessages
line = SrcLoc.srcLocLine srcLoc
col = SrcLoc.srcLocCol srcLoc
in Left (line, col, err)
#elif MIN_VERSION_ghc(8,10,0)
let
(_warnMessages, errorMessages) = msgs dynFlags
err = concatMap show errorMessages
line = SrcLoc.srcLocLine srcLoc
col = SrcLoc.srcLocCol srcLoc
in Left (line, col, err)
#else
let err = showSDoc dynFlags doc
line = SrcLoc.srcLocLine srcLoc
col = SrcLoc.srcLocCol srcLoc
in Left (line, col, err)
#endif
#if MIN_VERSION_ghc(8,10,0)
#elif MIN_VERSION_ghc(8,6,0)
PFailed _ _ _ -> error "The impossible happen: this case is not possible"
#endif