    module Hint.Parsers where

    import Prelude hiding (span)

    import Hint.Base

    import Control.Monad.IO.Class (liftIO)

    import qualified Hint.GHC as GHC

    data ParseResult = ParseOk | ParseError GHC.SrcSpan GHC.Message

    parseExpr :: MonadInterpreter m => String -> m ParseResult
    parseExpr :: forall (m :: * -> *). MonadInterpreter m => String -> m ParseResult
    parseExpr = P (Maybe
         (GenLocated
            SrcSpanAnnA
            (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
    -> String -> m ParseResult
    forall (m :: * -> *) a.
    MonadInterpreter m =>
    P a -> String -> m ParseResult
    runParser P (Maybe
         (GenLocated
            SrcSpanAnnA
            (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
    GHC.parseStmt

    parseType :: MonadInterpreter m => String -> m ParseResult
    parseType :: forall (m :: * -> *). MonadInterpreter m => String -> m ParseResult
    parseType = P (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> String -> m ParseResult
    forall (m :: * -> *) a.
    MonadInterpreter m =>
    P a -> String -> m ParseResult
    runParser P (GenLocated SrcSpanAnnA (HsType GhcPs))
    GHC.parseType

    runParser :: MonadInterpreter m => GHC.P a -> String -> m ParseResult
    runParser :: forall (m :: * -> *) a.
    MonadInterpreter m =>
    P a -> String -> m ParseResult
    runParser P a
    parser String
    expr =
        do dyn_fl <- RunGhc m DynFlags
    forall a. RunGhc m a
    forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
    runGhc GhcT n DynFlags
    forall {n :: * -> *}. (MonadIO n, MonadMask n) => GhcT n DynFlags
    forall (m :: * -> *). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags
           --
           buf <- (return . GHC.stringToStringBuffer) expr
           --
           -- ghc >= 7 panics if noSrcLoc is given
           let srcLoc = FastString -> Int -> Int -> RealSrcLoc
    GHC.mkRealSrcLoc (String -> FastString
    GHC.fsLit String
    "<hint>") Int
    1 Int
    1
           let parserOpts = DynFlags -> ParserOpts
    GHC.mkParserOpts DynFlags
    dyn_fl
           let parse_res = P a -> PState -> ParseResult a
    forall a. P a -> PState -> ParseResult a
    GHC.unP P a
    parser (ParserOpts -> StringBuffer -> RealSrcLoc -> PState
    GHC.initParserState ParserOpts
    parserOpts StringBuffer
    buf RealSrcLoc
    srcLoc)
           --
           case parse_res of
               GHC.POk{}            -> ParseResult -> m ParseResult
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ParseResult
    ParseOk
               --
    #if MIN_VERSION_ghc(8,10,0)
               GHC.PFailed PState
    pst      -> let errMsgs :: ErrorMessages
    errMsgs = PState -> DynFlags -> ErrorMessages
    GHC.getErrorMessages PState
    pst DynFlags
    dyn_fl
                                           span :: SrcSpan
    span = ErrorMessages -> SrcSpan
    forall e. Messages e -> SrcSpan
    GHC.errMsgSpan ErrorMessages
    errMsgs
                                           err :: SDoc
    err = [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    GHC.vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ ErrorMessages -> [SDoc]
    GHC.pprErrorMessages ErrorMessages
    errMsgs
                                       in ParseResult -> m ParseResult
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SrcSpan -> SDoc -> ParseResult
    ParseError SrcSpan
    span SDoc
    err)
    #else
               GHC.PFailed _ span err -> return (ParseError span err)
    #endif

    failOnParseError :: MonadInterpreter m
                     => (String -> m ParseResult)
                     -> String
                     -> m ()
    failOnParseError :: forall (m :: * -> *).
    MonadInterpreter m =>
    (String -> m ParseResult) -> String -> m ()
    failOnParseError String -> m ParseResult
    parser String
    expr = m (Maybe ()) -> m ()
    forall (m :: * -> *) a. MonadInterpreter m => m (Maybe a) -> m a
    mayFail m (Maybe ())
    go
        where go :: m (Maybe ())
    go = String -> m ParseResult
    parser String
    expr m ParseResult -> (ParseResult -> m (Maybe ())) -> m (Maybe ())
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ case
                          ParseResult
    ParseOk             -> Maybe () -> m (Maybe ())
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (() -> Maybe ()
    forall a. a -> Maybe a
    Just ())
                          -- If there was a parsing error,
                          -- do the "standard" error reporting
                          ParseError SrcSpan
    span SDoc
    err ->
                              do -- parsing failed, so we report it just as all
                                 -- other errors get reported....
                                 logger <- FromSession m Logger
    forall a. FromSession m a
    forall (m :: * -> *) a. MonadInterpreter m => FromSession m a
    fromSession SessionData () -> Logger
    forall a. SessionData a -> Logger
    ghcLogger
                                 dflags <- runGhc GHC.getSessionDynFlags
                                 let logger'  = Logger
    -> DynFlags -> WarnReason -> Severity -> SrcSpan -> SDoc -> IO ()
    GHC.putLogMsg Logger
    logger DynFlags
    dflags

                                 liftIO $ logger'
                                                  GHC.NoReason
                                                  GHC.SevError
                                                  span
                                                  err
                                 --
                                 -- behave like the rest of the GHC API functions
                                 -- do on error...
                                 return Nothing