{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}

module Network.MessagePack.Protocol
  ( capabilitiesN
  , capabilitiesC
  , capabilitiesS
  , methodListN
  , methodListC
  , methodListS
  , protocolMethods
  ) where

import           Control.Applicative              (Applicative, pure)
import           Control.Monad.Catch              (MonadCatch)
import           Control.Monad.Trans              (MonadIO)
import           Control.Monad.Trans.Control      (MonadBaseControl)
import           Data.Text                        (Text)

import           Network.MessagePack.Capabilities
import           Network.MessagePack.Client.Basic
import           Network.MessagePack.Server.Basic


capabilitiesN :: Text
capabilitiesN :: Text
capabilitiesN = Text
"rpc.capabilities"

capabilitiesC :: [ClientCapability] -> Client [ServerCapability]
capabilitiesC :: [ClientCapability] -> Client [ServerCapability]
capabilitiesC = Text -> [ClientCapability] -> Client [ServerCapability]
forall a. RpcType a => Text -> a
call Text
capabilitiesN

capabilitiesS
  :: Applicative m
  => [Method m]
  -> [ClientCapability]
  -> ServerT m [ServerCapability]
capabilitiesS :: [Method m] -> [ClientCapability] -> ServerT m [ServerCapability]
capabilitiesS [Method m]
_ [ClientCapability]
_ = [ServerCapability] -> ServerT m [ServerCapability]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ServerCapability
SCapMethodList]


methodListN :: Text
methodListN :: Text
methodListN = Text
"rpc.methodList"

methodListC :: Client [Text]
methodListC :: Client [Text]
methodListC = Text -> Client [Text]
forall a. RpcType a => Text -> a
call Text
methodListN

methodListS
  :: Applicative m
  => [Method m]
  -> ServerT m [Text]
methodListS :: [Method m] -> ServerT m [Text]
methodListS = [Text] -> ServerT m [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> ServerT m [Text])
-> ([Method m] -> [Text]) -> [Method m] -> ServerT m [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Method m -> Text) -> [Method m] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Method m -> Text
forall (m :: * -> *). Method m -> Text
methodName


protocolMethods
  :: (MonadBaseControl IO m, MonadIO m, MonadCatch m)
  => [Method m]
  -> [Method m]
protocolMethods :: [Method m] -> [Method m]
protocolMethods [Method m]
methods = [Method m]
methods [Method m] -> [Method m] -> [Method m]
forall a. [a] -> [a] -> [a]
++
  [ Text
-> MethodDocs
-> ([ClientCapability] -> ServerT m [ServerCapability])
-> Method m
forall (m :: * -> *) f.
MethodType m f =>
Text -> MethodDocs -> f -> Method m
method Text
capabilitiesN ([MethodVal] -> MethodVal -> MethodDocs
MethodDocs [Text -> Text -> MethodVal
MethodVal Text
"clientCaps" Text
"ClientCapability"] (Text -> Text -> MethodVal
MethodVal Text
"serverCaps" Text
"ServerCapability"))
      ([Method m] -> [ClientCapability] -> ServerT m [ServerCapability]
forall (m :: * -> *).
Applicative m =>
[Method m] -> [ClientCapability] -> ServerT m [ServerCapability]
capabilitiesS [Method m]
methods)
  , Text -> MethodDocs -> ServerT m [Text] -> Method m
forall (m :: * -> *) f.
MethodType m f =>
Text -> MethodDocs -> f -> Method m
method Text
methodListN   ([MethodVal] -> MethodVal -> MethodDocs
MethodDocs [] (Text -> Text -> MethodVal
MethodVal Text
"names" Text
"[String]"))
      ([Method m] -> ServerT m [Text]
forall (m :: * -> *).
Applicative m =>
[Method m] -> ServerT m [Text]
methodListS   [Method m]
methods)
  ]