RpcSpec.hs

{-# OPTIONS_GHC -F -pgmF htfpp #-}
{-# LANGUAGE TemplateHaskell #-}

module RpcSpec (htf_thisModulesTests) where

import qualified Data.Map as Map (empty)
-- import Language.Haskell.TH hiding (reportError)
import Neovim (CommandArguments, Neovim, Plugin(..))
import Test.Framework

import Ribosome.Api.Variable (setVar)
import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)
import Ribosome.Control.Ribosome (Ribosome, newRibosome)
import Ribosome.Error.Report (reportError)
import Ribosome.Nvim.Api.IO (vimCommand, vimGetVar)
import Ribosome.Nvim.Api.RpcCall (RpcError)
import Ribosome.Plugin (RpcDef, cmd, riboPlugin, rpcHandler, sync)
import Ribosome.System.Time (sleep)
import Ribosome.Test.Embed (integrationSpecDef)
import System.Log.Logger (Priority(DEBUG), setLevel, updateGlobalLogger)
import TestError (RiboT, TestError)

handleError :: TestError -> RiboT ()
handleError =
  reportError "test"

target :: Int
target =
  13

resultVar :: Text
resultVar =
  "test_result"

handler ::
  NvimE e m =>
  m Int
handler = do
  setVar resultVar target
  return target

handlerCmdCmdArgs ::
  MonadRibo m =>
  NvimE e m =>
  CommandArguments ->
  Text ->
  Text ->
  Text ->
  m Int
handlerCmdCmdArgs _ _ _ _ =
  handler

handlerCmdNoCmdArgs ::
  MonadRibo m =>
  NvimE e m =>
  Text ->
  Text ->
  Text ->
  m Int
handlerCmdNoCmdArgs _ _ _ =
  handler

handlerCmdNoArgs ::
  MonadRibo m =>
  NvimE e m =>
  m Int
handlerCmdNoArgs =
  handler

handlerCmdOneArg ::
  MonadRibo m =>
  NvimE e m =>
  Text ->
  m Int
handlerCmdOneArg _ =
  handler

$(return [])

handlers ::
  MonadRibo m =>
  NvimE e m =>
  [[RpcDef m]]
handlers =
  [
    $(rpcHandler (sync . cmd []) 'handlerCmdCmdArgs),
    $(rpcHandler (sync . cmd []) 'handlerCmdNoCmdArgs),
    $(rpcHandler (sync . cmd []) 'handlerCmdNoArgs),
    $(rpcHandler (sync . cmd []) 'handlerCmdOneArg)
    ]

plugin :: IO (Plugin (Ribosome ()))
plugin = do
  ribo <- newRibosome "test" def
  return $ riboPlugin "test" ribo handlers [] handleError Map.empty

successCommand ::
  AssertM m =>
  NvimE e m =>
  Text ->
  m ()
successCommand cmd' = do
  setVar resultVar (0 :: Int)
  vimCommand cmd'
  gassertEqual target =<< vimGetVar resultVar

failureCommand ::
  AssertM m =>
  NvimE e m =>
  Text ->
  m ()
failureCommand cmd' = do
  setVar resultVar (0 :: Int)
  catchAt recoverRpc (vimCommand cmd')
  gassertEqual (0 :: Int) =<< vimGetVar resultVar
  where
    recoverRpc (_ :: RpcError) =
      return ()

rpcSpec :: ExceptT RpcError (Neovim ()) ()
rpcSpec = do
  successCommand "HandlerCmdCmdArgs a b c"
  successCommand "HandlerCmdNoCmdArgs a b c"
  successCommand "HandlerCmdNoArgs"
  successCommand "HandlerCmdOneArg a"
  failureCommand "HandlerCmdCmdArgs a b"
  failureCommand "HandlerCmdNoCmdArgs a b"
  failureCommand "HandlerCmdNoArgs a"
  sleep 1

test_rpc :: IO ()
test_rpc = do
  liftIO $ updateGlobalLogger "test" (setLevel DEBUG)
  plug <- plugin
  -- traverse_ putStrLn $ lines $(stringE . pprint =<< rpcHandler (sync . cmd []) 'handlerCmdOneArg)
  integrationSpecDef plug rpcSpec