RpcTest.hs

module Ribosome.Test.RpcTest where

import Data.DeepPrisms (DeepPrisms)
import qualified Data.List as List (lines)
import qualified Data.Map.Strict as Map (empty)
import Hedgehog ((===))
import Language.Haskell.TH hiding (reportError)
import Neovim (CommandArguments, Plugin(..))
import System.Log.Logger (Priority(DEBUG), setLevel, updateGlobalLogger)
import TestError (RiboTest, TestError)

import Ribosome.Api.Variable (setVar)
import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE, Ribo)
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 Ribosome.Test.Run (UnitTest)

handleError ::
  DeepPrisms e RpcError =>
  TestError ->
  Ribo s e ()
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 ::
  NvimE e m =>
  CommandArguments ->
  Text ->
  Text ->
  Text ->
  m Int
handlerCmdCmdArgs _ _ _ _ =
  handler

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

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

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

handlerCmdMaybeArg ::
  NvimE e m =>
  Maybe Text ->
  m Int
handlerCmdMaybeArg _ =
  handler

handlerCmdListArg ::
  NvimE e m =>
  [Text] ->
  m Int
handlerCmdListArg _ =
  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),
    $(rpcHandler (sync . cmd []) 'handlerCmdMaybeArg),
    $(rpcHandler (sync . cmd []) 'handlerCmdListArg)
    ]

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

successCommand ::
  Text ->
  RiboTest ()
successCommand cmd' = do
  setVar resultVar (0 :: Int)
  vimCommand cmd'
  (target ===) =<< vimGetVar resultVar

failureCommand ::
  Text ->
  RiboTest ()
failureCommand cmd' = do
  lift (setVar resultVar (0 :: Int))
  catchAt recoverRpc (vimCommand cmd')
  ((0 :: Int) ===) =<< vimGetVar resultVar
  where
    recoverRpc (_ :: RpcError) =
      return ()

rpcSpec :: RiboTest ()
rpcSpec = do
  successCommand "HandlerCmdCmdArgs a b c"
  successCommand "HandlerCmdNoCmdArgs a b c"
  successCommand "HandlerCmdNoArgs"
  successCommand "HandlerCmdOneArg a"
  successCommand "HandlerCmdMaybeArg a"
  successCommand "HandlerCmdMaybeArg"
  successCommand "HandlerCmdListArg"
  successCommand "HandlerCmdListArg a b c"
  failureCommand "HandlerCmdCmdArgs a b"
  failureCommand "HandlerCmdNoCmdArgs a b"
  failureCommand "HandlerCmdNoArgs a"
  sleep 1

test_rpc :: UnitTest
test_rpc = do
  liftIO $ updateGlobalLogger "test" (setLevel DEBUG)
  plug <- liftIO plugin
  when debug $ traverse_ putStrLn . List.lines $ $(stringE . pprint =<< rpcHandler (sync . cmd []) 'handlerCmdListArg)
  integrationSpecDef plug rpcSpec
  where
    debug =
      False