{-# LANGUAGE CPP #-}
module Interpreter (
  Interpreter
, PreserveIt(..)
, safeEval
, safeEvalWith
, withInterpreter
, ghc
, interpreterSupported

-- exported for testing
, ghcInfo
, haveInterpreterKey
, filterExpression
) where

import           Imports

import           System.Process
import           System.Directory (getPermissions, executable)
import           GHC.Paths (ghc)

import           Language.Haskell.GhciWrapper

haveInterpreterKey :: String
haveInterpreterKey :: [Char]
haveInterpreterKey = [Char]
"Have interpreter"

ghcInfo :: IO [(String, String)]
ghcInfo :: IO [([Char], [Char])]
ghcInfo = [Char] -> [([Char], [Char])]
forall a. Read a => [Char] -> a
read ([Char] -> [([Char], [Char])])
-> IO [Char] -> IO [([Char], [Char])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> [Char] -> IO [Char]
readProcess [Char]
ghc [[Char]
"--info"] []

interpreterSupported :: IO Bool
interpreterSupported :: IO Bool
interpreterSupported = do
  -- in a perfect world this permission check should never fail, but I know of
  -- at least one case where it did..
  x <- [Char] -> IO Permissions
getPermissions [Char]
ghc
  unless (executable x) $ do
    fail $ ghc ++ " is not executable!"

  (== Just "YES") . lookup haveInterpreterKey <$> ghcInfo

withInterpreter
  :: (String, [String])
  -> (Interpreter -> IO a)  -- ^ Action to run
  -> IO a                   -- ^ Result of action
withInterpreter :: forall a. ([Char], [[Char]]) -> (Interpreter -> IO a) -> IO a
withInterpreter ([Char]
command, [[Char]]
flags) Interpreter -> IO a
action = do
  let
    args :: [[Char]]
args = [[Char]]
flags [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [
        [Char]
xTemplateHaskell
      , [Char]
"-fdiagnostics-color=never"
      , [Char]
"-fno-diagnostics-show-caret"
#if __GLASGOW_HASKELL__ >= 810 && __GLASGOW_HASKELL__ < 904
      , "-Wno-unused-packages"
#endif
#if __GLASGOW_HASKELL__ >= 910
      , [Char]
"-fprint-error-index-links=never"
#endif
      ]
  IO Interpreter
-> (Interpreter -> IO ()) -> (Interpreter -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Config -> [[Char]] -> IO Interpreter
new Config
defaultConfig{configGhci = command} [[Char]]
args) Interpreter -> IO ()
close Interpreter -> IO a
action

xTemplateHaskell :: String
xTemplateHaskell :: [Char]
xTemplateHaskell = [Char]
"-XTemplateHaskell"

-- | Evaluate an expression; return a Left value on exceptions.
--
-- An exception may e.g. be caused on unterminated multiline expressions.
safeEval :: Interpreter -> String -> IO (Either String String)
safeEval :: Interpreter -> [Char] -> IO (Either [Char] [Char])
safeEval = PreserveIt -> Interpreter -> [Char] -> IO (Either [Char] [Char])
safeEvalWith PreserveIt
NoPreserveIt

safeEvalWith :: PreserveIt -> Interpreter -> String -> IO (Either String String)
safeEvalWith :: PreserveIt -> Interpreter -> [Char] -> IO (Either [Char] [Char])
safeEvalWith PreserveIt
preserveIt Interpreter
repl = ([Char] -> IO (Either [Char] [Char]))
-> ([Char] -> IO (Either [Char] [Char]))
-> Either [Char] [Char]
-> IO (Either [Char] [Char])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either [Char] [Char] -> IO (Either [Char] [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] [Char] -> IO (Either [Char] [Char]))
-> ([Char] -> Either [Char] [Char])
-> [Char]
-> IO (Either [Char] [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] [Char]
forall a b. a -> Either a b
Left) (([Char] -> Either [Char] [Char])
-> IO [Char] -> IO (Either [Char] [Char])
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right (IO [Char] -> IO (Either [Char] [Char]))
-> ([Char] -> IO [Char]) -> [Char] -> IO (Either [Char] [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreserveIt -> Interpreter -> [Char] -> IO [Char]
evalWith PreserveIt
preserveIt Interpreter
repl) (Either [Char] [Char] -> IO (Either [Char] [Char]))
-> ([Char] -> Either [Char] [Char])
-> [Char]
-> IO (Either [Char] [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] [Char]
filterExpression

filterExpression :: String -> Either String String
filterExpression :: [Char] -> Either [Char] [Char]
filterExpression [Char]
e =
  case [Char] -> [[Char]]
lines [Char]
e of
    [] -> [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right [Char]
e
    [[Char]]
l  -> if [Char]
firstLine [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
":{" Bool -> Bool -> Bool
&& [Char]
lastLine [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
":}" then Either [Char] [Char]
forall {b}. Either [Char] b
err else [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right ([Char] -> [Char]
filterXTemplateHaskell [Char]
e)
      where
        firstLine :: [Char]
firstLine = [Char] -> [Char]
strip ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
l
        lastLine :: [Char]
lastLine  = [Char] -> [Char]
strip ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
last [[Char]]
l
        err :: Either [Char] b
err = [Char] -> Either [Char] b
forall a b. a -> Either a b
Left [Char]
"unterminated multi-line command"

filterXTemplateHaskell :: String -> String
filterXTemplateHaskell :: [Char] -> [Char]
filterXTemplateHaskell [Char]
input = case [Char] -> [[Char]]
words [Char]
input of
  [[Char]
":set", [Char]
setting] | [Char]
setting [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
xTemplateHaskell -> [Char]
""
  [Char]
":set" : [[Char]]
xs | [Char]
xTemplateHaskell [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
xs -> [[Char]] -> [Char]
unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
":set" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
xTemplateHaskell) [[Char]]
xs
  [[Char]]
_ -> [Char]
input