module Hint.Parsers
where
import Prelude hiding(span)
import Hint.Base
import qualified Hint.Compat as Compat
import Control.Monad.Trans ( liftIO )
import qualified Hint.GHC as GHC
data ParseResult = ParseOk | ParseError GHC.SrcSpan GHC.Message
parseExpr :: MonadInterpreter m => String -> m ParseResult
parseExpr = runParser GHC.parseStmt
parseType :: MonadInterpreter m => String -> m ParseResult
parseType = runParser GHC.parseType
runParser :: MonadInterpreter m => GHC.P a -> String -> m ParseResult
runParser parser expr =
do dyn_fl <- runGhc GHC.getSessionDynFlags
buf <- Compat.stringToStringBuffer expr
let srcLoc = Compat.mkSrcLoc (GHC.fsLit "<hint>") 1 1
let parse_res = GHC.unP parser (Compat.mkPState dyn_fl buf srcLoc)
case parse_res of
GHC.POk{} -> return ParseOk
GHC.PFailed span err -> return (ParseError span err)
failOnParseError :: MonadInterpreter m
=> (String -> m ParseResult)
-> String
-> m ()
failOnParseError parser expr = mayFail go
where go = do parsed <- parser expr
case parsed of
ParseOk -> return (Just ())
ParseError span err ->
do
logger <- fromSession ghcErrLogger
#if __GLASGOW_HASKELL__ >= 706
dflags <- runGhc GHC.getSessionDynFlags
let logger' = logger dflags
errStyle = GHC.defaultErrStyle dflags
#else
let logger' = logger
errStyle = GHC.defaultErrStyle
#endif
liftIO $ logger' GHC.SevError
span
errStyle
err
return Nothing