yesod-eventsource: Update to Yesod 1.2.
This commit is contained in:
parent
5c434b089a
commit
8bde1b592f
@ -2,18 +2,16 @@
|
|||||||
-- | This module contains everything that you need to support
|
-- | This module contains everything that you need to support
|
||||||
-- server-sent events in Yesod applications.
|
-- server-sent events in Yesod applications.
|
||||||
module Yesod.EventSource
|
module Yesod.EventSource
|
||||||
( RepEventSource
|
( repEventSource
|
||||||
, repEventSource
|
, pollingEventSource
|
||||||
, ioToRepEventSource
|
, ioToRepEventSource
|
||||||
, EventSourcePolyfill(..)
|
, EventSourcePolyfill(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Blaze.ByteString.Builder (Builder)
|
import Blaze.ByteString.Builder (Builder)
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
import Data.Functor ((<$>))
|
import Data.Functor ((<$>))
|
||||||
import Data.Monoid (mappend, mempty)
|
import Data.Monoid (mappend, mempty)
|
||||||
import Yesod.Content
|
|
||||||
import Yesod.Core
|
import Yesod.Core
|
||||||
import qualified Data.Conduit as C
|
import qualified Data.Conduit as C
|
||||||
import qualified Network.Wai as W
|
import qualified Network.Wai as W
|
||||||
@ -22,52 +20,50 @@ import qualified Network.Wai.EventSource.EventStream as ES
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- | Data type representing a response of server-sent events
|
|
||||||
-- (e.g., see 'repEventSource' and 'ioToRepEventSource').
|
|
||||||
newtype RepEventSource =
|
|
||||||
RepEventSource (C.Source (C.ResourceT IO) (C.Flush Builder))
|
|
||||||
|
|
||||||
instance HasReps RepEventSource where
|
|
||||||
chooseRep (RepEventSource src) =
|
|
||||||
const $ return ("text/event-stream", ContentSource src)
|
|
||||||
|
|
||||||
|
|
||||||
-- | (Internal) Find out the request's 'EventSourcePolyfill' and
|
-- | (Internal) Find out the request's 'EventSourcePolyfill' and
|
||||||
-- set any necessary headers.
|
-- set any necessary headers.
|
||||||
prepareForEventSource :: GHandler sub master EventSourcePolyfill
|
prepareForEventSource :: MonadHandler m => m EventSourcePolyfill
|
||||||
prepareForEventSource = do
|
prepareForEventSource = do
|
||||||
reqWith <- lookup "X-Requested-With" . W.requestHeaders <$> waiRequest
|
reqWith <- lookup "X-Requested-With" . W.requestHeaders <$> waiRequest
|
||||||
let polyfill | reqWith == Just "XMLHttpRequest" = Remy'sESPolyfill
|
let polyfill | reqWith == Just "XMLHttpRequest" = Remy'sESPolyfill
|
||||||
| otherwise = NoESPolyfill
|
| otherwise = NoESPolyfill
|
||||||
setHeader "Cache-Control" "no-cache" -- extremely important!
|
addHeader "Cache-Control" "no-cache" -- extremely important!
|
||||||
return polyfill
|
return polyfill
|
||||||
|
|
||||||
|
|
||||||
|
-- | (Internal) Source with a event stream content-type.
|
||||||
|
respondEventStream :: C.Source (HandlerT site IO) (C.Flush Builder)
|
||||||
|
-> HandlerT site IO TypedContent
|
||||||
|
respondEventStream = respondSource "text/event-stream"
|
||||||
|
|
||||||
|
|
||||||
-- | Returns a Server-Sent Event stream from a 'C.Source' of
|
-- | Returns a Server-Sent Event stream from a 'C.Source' of
|
||||||
-- 'ES.ServerEvent'@s@. The HTTP socket is flushed after every
|
-- 'ES.ServerEvent'@s@. The HTTP socket is flushed after every
|
||||||
-- event. The connection is closed either when the 'C.Source'
|
-- event. The connection is closed either when the 'C.Source'
|
||||||
-- finishes outputting data or a 'ES.CloseEvent' is outputted,
|
-- finishes outputting data or a 'ES.CloseEvent' is outputted,
|
||||||
-- whichever comes first.
|
-- whichever comes first.
|
||||||
repEventSource :: (EventSourcePolyfill -> C.Source (C.ResourceT IO) ES.ServerEvent)
|
repEventSource :: (EventSourcePolyfill -> C.Source (HandlerT site IO) ES.ServerEvent)
|
||||||
-> GHandler sub master RepEventSource
|
-> HandlerT site IO TypedContent
|
||||||
repEventSource src = RepEventSource . ES.sourceToSource . src <$> prepareForEventSource
|
repEventSource src =
|
||||||
|
prepareForEventSource >>=
|
||||||
|
respondEventStream . ES.sourceToSource . src
|
||||||
|
|
||||||
|
|
||||||
-- | Return a Server-Sent Event stream given an @IO@ action that
|
-- | Return a Server-Sent Event stream given a 'HandlerT' action
|
||||||
-- is repeatedly called. A state is threaded for the action so
|
-- that is repeatedly called. A state is threaded for the action
|
||||||
-- that it may avoid using @IORefs@. The @IO@ action may sleep
|
-- so that it may avoid using @IORefs@. The @HandlerT@ action
|
||||||
-- or block while waiting for more data. The HTTP socket is
|
-- may sleep or block while waiting for more data. The HTTP
|
||||||
-- flushed after every list of simultaneous events. The
|
-- socket is flushed after every list of simultaneous events.
|
||||||
-- connection is closed as soon as an 'ES.CloseEvent' is
|
-- The connection is closed as soon as an 'ES.CloseEvent' is
|
||||||
-- outputted, after which no other events are sent to the client.
|
-- outputted, after which no other events are sent to the client.
|
||||||
ioToRepEventSource :: s
|
pollingEventSource :: s
|
||||||
-> (EventSourcePolyfill -> s -> IO ([ES.ServerEvent], s))
|
-> (EventSourcePolyfill -> s -> HandlerT site IO ([ES.ServerEvent], s))
|
||||||
-> GHandler sub master RepEventSource
|
-> HandlerT site IO TypedContent
|
||||||
ioToRepEventSource initial act = do
|
pollingEventSource initial act = do
|
||||||
polyfill <- prepareForEventSource
|
polyfill <- prepareForEventSource
|
||||||
let -- Get new events to be sent.
|
let -- Get new events to be sent.
|
||||||
getEvents s = do
|
getEvents s = do
|
||||||
(evs, s') <- liftIO (act polyfill s)
|
(evs, s') <- lift (act polyfill s)
|
||||||
case evs of
|
case evs of
|
||||||
[] -> getEvents s'
|
[] -> getEvents s'
|
||||||
_ -> do
|
_ -> do
|
||||||
@ -84,7 +80,21 @@ ioToRepEventSource initial act = do
|
|||||||
Nothing -> (fst $ joinEvents [] acc, False)
|
Nothing -> (fst $ joinEvents [] acc, False)
|
||||||
joinEvents [] acc = (acc, True)
|
joinEvents [] acc = (acc, True)
|
||||||
|
|
||||||
return $ RepEventSource $ getEvents initial
|
respondEventStream (getEvents initial)
|
||||||
|
|
||||||
|
|
||||||
|
-- | Return a Server-Sent Event stream given an @IO@ action that
|
||||||
|
-- is repeatedly called. A state is threaded for the action so
|
||||||
|
-- that it may avoid using @IORefs@. The @IO@ action may sleep
|
||||||
|
-- or block while waiting for more data. The HTTP socket is
|
||||||
|
-- flushed after every list of simultaneous events. The
|
||||||
|
-- connection is closed as soon as an 'ES.CloseEvent' is
|
||||||
|
-- outputted, after which no other events are sent to the client.
|
||||||
|
ioToRepEventSource :: s
|
||||||
|
-> (EventSourcePolyfill -> s -> IO ([ES.ServerEvent], s))
|
||||||
|
-> HandlerT site IO TypedContent
|
||||||
|
ioToRepEventSource initial act = pollingEventSource initial act'
|
||||||
|
where act' p s = liftIO (act p s)
|
||||||
|
|
||||||
|
|
||||||
-- | Which @EventSource@ polyfill was detected (if any).
|
-- | Which @EventSource@ polyfill was detected (if any).
|
||||||
|
|||||||
@ -1,5 +1,5 @@
|
|||||||
name: yesod-eventsource
|
name: yesod-eventsource
|
||||||
version: 1.0.1
|
version: 1.1
|
||||||
license: MIT
|
license: MIT
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Felipe Lessa <felipe.lessa@gmail.com>
|
author: Felipe Lessa <felipe.lessa@gmail.com>
|
||||||
@ -28,7 +28,7 @@ description:
|
|||||||
|
|
||||||
library
|
library
|
||||||
build-depends: base >= 4 && < 5
|
build-depends: base >= 4 && < 5
|
||||||
, yesod-core >= 1.1 && < 1.2
|
, yesod-core == 1.2.*
|
||||||
, conduit >= 0.5 && < 1.1
|
, conduit >= 0.5 && < 1.1
|
||||||
, wai >= 1.3 && < 1.5
|
, wai >= 1.3 && < 1.5
|
||||||
, wai-eventsource >= 1.3 && < 1.4
|
, wai-eventsource >= 1.3 && < 1.4
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user