{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
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 (
    runInEmbeddedNeovim,
    runInEmbeddedNeovim',
    Seconds (..),
    TestConfiguration (..),
    -- deprecated
    testWithEmbeddedNeovim,
) where

import Neovim
import Neovim.API.Text (nvim_command, vim_command)
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 Data.Default (Default)
import Data.Text (pack)
import GHC.IO.Exception (ioe_filename)
import Neovim.Plugin (startPluginThreads)
import Neovim.Util (oneLineErrorMessage)
import Prettyprinter (annotate, vsep)
import Prettyprinter.Render.Terminal (Color (..), color)
import System.Process.Typed (
    ExitCode (ExitFailure, ExitSuccess),
    Process,
    createPipe,
    getExitCode,
    getStdin,
    getStdout,
    proc,
    setStdin,
    setStdout,
    startProcess,
    stopProcess,
    waitExitCode,
 )
import UnliftIO (Handle, IOException, async, atomically, cancel, catch, newEmptyMVar, putMVar, putTMVar, throwIO, timeout)
import UnliftIO.Concurrent (takeMVar, threadDelay)

-- | Type synonym for 'Word'.
newtype Seconds = Seconds Word
    deriving (Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seconds] -> ShowS
$cshowList :: [Seconds] -> ShowS
show :: Seconds -> String
$cshow :: Seconds -> String
showsPrec :: Int -> Seconds -> ShowS
$cshowsPrec :: Int -> Seconds -> ShowS
Show)

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

newtype TestConfiguration = TestConfiguration
    { TestConfiguration -> Seconds
cancelAfter :: Seconds
    }
    deriving (Int -> TestConfiguration -> ShowS
[TestConfiguration] -> ShowS
TestConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestConfiguration] -> ShowS
$cshowList :: [TestConfiguration] -> ShowS
show :: TestConfiguration -> String
$cshow :: TestConfiguration -> String
showsPrec :: Int -> TestConfiguration -> ShowS
$cshowsPrec :: Int -> TestConfiguration -> ShowS
Show)

instance Default TestConfiguration where
    def :: TestConfiguration
def =
        TestConfiguration
            { cancelAfter :: Seconds
cancelAfter = Word -> Seconds
Seconds Word
2
            }

{- | Run a neovim process with @-n --clean --embed@ and execute the
 given action that will have access to the started instance.

The 'TestConfiguration' contains sensible defaults.

'env' is the state of your function that you want to test.
-}
runInEmbeddedNeovim :: TestConfiguration -> Plugin env -> Neovim env a -> IO ()
runInEmbeddedNeovim :: forall env a.
TestConfiguration -> Plugin env -> Neovim env a -> IO ()
runInEmbeddedNeovim TestConfiguration{Seconds
cancelAfter :: Seconds
cancelAfter :: TestConfiguration -> Seconds
..} Plugin env
plugin Neovim env a
action =
    forall a. IO a -> IO ()
warnIfNvimIsNotOnPath IO ()
runTest
  where
    runTest :: IO ()
runTest = do
        MVar a
resultMVar <- forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar
        let action' :: Neovim env ()
action' = do
                a
result <- Neovim env a
action
                MVar StateTransition
q <- forall env a. (Config env -> a) -> Neovim env a
Internal.asks' forall env. Config env -> MVar StateTransition
Internal.transitionTo
                forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar StateTransition
q StateTransition
Internal.Quit
                -- vim_command isn't asynchronous, so we need to avoid waiting
                -- for the result of the operation by using 'async' since
                -- neovim cannot send a result if it has quit.
                Async ()
_ <- 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 env. Text -> Neovim env ()
vim_command Text
"qa!"
                forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar a
resultMVar a
result
        (Process Handle Handle ()
nvimProcess, IO ()
cleanUp) <- forall env.
Seconds
-> Plugin env
-> Neovim env ()
-> IO (Process Handle Handle (), IO ())
startEmbeddedNvim Seconds
cancelAfter Plugin env
plugin Neovim env ()
action'

        Maybe a
result <- forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout (forall i. Integral i => Seconds -> i
microSeconds Seconds
cancelAfter) (forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar a
resultMVar)

        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 => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Neovim returned with an exit status of: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i
            ExitCode
ExitSuccess -> case Maybe a
result of
                Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Test timed out"
                Just a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        IO ()
cleanUp

type TransitionHandler a = Internal.Config RPCConfig -> IO a

testTransitionHandler :: IO a -> TransitionHandler ()
testTransitionHandler :: forall a. IO a -> TransitionHandler ()
testTransitionHandler IO a
onInitAction Config RPCConfig
cfg =
    forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
cfg) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        StateTransition
Internal.InitSuccess -> do
            forall (f :: * -> *) a. Functor f => f a -> f ()
void IO a
onInitAction
            forall a. IO a -> TransitionHandler ()
testTransitionHandler IO a
onInitAction Config RPCConfig
cfg
        StateTransition
Internal.Restart -> do
            forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Restart unexpected"
        Internal.Failure Doc AnsiStyle
e -> do
            forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> Text
oneLineErrorMessage Doc AnsiStyle
e
        StateTransition
Internal.Quit -> do
            forall (m :: * -> *) a. Monad m => a -> m a
return ()

runInEmbeddedNeovim' :: TestConfiguration -> Neovim () a -> IO ()
runInEmbeddedNeovim' :: forall a. TestConfiguration -> Neovim () a -> IO ()
runInEmbeddedNeovim' TestConfiguration
testCfg = forall env a.
TestConfiguration -> Plugin env -> Neovim env a -> IO ()
runInEmbeddedNeovim TestConfiguration
testCfg Plugin{environment :: ()
environment = (), exports :: [ExportedFunctionality ()]
exports = []}

{-# DEPRECATED testWithEmbeddedNeovim "Use \"runInEmbeddedNeovim def env action\" and open files with nvim_command \"edit file\"" #-}

{- | The same as 'runInEmbeddedNeovim' with the given file opened via @nvim_command "edit file"@.
 - This method is kept for backwards compatibility.
-}
testWithEmbeddedNeovim ::
    -- | Optional path to a file that should be opened
    Maybe FilePath ->
    -- | Maximum time (in seconds) that a test is allowed to run
    Seconds ->
    -- | Read-only configuration
    env ->
    -- | Test case
    Neovim env a ->
    IO ()
testWithEmbeddedNeovim :: forall env a.
Maybe String -> Seconds -> env -> Neovim env a -> IO ()
testWithEmbeddedNeovim Maybe String
file Seconds
timeoutAfter env
env Neovim env a
action =
    forall env a.
TestConfiguration -> Plugin env -> Neovim env a -> IO ()
runInEmbeddedNeovim
        forall a. Default a => a
def{cancelAfter :: Seconds
cancelAfter = Seconds
timeoutAfter}
        Plugin{environment :: env
environment = env
env, exports :: [ExportedFunctionality env]
exports = []}
        (forall {env}. Neovim env ()
openTestFile forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Neovim env a
action)
  where
    openTestFile :: Neovim env ()
openTestFile = case Maybe String
file of
        Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just String
f -> forall env. Text -> Neovim env ()
nvim_command forall a b. (a -> b) -> a -> b
$ String -> Text
pack forall a b. (a -> b) -> a -> b
$ String
"edit " forall a. [a] -> [a] -> [a]
++ String
f

warnIfNvimIsNotOnPath :: IO a -> IO ()
warnIfNvimIsNotOnPath :: forall a. IO a -> IO ()
warnIfNvimIsNotOnPath IO a
test = forall (f :: * -> *) a. Functor f => f a -> f ()
void IO a
test forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(IOException
e :: IOException) -> case IOException -> Maybe String
ioe_filename IOException
e of
    Just String
"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 String
_ ->
        forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOException
e

startEmbeddedNvim ::
    Seconds ->
    Plugin env ->
    Neovim env () ->
    IO (Process Handle Handle (), IO ())
startEmbeddedNvim :: forall env.
Seconds
-> Plugin env
-> Neovim env ()
-> IO (Process Handle Handle (), IO ())
startEmbeddedNvim Seconds
timeoutAfter Plugin env
plugin (Internal.Neovim ReaderT (Config env) IO ()
action) = do
    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
$
                    String -> [String] -> ProcessConfig () () ()
proc String
"nvim" [String
"-n", String
"--clean", String
"--embed"]

    Config RPCConfig
cfg <- forall env. IO (Maybe String) -> 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, MonadUnliftIO 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 -> TransitionHandler ()
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 -> TransitionHandler ()
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})

    let actionCfg :: Config env
actionCfg = forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig (forall env. Plugin env -> env
environment Plugin env
plugin) Config RPCConfig
cfg
        action' :: IO ()
action' = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Config env) IO ()
action Config env
actionCfg
    [Async ()]
pluginHandlers <-
        Config ()
-> [Neovim () NeovimPlugin]
-> IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()]))
startPluginThreads (forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig () Config RPCConfig
cfg) [forall (m :: * -> *) env.
Applicative m =>
Plugin env -> m NeovimPlugin
wrapPlugin Plugin env
plugin] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left Doc AnsiStyle
e -> do
                forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
cfg) forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> StateTransition
Internal.Failure Doc AnsiStyle
e
                forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            Right ([FunctionMapEntry]
funMapEntries, [Async ()]
pluginTids) -> do
                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 [FunctionMapEntry]
funMapEntries)
                forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
cfg) StateTransition
Internal.InitSuccess
                forall (f :: * -> *) a. Applicative f => a -> f a
pure [Async ()]
pluginTids

    Async ()
transitionHandler <- 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 a. IO a -> TransitionHandler ()
testTransitionHandler IO ()
action' Config RPCConfig
cfg
    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 forall a b. (a -> b) -> a -> b
$
                [Async ()
socketReader, Async ()
eventHandler, Async ()
timeoutAsync, Async ()
transitionHandler]
                    forall a. [a] -> [a] -> [a]
++ [Async ()]
pluginHandlers

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