{- |
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 Data.Text.Prettyprint.Doc                 (annotate, vsep)
import Data.Text.Prettyprint.Doc.Render.Terminal (Color (..), color)
import GHC.IO.Exception                          (ioe_filename)
import Path
import Path.IO
import System.Exit                               (ExitCode (..))
import System.IO                                 (Handle)
import System.Process.Typed
import UnliftIO.Async                            (async, cancel)
import UnliftIO.Concurrent                       (threadDelay)
import UnliftIO.Exception
import UnliftIO.STM                              (atomically, putTMVar)

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


-- | 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
    :: Maybe (Path b File) -- ^ Optional path to a file that should be opened
    -> Seconds             -- ^ Maximum time (in seconds) that a test is allowed to run
    -> env                 -- ^ Read-only configuration
    -> Neovim env a        -- ^ Test case
    -> IO ()
testWithEmbeddedNeovim :: forall b env a.
Maybe (Path b File) -> Seconds -> env -> Neovim env a -> IO ()
testWithEmbeddedNeovim Maybe (Path b File)
file Seconds
timeout 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
timeout

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

        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 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 ->
                forall (m :: * -> *) a. Monad m => a -> m a
return ()
        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 Word
timeout) = do
    [FilePath]
args <- case Maybe (Path b File)
file of
                Maybe (Path b File)
Nothing ->
                    forall (m :: * -> *) a. Monad m => a -> m a
return []

                Just Path b File
f -> do
                    -- 'fail' should work with most testing frameworks
                    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 (m :: * -> *) a. Monad m => a -> m a
return [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 a b. (Integral a, Num b) => a -> b
fromIntegral Word
timeout) forall a. Num a => a -> a -> a
* Int
1000 forall a. Num a => a -> a -> a
* Int
1000
        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 (m :: * -> *) a. Monad m => a -> m a
return ())

    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 (m :: * -> *) a. Monad m => a -> m a
return (Process Handle Handle ()
nvimProcess, Config RPCConfig
cfg, IO ()
cleanUp)