    {-# LANGUAGE CPP #-}

    module Interpreter (
      Interpreter
    , safeEval
    , safeEvalIt
    , withInterpreter
    , ghc
    , interpreterSupported

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

    import           System.Process
    import           System.Directory (getPermissions, executable)
    import           Control.Monad
    import           Control.Exception hiding (handle)
    import           Data.Char
    import           GHC.Paths (ghc)

    import           Language.Haskell.GhciWrapper

    haveInterpreterKey :: String
    haveInterpreterKey :: String
    haveInterpreterKey = String
    "Have interpreter"

    ghcInfo :: IO [(String, String)]
    ghcInfo :: IO [(String, String)]
    ghcInfo = String -> [(String, String)]
    forall a. Read a => String -> a
    read (String -> [(String, String)])
    -> IO String -> IO [(String, String)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> [String] -> String -> IO String
    readProcess String
    ghc [String
    "--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..
      Permissions
    x <- String -> IO Permissions
    getPermissions String
    ghc
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Permissions -> Bool
    executable Permissions
    x) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        String -> IO ()
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    ghc String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " is not executable!"

      Bool -> (String -> Bool) -> Maybe String -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "YES") (Maybe String -> Bool)
    -> ([(String, String)] -> Maybe String)
    -> [(String, String)]
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    haveInterpreterKey ([(String, String)] -> Bool) -> IO [(String, String)] -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO [(String, String)]
    ghcInfo

    -- | Run an interpreter session.
    --
    -- Example:
    --
    -- >>> withInterpreter [] $ \i -> eval i "23 + 42"
    -- ...
    -- "65\n"
    withInterpreter
      :: [String]               -- ^ List of flags, passed to GHC
      -> (Interpreter -> IO a)  -- ^ Action to run
      -> IO a                   -- ^ Result of action
    withInterpreter :: forall a. [String] -> (Interpreter -> IO a) -> IO a
    withInterpreter [String]
    flags Interpreter -> IO a
    action = do
      let
        args :: [String]
    args = [String]
    flags [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [
            String
    "--interactive"
          , String
    xTemplateHaskell
    #if __GLASGOW_HASKELL__ >= 802
          , String
    "-fdiagnostics-color=never"
          , String
    "-fno-diagnostics-show-caret"
    #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 -> [String] -> IO Interpreter
    new Config
    defaultConfig{configGhci :: String
    configGhci = String
    ghc} [String]
    args) Interpreter -> IO ()
    close Interpreter -> IO a
    action

    xTemplateHaskell :: String
    xTemplateHaskell :: String
    xTemplateHaskell = String
    "-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 -> String -> IO (Either String String)
    safeEval Interpreter
    repl = (String -> IO (Either String String))
    -> (String -> IO (Either String String))
    -> Either String String
    -> IO (Either String String)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> (String -> Either String String)
    -> String
    -> IO (Either String String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Either String String
    forall a b. a -> Either a b
    Left) ((String -> Either String String)
    -> IO String -> IO (Either String String)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Either String String
    forall a b. b -> Either a b
    Right (IO String -> IO (Either String String))
    -> (String -> IO String) -> String -> IO (Either String String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Interpreter -> String -> IO String
    eval Interpreter
    repl) (Either String String -> IO (Either String String))
    -> (String -> Either String String)
    -> String
    -> IO (Either String String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Either String String
    filterExpression

    safeEvalIt :: Interpreter -> String -> IO (Either String String)
    safeEvalIt :: Interpreter -> String -> IO (Either String String)
    safeEvalIt Interpreter
    repl = (String -> IO (Either String String))
    -> (String -> IO (Either String String))
    -> Either String String
    -> IO (Either String String)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> (String -> Either String String)
    -> String
    -> IO (Either String String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Either String String
    forall a b. a -> Either a b
    Left) ((String -> Either String String)
    -> IO String -> IO (Either String String)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Either String String
    forall a b. b -> Either a b
    Right (IO String -> IO (Either String String))
    -> (String -> IO String) -> String -> IO (Either String String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Interpreter -> String -> IO String
    evalIt Interpreter
    repl) (Either String String -> IO (Either String String))
    -> (String -> Either String String)
    -> String
    -> IO (Either String String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Either String String
    filterExpression

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

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