{-# language ConstraintKinds #-}
{-# language DataKinds #-}
{-# language ExistentialQuantification #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language MultiParamTypeClasses #-}
{-# language PolyKinds #-}
{-# language RankNTypes #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}
module Mu.Server (
MonadServer, ServerT(..), HandlersT(..)
, ServerErrorIO, ServerIO
, serverError, ServerError(..), ServerErrorCode(..)
, alwaysOk
) where
import Control.Monad.Except
import Data.Conduit
import Data.Kind
import Mu.Rpc
import Mu.Schema
type MonadServer m = (MonadError ServerError m, MonadIO m)
type ServerErrorIO = ExceptT ServerError IO
type ServerIO w srv = ServerT w srv ServerErrorIO
serverError :: (MonadError ServerError m)
=> ServerError -> m a
serverError :: ServerError -> m a
serverError = ServerError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
alwaysOk :: (MonadIO m)
=> IO a -> m a
alwaysOk :: IO a -> m a
alwaysOk = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
data ServerError
= ServerError ServerErrorCode String
data ServerErrorCode
= Unknown
| Unavailable
| Unimplemented
| Unauthenticated
| Internal
| Invalid
| NotFound
deriving (ServerErrorCode -> ServerErrorCode -> Bool
(ServerErrorCode -> ServerErrorCode -> Bool)
-> (ServerErrorCode -> ServerErrorCode -> Bool)
-> Eq ServerErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerErrorCode -> ServerErrorCode -> Bool
$c/= :: ServerErrorCode -> ServerErrorCode -> Bool
== :: ServerErrorCode -> ServerErrorCode -> Bool
$c== :: ServerErrorCode -> ServerErrorCode -> Bool
Eq, Int -> ServerErrorCode -> ShowS
[ServerErrorCode] -> ShowS
ServerErrorCode -> String
(Int -> ServerErrorCode -> ShowS)
-> (ServerErrorCode -> String)
-> ([ServerErrorCode] -> ShowS)
-> Show ServerErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerErrorCode] -> ShowS
$cshowList :: [ServerErrorCode] -> ShowS
show :: ServerErrorCode -> String
$cshow :: ServerErrorCode -> String
showsPrec :: Int -> ServerErrorCode -> ShowS
$cshowsPrec :: Int -> ServerErrorCode -> ShowS
Show)
data ServerT (w :: Type -> Type) (s :: Service snm mnm) (m :: Type -> Type) (hs :: [Type]) where
Server :: HandlersT w methods m hs -> ServerT w ('Service sname anns methods) m hs
infixr 5 :<|>:
data HandlersT (w :: Type -> Type) (methods :: [Method mnm]) (m :: Type -> Type) (hs :: [Type]) where
H0 :: HandlersT w '[] m '[]
(:<|>:) :: Handles w args ret m h => h -> HandlersT w ms m hs
-> HandlersT w ('Method name anns args ret ': ms) m (h ': hs)
class Handles (w :: Type -> Type) (args :: [Argument]) (ret :: Return)
(m :: Type -> Type) (h :: Type)
class ToRef (w :: Type -> Type) (ref :: TypeRef) (t :: Type)
class FromRef (w :: Type -> Type) (ref :: TypeRef) (t :: Type)
instance ToSchema w sch sty t => ToRef w ('ViaSchema sch sty) t
instance ToRef w ('ViaRegistry subject t last) t
instance FromSchema w sch sty t => FromRef w ('ViaSchema sch sty) t
instance FromRef w ('ViaRegistry subject t last) t
instance (FromRef w ref t, Handles w args ret m h,
handler ~ (t -> h))
=> Handles w ('ArgSingle ref ': args) ret m handler
instance (MonadError ServerError m, FromRef w ref t, Handles w args ret m h,
handler ~ (ConduitT () t m () -> h))
=> Handles w ('ArgStream ref ': args) ret m handler
instance (MonadError ServerError m, handler ~ m ())
=> Handles w '[] 'RetNothing m handler
instance (MonadError ServerError m, ToRef w eref e, ToRef w vref v, handler ~ m (Either e v))
=> Handles w '[] ('RetThrows eref vref) m handler
instance (MonadError ServerError m, ToRef w ref v, handler ~ m v)
=> Handles w '[] ('RetSingle ref) m handler
instance (MonadError ServerError m, ToRef w ref v, handler ~ (ConduitT v Void m () -> m ()))
=> Handles w '[] ('RetStream ref) m handler