module Network.MessagePack.Client.Basic (
Client
, ClientT
, execClient
, call
, RpcError (..)
, RpcType (..)
) where
import Control.Monad.Catch (MonadThrow, throwM)
import qualified Control.Monad.State.Strict as CMS
import qualified Data.ByteString as S
import Data.Conduit (($$+))
import Data.Conduit.Network (appSink, appSource,
clientSettings,
runTCPClient)
import Data.MessagePack (MessagePack, Object,
fromObject, toObject)
import qualified Data.MessagePack.Result as R
import Network.MessagePack.Client.Internal
import Network.MessagePack.Types
execClient :: S.ByteString -> Int -> Client a -> IO a
execClient host port client =
runTCPClient (clientSettings port host) $ \ad -> do
(rsrc, _) <- appSource ad $$+ return ()
CMS.evalStateT (runClientT client) Connection
{ connSource = rsrc
, connSink = appSink ad
, connMsgId = 0
, connMths = []
}
class RpcType r where
rpcc :: String -> [Object] -> r
instance (CMS.MonadIO m, MonadThrow m, MessagePack o)
=> RpcType (ClientT m o) where
rpcc name args = do
res <- rpcCall name (reverse args)
case fromObject res of
R.Success ok ->
return ok
R.Failure msg ->
throwM $ ResultTypeError msg res
instance (MessagePack o, RpcType r) => RpcType (o -> r) where
rpcc name args arg = rpcc name (toObject arg : args)
call :: RpcType a => String -> a
call name = rpcc name []