| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Reflex.Dom.GadtApi.WebSocket
Synopsis
- performWebSocketRequests :: forall (req :: Type -> Type) t m. (Prerender t m, Applicative m, FromJSON (Some req), forall a. ToJSON (req a), Has FromJSON req) => WebSocketEndpoint -> Event t (RequesterData req) -> m (Event t (RequesterData (Either Text)))
- data TaggedRequest = TaggedRequest Int Value
- data TaggedResponse = TaggedResponse Int Value
- mkTaggedResponse :: (Monad m, FromJSON (Some f), Has ToJSON f) => TaggedRequest -> (forall a. f a -> m a) -> m (Either String TaggedResponse)
- type WebSocketEndpoint = Text
- tagRequests :: forall (req :: Type -> Type) t m. (Applicative m, FromJSON (Some req), forall a. ToJSON (req a), Has FromJSON req, Monad m, MonadFix m, Reflex t, MonadHold t m) => Event t (RequesterData req) -> Event t TaggedResponse -> m (Event t [TaggedRequest], Event t (RequesterData (Either Text)))
Documentation
performWebSocketRequests :: forall (req :: Type -> Type) t m. (Prerender t m, Applicative m, FromJSON (Some req), forall a. ToJSON (req a), Has FromJSON req) => WebSocketEndpoint -> Event t (RequesterData req) -> m (Event t (RequesterData (Either Text))) Source #
Opens a websockets connection, takes the output of a RequesterT widget
and issues that output as API requests over the socket. The result of this
function can be fed back into the requester as responses. For example:
rec (appResult, requests) <- runRequesterT myApplication responses
responses <- performWebSocketRequests myEndpoint requests
data TaggedRequest Source #
A request tagged with an identifier
Constructors
| TaggedRequest Int Value |
Instances
data TaggedResponse Source #
A response tagged with an identifier matching the one in the TaggedRequest. The identifier is the first argument.
Constructors
| TaggedResponse Int Value |
Instances
| FromJSON TaggedResponse Source # | |||||
Defined in Reflex.Dom.GadtApi.WebSocket Methods parseJSON :: Value -> Parser TaggedResponse # parseJSONList :: Value -> Parser [TaggedResponse] # | |||||
| ToJSON TaggedResponse Source # | |||||
Defined in Reflex.Dom.GadtApi.WebSocket Methods toJSON :: TaggedResponse -> Value # toEncoding :: TaggedResponse -> Encoding # toJSONList :: [TaggedResponse] -> Value # toEncodingList :: [TaggedResponse] -> Encoding # omitField :: TaggedResponse -> Bool # | |||||
| Generic TaggedResponse Source # | |||||
Defined in Reflex.Dom.GadtApi.WebSocket Associated Types
Methods from :: TaggedResponse -> Rep TaggedResponse x # to :: Rep TaggedResponse x -> TaggedResponse # | |||||
| type Rep TaggedResponse Source # | |||||
Defined in Reflex.Dom.GadtApi.WebSocket type Rep TaggedResponse = D1 ('MetaData "TaggedResponse" "Reflex.Dom.GadtApi.WebSocket" "reflex-gadt-api-0.2.2.3-inplace" 'False) (C1 ('MetaCons "TaggedResponse" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Value))) | |||||
mkTaggedResponse :: (Monad m, FromJSON (Some f), Has ToJSON f) => TaggedRequest -> (forall a. f a -> m a) -> m (Either String TaggedResponse) Source #
Constructs a response for a given request, and handles the decoding/encoding and tagging steps internal to TaggedRequest and TaggedResponse.
type WebSocketEndpoint = Text Source #
tagRequests :: forall (req :: Type -> Type) t m. (Applicative m, FromJSON (Some req), forall a. ToJSON (req a), Has FromJSON req, Monad m, MonadFix m, Reflex t, MonadHold t m) => Event t (RequesterData req) -> Event t TaggedResponse -> m (Event t [TaggedRequest], Event t (RequesterData (Either Text))) Source #
This function transforms a request Event into an Event of
TaggedRequests (the indexed wire format used to transmit requests). It
expects to receive an Event of TaggedResponse, the corresponding
response wire format, which it will transform into an "untagged" response.
requests --> |-------------| --> tagged requests
↗ | | ↘
Client | tagRequests | Server
↖ | | ↙
responses <-- |-------------| <-- tagged responses
This function is provided so that you can use a single websocket for
multiple purposes without reimplementing the functionality of
performWebSocketRequests. For instance, you might have a websocket split
into two "channels," one for these tagged API requests and another for data
being pushed from the server.