{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}

-- | This module is here to parse Haskell expression using the GHC Api
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)

-- @HsExpr@ is available from GHC.Hs.Expr in all versions we support.
-- However, the goal of GHC is to split HsExpr into its own package, under
-- the namespace Language.Haskell.Syntax. The module split happened in 9.0,
-- but still in the ghc package.
#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)

-- | Parse a Haskell expression from source code into a Template Haskell expression.
-- See @parseExpWithExts@ or @parseExpWithFlags@ for customizing with additional extensions and settings.
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

-- | Parse a Haskell expression from source code into a Template Haskell expression
-- using a given set of GHC extensions.
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)

-- | Parse a Haskell expression from source code into a Template Haskell expression
-- using a given set of GHC DynFlags.
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)

-- | Run the GHC parser to parse a Haskell expression into a @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

{- ORMOLU_DISABLE #-}
#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
                -- err = concatMap show 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 -- TODO: do not ignore "warnMessages"
                -- I have no idea what they can be
                (_warnMessages, errorMessages) = msgs dynFlags
                err = concatMap show errorMessages
                line = SrcLoc.srcLocLine srcLoc
                col = SrcLoc.srcLocCol srcLoc
            in Left (line, col, err)
#endif

-- From Language.Haskell.GhclibParserEx.GHC.Parser

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