Atomic.hs

module Ribosome.Api.Atomic where

import Data.MessagePack (Object(ObjectNil, ObjectArray, ObjectString))
import Neovim.Plugin.Classes (FunctionName(F))
import qualified Ribosome.Nvim.Api.RpcCall as RpcError (RpcError(Atomic))

import Ribosome.Control.Monad.Ribo (NvimE)
import Ribosome.Msgpack.Decode (MsgpackDecode(..), fromMsgpack')
import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))
import Ribosome.Msgpack.Error (DecodeError)
import qualified Ribosome.Msgpack.Util as Util (illegalType)
import Ribosome.Nvim.Api.IO (nvimCallAtomic)
import Ribosome.Nvim.Api.RpcCall (RpcCall(RpcCall))

data AtomicStatus =
  Failure Text
  |
  Success
  deriving (Eq, Show)

instance MsgpackDecode AtomicStatus where
  fromMsgpack ObjectNil =
    Right Success
  fromMsgpack (ObjectArray [_, _, ObjectString msg]) =
    Right (Failure (decodeUtf8 msg))
  fromMsgpack o =
    Util.illegalType "AtomicStatus" o

-- |Bundle a list of 'RpcCall's into a single call to nvim_call_atomic.
-- The result is checked for an error message, and if it is present, the call will fail.
atomic ::
  MonadDeepError e DecodeError m =>
  NvimE e m =>
  [RpcCall] ->
  m [Object]
atomic calls = do
  (results, statusObject) <- unpack =<< nvimCallAtomic (call <$> calls)
  status <- fromMsgpack' statusObject
  check results status
  where
    call (RpcCall (F name) args) =
      toMsgpack [toMsgpack name, toMsgpack args]
    unpack [ObjectArray results, status] =
      return (results, status)
    unpack o =
      throwHoist (RpcError.Atomic ("unexpected result structure: " <> show o))
    check _ (Failure err) =
      throwHoist (RpcError.Atomic err)
    check results Success =
      return results

-- |Bundle calls into one and decode all results to the same type.
atomicAs ::
  MonadDeepError e DecodeError m =>
  MsgpackDecode a =>
  NvimE e m =>
  [RpcCall] ->
  m [a]
atomicAs =
  traverse fromMsgpack' <=< atomic