module IHP.HSX.HaskellParser (parseHaskellExpression) where

import Prelude
import GHC.Parser.Lexer (ParseResult (..), PState (..))
import qualified GHC.Parser.Errors.Ppr as ParserErrorPpr
import GHC.Types.SrcLoc
import qualified GHC.Parser as Parser
import qualified GHC.Parser.Lexer as Lexer
import GHC.Data.FastString
import GHC.Data.StringBuffer
import GHC.Parser.PostProcess
import Text.Megaparsec.Pos
import qualified "template-haskell" Language.Haskell.TH as TH

import qualified GHC.Data.EnumSet as EnumSet
import GHC
import IHP.HSX.HsExpToTH (toExp)

parseHaskellExpression :: SourcePos -> [TH.Extension] -> String -> Either (Int, Int, String) TH.Exp
parseHaskellExpression :: SourcePos -> [Extension] -> String -> Either (Int, Int, String) Exp
parseHaskellExpression SourcePos
sourcePos [Extension]
extensions String
input =
        case ParseResult (LocatedA (HsExpr GhcPs))
expr of
            POk PState
parserState LocatedA (HsExpr GhcPs)
result -> forall a b. b -> Either a b
Right (HsExpr GhcPs -> Exp
toExp (forall l e. GenLocated l e -> e
unLoc LocatedA (HsExpr GhcPs)
result))
            PFailed PState
parserState ->
                let
                    error :: String
error = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. PsError -> MsgEnvelope DecoratedSDoc
ParserErrorPpr.pprError) (PState
parserState.errors)
                    realLoc :: RealSrcLoc
realLoc = (PsLoc -> RealSrcLoc
psRealLoc PState
parserState.loc)
                    line :: Int
line = RealSrcLoc -> Int
srcLocLine RealSrcLoc
realLoc
                    col :: Int
col = RealSrcLoc -> Int
srcLocCol RealSrcLoc
realLoc
                in
                    forall a b. a -> Either a b
Left (Int
line, Int
col, String
error)
    where
        expr :: ParseResult (LocatedA (HsExpr GhcPs))
        expr :: ParseResult (LocatedA (HsExpr GhcPs))
expr = case forall a. P a -> PState -> ParseResult a
Lexer.unP P ECP
Parser.parseExpression PState
parseState of
                POk PState
parserState ECP
result -> forall a. P a -> PState -> ParseResult a
Lexer.unP (forall a. PV a -> P a
runPV (ECP -> forall b. DisambECP b => PV (LocatedA b)
unECP ECP
result)) PState
parserState
                PFailed PState
parserState -> forall a. PState -> ParseResult a
PFailed PState
parserState

        location :: RealSrcLoc
        location :: RealSrcLoc
location = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
filename Int
line Int
col
        
        filename :: FastString
        filename :: FastString
filename = String -> FastString
mkFastString SourcePos
sourcePos.sourceName

        line :: Int
        line :: Int
line = Pos -> Int
unPos SourcePos
sourcePos.sourceLine

        col :: Int
        col :: Int
col = Pos -> Int
unPos SourcePos
sourcePos.sourceColumn

        buffer :: StringBuffer
buffer = String -> StringBuffer
stringToStringBuffer String
input
        parseState :: PState
parseState = ParserOpts -> StringBuffer -> RealSrcLoc -> PState
Lexer.initParserState ParserOpts
parserOpts StringBuffer
buffer RealSrcLoc
location

        parserOpts :: Lexer.ParserOpts
        parserOpts :: ParserOpts
parserOpts = EnumSet WarningFlag
-> EnumSet Extension -> Bool -> Bool -> Bool -> Bool -> ParserOpts
Lexer.mkParserOpts forall a. EnumSet a
EnumSet.empty (forall a. Enum a => [a] -> EnumSet a
EnumSet.fromList [Extension]
extensions) Bool
False Bool
False Bool
False Bool
False