{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Subscriptions
( webSocketsApp,
httpPubApp,
PubApp (..),
SubApp (..),
Event (..),
ServerApp,
Hashable,
)
where
import Control.Monad.IO.Unlift
( MonadUnliftIO,
)
import Data.Morpheus.App
( App,
MapAPI (..),
runApp,
)
import Data.Morpheus.Subscriptions.Event
( Event (..),
runEvents,
)
import Data.Morpheus.Subscriptions.Internal
( ApiContext (..),
Input (..),
connectionThread,
initDefaultStore,
publishEventWith,
runStreamHTTP,
streamApp,
)
import Data.Morpheus.Subscriptions.WebSockets
( webSocketsWrapper,
)
import Network.WebSockets
( ServerApp,
)
import Relude
httpPubApp ::
( PubApp e,
MapAPI a b,
MonadIO m
) =>
[e -> m ()] ->
App e m ->
a ->
m b
httpPubApp :: [e -> m ()] -> App e m -> a -> m b
httpPubApp = [e -> m ()] -> App e m -> a -> m b
forall e (m :: * -> *) a b.
(PubApp e, MonadIO m, MapAPI a b) =>
[e -> m ()] -> App e m -> a -> m b
runPubApp
webSocketsApp ::
( MonadUnliftIO m,
MonadIO m,
SubApp ServerApp e
) =>
App e m ->
m (ServerApp, e -> m ())
webSocketsApp :: App e m -> m (ServerApp, e -> m ())
webSocketsApp = App e m -> m (ServerApp, e -> m ())
forall app e (m :: * -> *).
(SubApp app e, MonadIO m, MonadUnliftIO m) =>
App e m -> m (app, e -> m ())
runSubApp
class SubApp app e where
runSubApp :: (MonadIO m, MonadUnliftIO m) => App e m -> m (app, e -> m ())
class PubApp e where
runPubApp :: (MonadIO m, MapAPI a b) => [e -> m ()] -> App e m -> a -> m b
instance (Show ch, Eq ch, Hashable ch) => SubApp ServerApp (Event ch con) where
runSubApp :: App (Event ch con) m -> m (ServerApp, Event ch con -> m ())
runSubApp App (Event ch con) m
app = do
Store (Event ch con) m
store <- m (Store (Event ch con) m)
forall (m :: * -> *) (m2 :: * -> *) ch con.
(MonadIO m, MonadIO m2) =>
m2 (Store (Event ch con) m)
initDefaultStore
ServerApp
wsApp <- Store (Event ch con) m
-> (ApiContext SUB (Event ch con) m -> m ()) -> m ServerApp
forall (m :: * -> *) e.
(MonadUnliftIO m, MonadIO m) =>
Store e m -> (ApiContext SUB e m -> m ()) -> m ServerApp
webSocketsWrapper Store (Event ch con) m
store (App (Event ch con) m -> ApiContext SUB (Event ch con) m -> m ()
forall (m :: * -> *) ch con.
(MonadUnliftIO m, Eq ch, Hashable ch) =>
App (Event ch con) m -> ApiContext SUB (Event ch con) m -> m ()
connectionThread App (Event ch con) m
app)
(ServerApp, Event ch con -> m ())
-> m (ServerApp, Event ch con -> m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( ServerApp
wsApp,
Store (Event ch con) m -> Event ch con -> m ()
forall (m :: * -> *) channel cont.
(MonadIO m, Eq channel, Hashable channel, Show channel) =>
Store (Event channel cont) m -> Event channel cont -> m ()
publishEventWith Store (Event ch con) m
store
)
instance (Show ch, Eq ch, Hashable ch) => PubApp (Event ch con) where
runPubApp :: [Event ch con -> m ()] -> App (Event ch con) m -> a -> m b
runPubApp [] App (Event ch con) m
app = App (Event ch con) m -> a -> m b
forall a b (m :: * -> *) e.
(MapAPI a b, Monad m) =>
App e m -> a -> m b
runApp App (Event ch con) m
app
runPubApp [Event ch con -> m ()]
callbacks App (Event ch con) m
app =
(GQLRequest -> m GQLResponse) -> a -> m b
forall a b (m :: * -> *).
(MapAPI a b, Applicative m) =>
(GQLRequest -> m GQLResponse) -> a -> m b
mapAPI ((GQLRequest -> m GQLResponse) -> a -> m b)
-> (GQLRequest -> m GQLResponse) -> a -> m b
forall a b. (a -> b) -> a -> b
$
ApiContext PUB (Event ch con) m
-> Output PUB (Event ch con) m -> m GQLResponse
forall (m :: * -> *) e.
Monad m =>
ApiContext PUB e m -> Output PUB e m -> m GQLResponse
runStreamHTTP PubContext :: forall event (m :: * -> *).
(event -> m ()) -> ApiContext PUB event m
PubContext {eventPublisher :: Event ch con -> m ()
eventPublisher = [Event ch con -> m ()] -> Event ch con -> m ()
forall (t :: * -> *) (f :: * -> *) event b.
(Foldable t, Applicative f) =>
t (event -> f b) -> event -> f ()
runEvents [Event ch con -> m ()]
callbacks}
(Output PUB (Event ch con) m -> m GQLResponse)
-> (GQLRequest -> Output PUB (Event ch con) m)
-> GQLRequest
-> m GQLResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App (Event ch con) m -> Input PUB -> Output PUB (Event ch con) m
forall ch (m :: * -> *) con (api :: API).
(Eq ch, Monad m, Hashable ch) =>
App (Event ch con) m -> Input api -> Output api (Event ch con) m
streamApp App (Event ch con) m
app
(Input PUB -> Output PUB (Event ch con) m)
-> (GQLRequest -> Input PUB)
-> GQLRequest
-> Output PUB (Event ch con) m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLRequest -> Input PUB
Request
instance SubApp ServerApp () where
runSubApp :: App () m -> m (ServerApp, () -> m ())
runSubApp App () m
_ =
(ServerApp, () -> m ()) -> m (ServerApp, () -> m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( IO () -> ServerApp
forall a b. a -> b -> a
const (IO () -> ServerApp) -> IO () -> ServerApp
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
m () -> () -> m ()
forall a b. a -> b -> a
const (m () -> () -> m ()) -> m () -> () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
)
instance PubApp () where
runPubApp :: [() -> m ()] -> App () m -> a -> m b
runPubApp [() -> m ()]
_ = App () m -> a -> m b
forall a b (m :: * -> *) e.
(MapAPI a b, Monad m) =>
App e m -> a -> m b
runApp