{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Safe                  #-}
{-# LANGUAGE StrictData            #-}
module Network.MessagePack.Types.Server
  ( MethodVal (..)
  , MethodDocs (..)
  , MethodType (..)
  , Method (..)
  , method
  ) where

import           Control.Monad    (Monad)
import           Data.MessagePack (Object)
import           Data.Text        (Text)


data MethodVal = MethodVal
  { MethodVal -> Text
valName :: Text
  , MethodVal -> Text
valType :: Text
  }
  deriving (Int -> MethodVal -> ShowS
[MethodVal] -> ShowS
MethodVal -> String
(Int -> MethodVal -> ShowS)
-> (MethodVal -> String)
-> ([MethodVal] -> ShowS)
-> Show MethodVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MethodVal] -> ShowS
$cshowList :: [MethodVal] -> ShowS
show :: MethodVal -> String
$cshow :: MethodVal -> String
showsPrec :: Int -> MethodVal -> ShowS
$cshowsPrec :: Int -> MethodVal -> ShowS
Show, ReadPrec [MethodVal]
ReadPrec MethodVal
Int -> ReadS MethodVal
ReadS [MethodVal]
(Int -> ReadS MethodVal)
-> ReadS [MethodVal]
-> ReadPrec MethodVal
-> ReadPrec [MethodVal]
-> Read MethodVal
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MethodVal]
$creadListPrec :: ReadPrec [MethodVal]
readPrec :: ReadPrec MethodVal
$creadPrec :: ReadPrec MethodVal
readList :: ReadS [MethodVal]
$creadList :: ReadS [MethodVal]
readsPrec :: Int -> ReadS MethodVal
$creadsPrec :: Int -> ReadS MethodVal
Read, MethodVal -> MethodVal -> Bool
(MethodVal -> MethodVal -> Bool)
-> (MethodVal -> MethodVal -> Bool) -> Eq MethodVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MethodVal -> MethodVal -> Bool
$c/= :: MethodVal -> MethodVal -> Bool
== :: MethodVal -> MethodVal -> Bool
$c== :: MethodVal -> MethodVal -> Bool
Eq)

data MethodDocs = MethodDocs
  { MethodDocs -> [MethodVal]
methodArgs :: [MethodVal]
  , MethodDocs -> MethodVal
methodRetv :: MethodVal
  }
  deriving (Int -> MethodDocs -> ShowS
[MethodDocs] -> ShowS
MethodDocs -> String
(Int -> MethodDocs -> ShowS)
-> (MethodDocs -> String)
-> ([MethodDocs] -> ShowS)
-> Show MethodDocs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MethodDocs] -> ShowS
$cshowList :: [MethodDocs] -> ShowS
show :: MethodDocs -> String
$cshow :: MethodDocs -> String
showsPrec :: Int -> MethodDocs -> ShowS
$cshowsPrec :: Int -> MethodDocs -> ShowS
Show, ReadPrec [MethodDocs]
ReadPrec MethodDocs
Int -> ReadS MethodDocs
ReadS [MethodDocs]
(Int -> ReadS MethodDocs)
-> ReadS [MethodDocs]
-> ReadPrec MethodDocs
-> ReadPrec [MethodDocs]
-> Read MethodDocs
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MethodDocs]
$creadListPrec :: ReadPrec [MethodDocs]
readPrec :: ReadPrec MethodDocs
$creadPrec :: ReadPrec MethodDocs
readList :: ReadS [MethodDocs]
$creadList :: ReadS [MethodDocs]
readsPrec :: Int -> ReadS MethodDocs
$creadsPrec :: Int -> ReadS MethodDocs
Read, MethodDocs -> MethodDocs -> Bool
(MethodDocs -> MethodDocs -> Bool)
-> (MethodDocs -> MethodDocs -> Bool) -> Eq MethodDocs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MethodDocs -> MethodDocs -> Bool
$c/= :: MethodDocs -> MethodDocs -> Bool
== :: MethodDocs -> MethodDocs -> Bool
$c== :: MethodDocs -> MethodDocs -> Bool
Eq)

-- ^ MessagePack RPC method
data Method m = Method
  { Method m -> Text
methodName :: Text
  , Method m -> MethodDocs
methodDocs :: MethodDocs
  , Method m -> [Object] -> m Object
methodBody :: [Object] -> m Object
  }


class Monad m => MethodType m f where
  -- | Create a RPC method from a Haskell function
  toBody :: Text -> f -> [Object] -> m Object


-- | Build a method
method
  :: MethodType m f
  => Text     -- ^ Method name
  -> MethodDocs
  -> f        -- ^ Method body
  -> Method m
method :: Text -> MethodDocs -> f -> Method m
method Text
name MethodDocs
docs f
body = Text -> MethodDocs -> ([Object] -> m Object) -> Method m
forall (m :: * -> *).
Text -> MethodDocs -> ([Object] -> m Object) -> Method m
Method Text
name MethodDocs
docs (([Object] -> m Object) -> Method m)
-> ([Object] -> m Object) -> Method m
forall a b. (a -> b) -> a -> b
$ Text -> f -> [Object] -> m Object
forall (m :: * -> *) f.
MethodType m f =>
Text -> f -> [Object] -> m Object
toBody Text
name f
body