{- |
Module      :  Neovim.Test
Description :  Testing functions
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
Portability :  GHC
-}
module Neovim.Test (
    testWithEmbeddedNeovim,
    Seconds (..),
) where

import Neovim
import Neovim.API.Text
import qualified Neovim.Context.Internal as Internal
import Neovim.RPC.Common (RPCConfig, newRPCConfig)
import Neovim.RPC.EventHandler (runEventHandler)
import Neovim.RPC.SocketReader (runSocketReader)

import Control.Monad.Reader (runReaderT)
import Control.Monad.Trans.Resource (runResourceT)
import GHC.IO.Exception (ioe_filename)
import Path
import Path.IO
import Prettyprinter (annotate, vsep)
import Prettyprinter.Render.Terminal (Color (..), color)
import System.Process.Typed
import UnliftIO
import UnliftIO.Concurrent (threadDelay)

-- | Type synonym for 'Word'.
newtype Seconds = Seconds Word

microSeconds :: Integral i => Seconds -> i
microSeconds :: forall i. Integral i => Seconds -> i
microSeconds (Seconds Word
s) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s forall a. Num a => a -> a -> a
* i
1000 forall a. Num a => a -> a -> a
* i
1000

{- | Run the given 'Neovim' action according to the given parameters.
 The embedded neovim instance is started without a config (i.e. it is passed
 @-u NONE@).

 If you want to run your tests purely from haskell, you have to setup
 the desired state of neovim with the help of the functions in
 "Neovim.API.String".
-}
testWithEmbeddedNeovim ::
    -- | Optional path to a file that should be opened
    Maybe (Path b File) ->
    -- | Maximum time (in seconds) that a test is allowed to run
    Seconds ->
    -- | Read-only configuration
    env ->
    -- | Test case
    Neovim env a ->
    IO ()
testWithEmbeddedNeovim :: forall b env a.
Maybe (Path b File) -> Seconds -> env -> Neovim env a -> IO ()
testWithEmbeddedNeovim Maybe (Path b File)
file Seconds
timeoutAfter env
r (Internal.Neovim ResourceT (ReaderT (Config env) IO) a
a) =
    IO ()
runTest forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` IOException -> IO ()
catchIfNvimIsNotOnPath
  where
    runTest :: IO ()
runTest = do
        (Process Handle Handle ()
nvimProcess, Config RPCConfig
cfg, IO ()
cleanUp) <- forall b.
Maybe (Path b File)
-> Seconds
-> IO (Process Handle Handle (), Config RPCConfig, IO ())
startEmbeddedNvim Maybe (Path b File)
file Seconds
timeoutAfter

        let testCfg :: Config env
testCfg = forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig env
r Config RPCConfig
cfg

        Maybe a
result <- forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout (forall i. Integral i => Seconds -> i
microSeconds Seconds
timeoutAfter) forall a b. (a -> b) -> a -> b
$ do
            forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT ResourceT (ReaderT (Config env) IO) a
a) Config env
testCfg

        -- vim_command isn't asynchronous, so we need to avoid waiting for the
        -- result of the operation since neovim cannot send a result if it
        -- has quit.
        let Internal.Neovim ResourceT (ReaderT (Config env) IO) ()
q = Text -> forall env. Neovim env ()
vim_command Text
"qa!"
        Async ()
testRunner <- forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall {env}. ResourceT (ReaderT (Config env) IO) ()
q) Config env
testCfg

        forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ExitCode
waitExitCode Process Handle Handle ()
nvimProcess forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            ExitFailure Int
i ->
                forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Neovim returned with an exit status of: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
i
            ExitCode
ExitSuccess -> case Maybe a
result of
                Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Test timed out"
                Just a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel Async ()
testRunner
        IO ()
cleanUp

catchIfNvimIsNotOnPath :: IOException -> IO ()
catchIfNvimIsNotOnPath :: IOException -> IO ()
catchIfNvimIsNotOnPath IOException
e = case IOException -> Maybe FilePath
ioe_filename IOException
e of
    Just FilePath
"nvim" ->
        Doc AnsiStyle -> IO ()
putDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Red) forall a b. (a -> b) -> a -> b
$
            forall ann. [Doc ann] -> Doc ann
vsep
                [ Doc AnsiStyle
"The neovim executable 'nvim' is not on the PATH."
                , Doc AnsiStyle
"You may not be testing fully!"
                ]
    Maybe FilePath
_ ->
        forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOException
e

startEmbeddedNvim ::
    Maybe (Path b File) ->
    Seconds ->
    IO (Process Handle Handle (), Internal.Config RPCConfig, IO ())
startEmbeddedNvim :: forall b.
Maybe (Path b File)
-> Seconds
-> IO (Process Handle Handle (), Config RPCConfig, IO ())
startEmbeddedNvim Maybe (Path b File)
file Seconds
timeoutAfter = do
    [FilePath]
args <- case Maybe (Path b File)
file of
        Maybe (Path b File)
Nothing ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Just Path b File
f -> do
            forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path b File
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"File not found: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Path b File
f
            forall (f :: * -> *) a. Applicative f => a -> f a
pure [forall b t. Path b t -> FilePath
toFilePath Path b File
f]

    Process Handle Handle ()
nvimProcess <-
        forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess forall a b. (a -> b) -> a -> b
$
            forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin forall (anyStreamType :: StreamType).
StreamSpec anyStreamType Handle
createPipe forall a b. (a -> b) -> a -> b
$
                forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout forall (anyStreamType :: StreamType).
StreamSpec anyStreamType Handle
createPipe forall a b. (a -> b) -> a -> b
$
                    FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"nvim" ([FilePath
"-n", FilePath
"--clean", FilePath
"--embed"] forall a. [a] -> [a] -> [a]
++ [FilePath]
args)

    Config RPCConfig
cfg <- forall env. IO (Maybe FilePath) -> IO env -> IO (Config env)
Internal.newConfig (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) forall (io :: * -> *). (Applicative io, MonadIO io) => io RPCConfig
newRPCConfig

    Async ()
socketReader <-
        forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
            Handle -> Config RPCConfig -> IO ()
runSocketReader
                (forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process Handle Handle ()
nvimProcess)
                (Config RPCConfig
cfg{pluginSettings :: Maybe (PluginSettings RPCConfig)
Internal.pluginSettings = forall a. Maybe a
Nothing})

    Async ()
eventHandler <-
        forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
            Handle -> Config RPCConfig -> IO ()
runEventHandler
                (forall stdin stdout stderr. Process stdin stdout stderr -> stdin
getStdin Process Handle Handle ()
nvimProcess)
                (Config RPCConfig
cfg{pluginSettings :: Maybe (PluginSettings RPCConfig)
Internal.pluginSettings = forall a. Maybe a
Nothing})

    forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$
        forall a. TMVar a -> a -> STM ()
putTMVar
            (forall env. Config env -> TMVar FunctionMap
Internal.globalFunctionMap Config RPCConfig
cfg)
            ([FunctionMapEntry] -> FunctionMap
Internal.mkFunctionMap [])

    Async ()
timeoutAsync <- forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay forall a b. (a -> b) -> a -> b
$ forall i. Integral i => Seconds -> i
microSeconds Seconds
timeoutAfter
        forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m (Maybe ExitCode)
getExitCode Process Handle Handle ()
nvimProcess forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess Process Handle Handle ()
nvimProcess) (\ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

    let cleanUp :: IO ()
cleanUp = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel [Async ()
socketReader, Async ()
eventHandler, Async ()
timeoutAsync]

    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Process Handle Handle ()
nvimProcess, Config RPCConfig
cfg, IO ()
cleanUp)