{-# LANGUAGE CPP #-}
module Interpreter (
Interpreter
, safeEval
, safeEvalIt
, withInterpreter
, ghc
, interpreterSupported
, ghcInfo
, haveInterpreterKey
) where
import System.Process
import System.Directory (getPermissions, executable)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Monad
import Control.Exception hiding (handle)
import Data.Char
import GHC.Paths (ghc)
import Language.Haskell.GhciWrapper
haveInterpreterKey :: String
haveInterpreterKey = "Have interpreter"
ghcInfo :: IO [(String, String)]
ghcInfo = read <$> readProcess ghc ["--info"] []
interpreterSupported :: IO Bool
interpreterSupported = do
x <- getPermissions ghc
unless (executable x) $ do
fail $ ghc ++ " is not executable!"
maybe False (== "YES") . lookup haveInterpreterKey <$> ghcInfo
withInterpreter
:: [String]
-> (Interpreter -> IO a)
-> IO a
withInterpreter flags action = do
let
args = flags ++ [
"--interactive"
#if __GLASGOW_HASKELL__ >= 802
, "-fdiagnostics-color=never"
, "-fno-diagnostics-show-caret"
#endif
]
bracket (new defaultConfig{configGhci = ghc} args) close action
safeEval :: Interpreter -> String -> IO (Either String String)
safeEval repl = either (return . Left) (fmap Right . eval repl) . filterExpression
safeEvalIt :: Interpreter -> String -> IO (Either String String)
safeEvalIt repl = either (return . Left) (fmap Right . evalIt repl) . filterExpression
filterExpression :: String -> Either String String
filterExpression e =
case lines e of
[] -> Right e
l -> if firstLine == ":{" && lastLine /= ":}" then fail_ else Right e
where
firstLine = strip $ head l
lastLine = strip $ last l
fail_ = Left "unterminated multiline command"
where
strip :: String -> String
strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse