    {-# LANGUAGE CPP #-}

    #if __GLASGOW_HASKELL__ <= 906
    {-# LANGUAGE LambdaCase #-}
    #endif

    module Test.DocTest.Internal.Interpreter (
      Interpreter
    , safeEval
    , safeEvalIt
    , withInterpreter
    , ghc
    , interpreterSupported

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

    import System.Process
    import System.Directory (getPermissions, executable)
    import Control.Monad
    import Control.Exception hiding (handle)
    import Data.Char
    #if __GLASGOW_HASKELL__ > 906
    import Data.List (unsnoc)
    #else
    import Data.Bifunctor (first)
    #endif
    import GHC.Paths (ghc)

    import Test.DocTest.Internal.GhciWrapper
    import Test.DocTest.Internal.Logging (DebugLogger)

    -- $setup
    -- >>> import Test.DocTest.Internal.GhciWrapper (eval)
    -- >>> import Test.DocTest.Internal.Logging (noLogger)

    #if __GLASGOW_HASKELL__ <= 906
    -- | If the list is empty returns 'Nothing', otherwise returns the 'init' and the 'last'.
    --
    -- > unsnoc "test" == Just ("tes",'t')
    -- > unsnoc ""     == Nothing
    -- > \xs -> unsnoc xs == if null xs then Nothing else Just (init xs, last xs)
    unsnoc :: [a] -> Maybe ([a], a)
    unsnoc = \case
      []   -> Nothing
      x:xs -> Just $ unsnoc1 x xs
      where
        unsnoc1 :: a -> [a] -> ([a], a)
        unsnoc1 x = \case
          []   -> ([], x)
          y:ys -> first (x:) $ unsnoc1 y ys
    #endif

    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..
      x <- String -> IO Permissions
    getPermissions String
    ghc
      unless (executable x) $ do
        fail $ ghc ++ " is not executable!"

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

    -- | Run an interpreter session.
    --
    -- Example:
    --
    -- >>> withInterpreter noLogger [] $ \i -> eval i "23 + 42"
    -- "65\n"
    withInterpreter
      :: DebugLogger            -- ^ Debug logger
      -> [String]               -- ^ List of flags, passed to GHC
      -> (Interpreter -> IO a)  -- ^ Action to run
      -> IO a                   -- ^ Result of action
    withInterpreter :: forall a.
    (String -> IO ()) -> [String] -> (Interpreter -> IO a) -> IO a
    withInterpreter String -> IO ()
    logger [String]
    flags Interpreter -> IO a
    action = do
      let
        args :: [String]
    args = [String]
    flags [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [
            String
    "--interactive"
          , String
    "-fdiagnostics-color=never"
          , String
    "-fno-diagnostics-show-caret"
          ]
      IO Interpreter
    -> (Interpreter -> IO ()) -> (Interpreter -> IO a) -> IO a
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket ((String -> IO ()) -> Config -> [String] -> IO Interpreter
    new String -> IO ()
    logger Config
    defaultConfig{configGhci = ghc} [String]
    args) Interpreter -> IO ()
    close Interpreter -> IO a
    action

    -- | 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) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    strip (String -> [String]
    lines String
    e) of
        [] -> String -> Either String String
    forall a b. b -> Either a b
    Right String
    e
        (String
    firstLine:[String]
    ls) ->
          let lastLine :: String
    lastLine = String
    -> (([String], String) -> String)
    -> Maybe ([String], String)
    -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    firstLine ([String], String) -> String
    forall a b. (a, b) -> b
    snd ([String] -> Maybe ([String], String)
    forall a. [a] -> Maybe ([a], a)
    unsnoc [String]
    ls) in
          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
    fail_ else String -> Either String String
    forall a b. b -> Either a b
    Right String
    e
      where
        fail_ :: Either String b
    fail_ = String -> Either String b
    forall a b. a -> Either a b
    Left String
    "unterminated multiline command"

        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