yesod-eventsource: Update to Yesod 1.2.

This commit is contained in:
Felipe Lessa 2013-05-03 21:21:53 -03:00
parent 5c434b089a
commit 8bde1b592f
2 changed files with 43 additions and 33 deletions

View File

@ -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).

View File

@ -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