{-# 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,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)

-- @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 = 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

-- | 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
  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)

-- | 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 (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

{- ORMOLU_DISABLE #-}
#if MIN_VERSION_ghc(9,2,0)
    -- TODO messages?
    PFailed PState{loc=SrcLoc.psRealLoc -> srcLoc, errors=errorMessages} ->
            let
                psErrToString e = show $ ParserErrorPpr.pprError e
                err = concatMap psErrToString errorMessages
                -- err = concatMap show 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 -- TODO: do not ignore "warnMessages"
                -- I have no idea what they can be
                (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

-- 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 =
  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