{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
#if __GLASGOW_HASKELL__ >= 810
{-# LANGUAGE EmptyCase #-}
#endif
module Test.Hspec.Core.Formatters.Pretty.Parser (
  Expression(..)
, Literal(..)
, parseExpression
, unsafeParseExpression
) where

import           Prelude ()
import           Test.Hspec.Core.Compat hiding (fail)
import           Test.Hspec.Core.Formatters.Pretty.Parser.Types

#ifndef __GHCJS__
#if __GLASGOW_HASKELL__ >= 802 && __GLASGOW_HASKELL__ <= 902
#define PRETTY_PRINTING_SUPPORTED
#endif
#endif

#ifndef PRETTY_PRINTING_SUPPORTED

parseExpression :: String -> Maybe Expression
parseExpression _ = Nothing

unsafeParseExpression :: String -> Maybe Expression
unsafeParseExpression _ = Nothing

#else

import           GHC.Stack
import           GHC.Exception (throw, errorCallWithCallStackException)

#if __GLASGOW_HASKELL__ >= 804
import           GHC.LanguageExtensions.Type
#endif

#if __GLASGOW_HASKELL__ >= 902
import           GHC.Types.SourceText
#elif __GLASGOW_HASKELL__ >= 900
import           GHC.Types.Basic
import           GHC.Unit.Types
#endif

#if __GLASGOW_HASKELL__ >= 900
import qualified GHC.Parser as GHC
import           GHC.Parser.Lexer
import           GHC.Data.StringBuffer
import           GHC.Data.FastString
import           GHC.Types.SrcLoc
import qualified GHC.Data.EnumSet as EnumSet
import           GHC.Types.Name
import           GHC.Types.Name.Reader
import           GHC.Parser.PostProcess hiding (Tuple)
#else
import           Lexer
import qualified Parser as GHC
import           StringBuffer
import           FastString
import           SrcLoc
import           Name
import           RdrName
import           BasicTypes
import           Module
#if __GLASGOW_HASKELL__ >= 804
import qualified EnumSet
#endif
#endif

#if __GLASGOW_HASKELL__ == 810
import           RdrHsSyn hiding (Tuple)
#endif

#if __GLASGOW_HASKELL__ >= 810
import           GHC.Hs
#else
import           HsSyn
#endif

#if __GLASGOW_HASKELL__ <= 806
import           Data.Bits
import           Control.Exception
#endif

parseExpression :: String -> Maybe Expression
parseExpression :: String -> Maybe Expression
parseExpression = (Error -> Maybe Expression) -> String -> Maybe Expression
parseWith (Maybe Expression -> Error -> Maybe Expression
forall a b. a -> b -> a
const Maybe Expression
forall a. Maybe a
Nothing)

unsafeParseExpression :: String -> Maybe Expression
unsafeParseExpression :: String -> Maybe Expression
unsafeParseExpression = (Error -> Maybe Expression) -> String -> Maybe Expression
parseWith Error -> Maybe Expression
forall a. Error -> a
throwError

parseWith :: (Error -> Maybe Expression) -> String -> Maybe Expression
parseWith :: (Error -> Maybe Expression) -> String -> Maybe Expression
parseWith Error -> Maybe Expression
err = String -> Maybe (HsExpr GhcPs)
parse (String -> Maybe (HsExpr GhcPs))
-> (HsExpr GhcPs -> Maybe Expression) -> String -> Maybe Expression
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Error -> Maybe Expression)
-> (Expression -> Maybe Expression)
-> Either Error Expression
-> Maybe Expression
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Error -> Maybe Expression
err Expression -> Maybe Expression
forall a. a -> Maybe a
Just (Either Error Expression -> Maybe Expression)
-> (HsExpr GhcPs -> Either Error Expression)
-> HsExpr GhcPs
-> Maybe Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression

data Error = Error CallStack String

throwError :: Error -> a
throwError :: Error -> a
throwError (Error CallStack
stack String
err) = SomeException -> a
forall a e. Exception e => e -> a
throw (SomeException -> a) -> SomeException -> a
forall a b. (a -> b) -> a -> b
$ String -> CallStack -> SomeException
errorCallWithCallStackException String
err CallStack
stack

fail :: HasCallStack => String -> Either Error a
fail :: String -> Either Error a
fail = Error -> Either Error a
forall a b. a -> Either a b
Left (Error -> Either Error a)
-> (String -> Error) -> String -> Either Error a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> String -> Error
Error CallStack
HasCallStack => CallStack
callStack

class ToExpression a where
  toExpression :: a -> Either Error Expression

#if __GLASGOW_HASKELL__ < 806
#define _x
#endif

#if __GLASGOW_HASKELL__ >= 900
#define X(name, expr)
#elif __GLASGOW_HASKELL__ == 810
#define X(name, expr) name none -> case none of
#elif __GLASGOW_HASKELL__ >= 806
#define X(name, expr) name none -> case none of NoExt -> expr
#else
#define X(name, expr)
#endif

#if __GLASGOW_HASKELL__ >= 804
#define GhcPsHsLit GhcPs
#else
type GhcPs = RdrName
#define GhcPsHsLit
#endif

#if __GLASGOW_HASKELL__ >= 902
#define _listSynExpr
#endif

#if __GLASGOW_HASKELL__ >= 806
#define RecCon(name, fields) RecordCon _ (L _ name) fields
#else
#define RecCon(name, fields) RecordCon (L _ name) _ _ fields
#endif

#define REJECT(name) name{} -> fail "name"

instance ToExpression (HsExpr GhcPs) where
  toExpression :: HsExpr GhcPs -> Either Error Expression
toExpression HsExpr GhcPs
expr = case HsExpr GhcPs
expr of
    HsVar XVar GhcPs
_x Located (IdP GhcPs)
name -> Located RdrName -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression Located (IdP GhcPs)
Located RdrName
name
    HsLit XLitE GhcPs
_x HsLit GhcPs
lit -> HsLit GhcPs -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression HsLit GhcPs
lit
    HsOverLit XOverLitE GhcPs
_x HsOverLit GhcPs
lit -> HsOverLit GhcPs -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression HsOverLit GhcPs
lit
    HsApp XApp GhcPs
_x LHsExpr GhcPs
f LHsExpr GhcPs
x -> Expression -> Expression -> Expression
App (Expression -> Expression -> Expression)
-> Either Error Expression
-> Either Error (Expression -> Expression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression LHsExpr GhcPs
f Either Error (Expression -> Expression)
-> Either Error Expression -> Either Error Expression
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LHsExpr GhcPs -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression LHsExpr GhcPs
x
    NegApp XNegApp GhcPs
_x LHsExpr GhcPs
e SyntaxExpr GhcPs
_ -> LHsExpr GhcPs -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression LHsExpr GhcPs
e Either Error Expression
-> (Expression -> Either Error Expression)
-> Either Error Expression
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Expression
x -> case Expression
x of
      Literal (Rational Rational
n) -> Expression -> Either Error Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Either Error Expression)
-> Expression -> Either Error Expression
forall a b. (a -> b) -> a -> b
$ Literal -> Expression
Literal (Rational -> Literal
Rational (Rational -> Literal) -> Rational -> Literal
forall a b. (a -> b) -> a -> b
$ Rational -> Rational
forall a. Num a => a -> a
negate Rational
n)
      Literal (Integer Integer
n) -> Expression -> Either Error Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Either Error Expression)
-> Expression -> Either Error Expression
forall a b. (a -> b) -> a -> b
$ Literal -> Expression
Literal (Integer -> Literal
Integer (Integer -> Literal) -> Integer -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
negate Integer
n)
      Expression
_ -> String -> Either Error Expression
forall a. HasCallStack => String -> Either Error a
fail String
"NegApp"
    HsPar XPar GhcPs
_x LHsExpr GhcPs
e -> Expression -> Expression
Parentheses (Expression -> Expression)
-> Either Error Expression -> Either Error Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression LHsExpr GhcPs
e
    ExplicitTuple XExplicitTuple GhcPs
_x [LHsTupArg GhcPs]
xs Boxity
_ -> [Expression] -> Expression
Tuple ([Expression] -> Expression)
-> Either Error [Expression] -> Either Error Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LHsTupArg GhcPs -> Either Error Expression)
-> [LHsTupArg GhcPs] -> Either Error [Expression]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsTupArg GhcPs -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression [LHsTupArg GhcPs]
xs
    ExplicitList XExplicitList GhcPs
_ Maybe (SyntaxExpr GhcPs)
_listSynExpr [LHsExpr GhcPs]
xs -> [Expression] -> Expression
List ([Expression] -> Expression)
-> Either Error [Expression] -> Either Error Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LHsExpr GhcPs -> Either Error Expression)
-> [LHsExpr GhcPs] -> Either Error [Expression]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsExpr GhcPs -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression [LHsExpr GhcPs]
xs
    RecCon(name, fields) -> HsRecordBinds GhcPs
Record (showRdrName name) <$> (recordFields $ rec_flds fields)
      where
        fieldName :: HsRecField' (FieldOcc GhcPs) arg -> String
fieldName = FieldOcc GhcPs -> String
showFieldLabel (FieldOcc GhcPs -> String)
-> (HsRecField' (FieldOcc GhcPs) arg -> FieldOcc GhcPs)
-> HsRecField' (FieldOcc GhcPs) arg
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (FieldOcc GhcPs) -> FieldOcc GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located (FieldOcc GhcPs) -> FieldOcc GhcPs)
-> (HsRecField' (FieldOcc GhcPs) arg -> Located (FieldOcc GhcPs))
-> HsRecField' (FieldOcc GhcPs) arg
-> FieldOcc GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecField' (FieldOcc GhcPs) arg -> Located (FieldOcc GhcPs)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl
        recordFields :: [LHsRecField GhcPs (LHsExpr GhcPs)]
-> Either Error [(String, Expression)]
recordFields = (LHsRecField GhcPs (LHsExpr GhcPs)
 -> Either Error (String, Expression))
-> [LHsRecField GhcPs (LHsExpr GhcPs)]
-> Either Error [(String, Expression)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)
-> Either Error (String, Expression)
forall a.
ToExpression a =>
HsRecField' (FieldOcc GhcPs) a -> Either Error (String, Expression)
recordField (HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)
 -> Either Error (String, Expression))
-> (LHsRecField GhcPs (LHsExpr GhcPs)
    -> HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs))
-> LHsRecField GhcPs (LHsExpr GhcPs)
-> Either Error (String, Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsRecField GhcPs (LHsExpr GhcPs)
-> HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
        recordField :: HsRecField' (FieldOcc GhcPs) a -> Either Error (String, Expression)
recordField HsRecField' (FieldOcc GhcPs) a
field = (,) (HsRecField' (FieldOcc GhcPs) a -> String
forall arg. HsRecField' (FieldOcc GhcPs) arg -> String
fieldName HsRecField' (FieldOcc GhcPs) a
field) (Expression -> (String, Expression))
-> Either Error Expression -> Either Error (String, Expression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression (HsRecField' (FieldOcc GhcPs) a -> a
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg HsRecField' (FieldOcc GhcPs) a
field)

    REJECT(HsUnboundVar)
    REJECT(HsConLikeOut)
    REJECT(HsRecFld)
    REJECT(HsOverLabel)
    REJECT(HsIPVar)
    REJECT(HsLam)
    REJECT(HsLamCase)
    REJECT(HsAppType)
    REJECT(OpApp)
    REJECT(SectionL)
    REJECT(SectionR)
    REJECT(ExplicitSum)
    REJECT(HsCase)
    HsExpr GhcPs
REJECT(HsIf)
    REJECT(HsMultiIf)
    REJECT(HsLet)
    HsExpr GhcPs
REJECT(HsDo)
    REJECT(RecordUpd)
    REJECT(ExprWithTySig)
    REJECT(ArithSeq)
    REJECT(HsBracket)
    REJECT(HsRnBracketOut)
    REJECT(HsTcBracketOut)
    REJECT(HsSpliceE)
    REJECT(HsProc)
    REJECT(HsStatic)
    REJECT(HsTick)
    REJECT(HsBinTick)
#if __GLASGOW_HASKELL__ >= 902
    REJECT(HsGetField)
    REJECT(HsProjection)
#endif
#if __GLASGOW_HASKELL__ >= 900
    REJECT(HsPragE)
#endif
#if __GLASGOW_HASKELL__ <= 810
    REJECT(HsSCC)
    REJECT(HsCoreAnn)
    REJECT(HsTickPragma)
    REJECT(HsWrap)
#endif
#if __GLASGOW_HASKELL__ <= 808
    REJECT(HsArrApp)
    REJECT(HsArrForm)
    REJECT(EWildPat)
    REJECT(EAsPat)
    REJECT(EViewPat)
    REJECT(ELazyPat)
#endif
#if __GLASGOW_HASKELL__ <= 804
    REJECT(HsAppTypeOut)
    REJECT(ExplicitPArr)
    REJECT(ExprWithTySigOut)
    REJECT(PArrSeq)
#endif
    X(XExpr, fail "XExpr")

instance ToExpression RdrName where
  toExpression :: RdrName -> Either Error Expression
toExpression = Expression -> Either Error Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Either Error Expression)
-> (RdrName -> Expression) -> RdrName -> Either Error Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Expression
Id (String -> Expression)
-> (RdrName -> String) -> RdrName -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> String
showRdrName

instance ToExpression (HsTupArg GhcPs) where
  toExpression :: HsTupArg GhcPs -> Either Error Expression
toExpression HsTupArg GhcPs
t = case HsTupArg GhcPs
t of
    Present XPresent GhcPs
_x LHsExpr GhcPs
expr -> LHsExpr GhcPs -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression LHsExpr GhcPs
expr
    Missing XMissing GhcPs
_ -> String -> Either Error Expression
forall a. HasCallStack => String -> Either Error a
fail String
"Missing (tuple section)"
    X(XTupArg, fail "XTupArg")

instance ToExpression e => ToExpression (GenLocated l e) where
  toExpression :: GenLocated l e -> Either Error Expression
toExpression (L l
_ e
e) = e -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression e
e

instance ToExpression (HsOverLit GhcPs) where
  toExpression :: HsOverLit GhcPs -> Either Error Expression
toExpression = OverLitVal -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression (OverLitVal -> Either Error Expression)
-> (HsOverLit GhcPs -> OverLitVal)
-> HsOverLit GhcPs
-> Either Error Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val

#if __GLASGOW_HASKELL__ > 802
#define _integralSource

instance ToExpression IntegralLit where
  toExpression :: IntegralLit -> Either Error Expression
toExpression IntegralLit
il = Integer -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression (IntegralLit -> Integer
il_value IntegralLit
il)
#endif

instance ToExpression OverLitVal where
  toExpression :: OverLitVal -> Either Error Expression
toExpression OverLitVal
lit = case OverLitVal
lit of
    HsIntegral _integralSource il -> toExpression il
    HsFractional FractionalLit
fl -> FractionalLit -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression FractionalLit
fl
    HsIsString SourceText
_ FastString
str -> FastString -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression FastString
str

instance ToExpression FractionalLit where
  toExpression :: FractionalLit -> Either Error Expression
toExpression FractionalLit
fl = Rational -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression (FractionalLit -> Rational
fl_value FractionalLit
fl)

#if __GLASGOW_HASKELL__ >= 902
fl_value :: FractionalLit -> Rational
fl_value = rationalFromFractionalLit
#endif

instance ToExpression FastString where
  toExpression :: FastString -> Either Error Expression
toExpression = Expression -> Either Error Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Either Error Expression)
-> (FastString -> Expression)
-> FastString
-> Either Error Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Expression
Literal (Literal -> Expression)
-> (FastString -> Literal) -> FastString -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
String (String -> Literal)
-> (FastString -> String) -> FastString -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> String
unpackFS

instance ToExpression Integer where
  toExpression :: Integer -> Either Error Expression
toExpression = Expression -> Either Error Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Either Error Expression)
-> (Integer -> Expression) -> Integer -> Either Error Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Expression
Literal (Literal -> Expression)
-> (Integer -> Literal) -> Integer -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
Integer

instance ToExpression Rational where
  toExpression :: Rational -> Either Error Expression
toExpression = Expression -> Either Error Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Either Error Expression)
-> (Rational -> Expression) -> Rational -> Either Error Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Expression
Literal (Literal -> Expression)
-> (Rational -> Literal) -> Rational -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Literal
Rational

instance ToExpression Char where
  toExpression :: Char -> Either Error Expression
toExpression = Expression -> Either Error Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Either Error Expression)
-> (Char -> Expression) -> Char -> Either Error Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Expression
Literal (Literal -> Expression) -> (Char -> Literal) -> Char -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Literal
Char

instance ToExpression (HsLit GhcPsHsLit) where
  toExpression :: HsLit GhcPs -> Either Error Expression
toExpression HsLit GhcPs
lit = case HsLit GhcPs
lit of
    HsChar XHsChar GhcPs
_ Char
c -> Char -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression Char
c
    HsString XHsString GhcPs
_ FastString
str -> FastString -> Either Error Expression
forall a. ToExpression a => a -> Either Error Expression
toExpression FastString
str
    REJECT(HsCharPrim)
    REJECT(HsStringPrim)
    REJECT(HsInt)
    REJECT(HsIntPrim)
    REJECT(HsWordPrim)
    REJECT(HsInt64Prim)
    REJECT(HsWord64Prim)
    REJECT(HsInteger)
    REJECT(HsRat)
    REJECT(HsFloatPrim)
    REJECT(HsDoublePrim)
    X(XLit, fail "XLit")

showFieldLabel :: FieldOcc GhcPs -> String
showFieldLabel :: FieldOcc GhcPs -> String
showFieldLabel FieldOcc GhcPs
label = case FieldOcc GhcPs
label of
#if __GLASGOW_HASKELL__ >= 806
  FieldOcc XCFieldOcc GhcPs
_ (L SrcSpan
_ RdrName
name) -> RdrName -> String
showRdrName RdrName
name
#else
  FieldOcc (L _ name) _ -> showRdrName name
#endif
  X(XFieldOcc, "")

showRdrName :: RdrName -> String
showRdrName :: RdrName -> String
showRdrName RdrName
n = case RdrName
n of
  Unqual OccName
name -> OccName -> String
showOccName OccName
name
  Qual ModuleName
_ OccName
name -> OccName -> String
showOccName OccName
name
  Orig Module
_ OccName
name -> OccName -> String
showOccName OccName
name
  Exact Name
name -> OccName -> String
showOccName (Name -> OccName
nameOccName Name
name)

showOccName :: OccName -> String
showOccName :: OccName -> String
showOccName = FastString -> String
unpackFS (FastString -> String)
-> (OccName -> FastString) -> OccName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS

parse :: String -> Maybe (HsExpr GhcPs)
parse :: String -> Maybe (HsExpr GhcPs)
parse String
input = case String -> P (LHsExpr GhcPs) -> ParseResult (LHsExpr GhcPs)
forall a. String -> P a -> ParseResult a
runParser String
input P (LHsExpr GhcPs)
pHsExpr of
  POk PState
_ (L SrcSpan
_ HsExpr GhcPs
x) -> HsExpr GhcPs -> Maybe (HsExpr GhcPs)
forall a. a -> Maybe a
Just HsExpr GhcPs
x
  PFailed {} -> Maybe (HsExpr GhcPs)
forall a. Maybe a
Nothing
  where
    pHsExpr :: P (LHsExpr GhcPs)
pHsExpr = do
      ECP
r <- P ECP
GHC.parseExpression
      PV (LHsExpr GhcPs) -> P (LHsExpr GhcPs)
forall a. PV a -> P a
runPV (ECP -> PV (LHsExpr GhcPs)
unECP ECP
r)

#if __GLASGOW_HASKELL__ <= 900
#if __GLASGOW_HASKELL__ >= 810
    unECP :: ECP -> PV (LHsExpr GhcPs)
unECP = ECP -> PV (LHsExpr GhcPs)
ECP -> forall b. DisambECP b => PV (Located b)
runECP_PV
#else
    unECP = return
    runPV = id
#endif
#endif

runParser :: String -> P a -> ParseResult a
runParser :: String -> P a -> ParseResult a
runParser String
str P a
parser = P a -> PState -> ParseResult a
forall a. P a -> PState -> ParseResult a
unP P a
parser PState
parseState
  where
    location :: RealSrcLoc
location = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
"" Int
1 Int
1
    input :: StringBuffer
input = String -> StringBuffer
stringToStringBuffer String
str
    parseState :: PState
parseState = ParserFlags -> StringBuffer -> RealSrcLoc -> PState
initParserState ParserFlags
opts StringBuffer
input RealSrcLoc
location
    opts :: ParserFlags
opts = EnumSet WarningFlag
-> EnumSet Extension -> Bool -> Bool -> Bool -> Bool -> ParserFlags
mkParserOpts EnumSet WarningFlag
forall a. EnumSet a
warn EnumSet Extension
extensions Bool
False Bool
False Bool
False Bool
True

#if __GLASGOW_HASKELL__ >= 804
    extensions :: EnumSet Extension
extensions = [Extension] -> EnumSet Extension
forall a. Enum a => [a] -> EnumSet a
EnumSet.fromList [Extension
TraditionalRecordSyntax]
    warn :: EnumSet a
warn = EnumSet a
forall a. EnumSet a
EnumSet.empty
#else
    extensions = mempty
    warn = mempty
#endif

#if __GLASGOW_HASKELL__ <= 900
    initParserState :: ParserFlags -> StringBuffer -> RealSrcLoc -> PState
initParserState = ParserFlags -> StringBuffer -> RealSrcLoc -> PState
mkPStatePure
    mkParserOpts :: EnumSet WarningFlag
-> EnumSet Extension -> Bool -> Bool -> Bool -> Bool -> ParserFlags
mkParserOpts EnumSet WarningFlag
warningFlags EnumSet Extension
extensionFlags = EnumSet WarningFlag
-> EnumSet Extension
-> UnitId
-> Bool
-> Bool
-> Bool
-> Bool
-> ParserFlags
mkParserFlags' EnumSet WarningFlag
warningFlags EnumSet Extension
extensionFlags UnitId
unit
#if __GLASGOW_HASKELL__ == 900
    unit = UnitId ""
#else
    unit :: UnitId
unit = FastString -> UnitId
fsToUnitId FastString
""
#endif
#endif

#if __GLASGOW_HASKELL__ <= 806
    mkParserFlags' ws es u _ _ _ _ = assert (traditionalRecordSyntaxEnabled extensionsBitmap) $
      ParserFlags ws es u extensionsBitmap
    extensionsBitmap = shift 1 traditionalRecordSyntaxBit
#if __GLASGOW_HASKELL__ == 806
    traditionalRecordSyntaxBit = 28
#else
    traditionalRecordSyntaxBit = 29
#endif
#endif

#endif