wai-eventsource (empty) → 1.0.0
raw patch · 5 files changed
+180/−0 lines, 5 filesdep +basedep +blaze-builderdep +bytestringsetup-changed
Dependencies added: base, blaze-builder, bytestring, conduit, http-types, transformers, wai, warp
Files
- LICENSE +25/−0
- Setup.lhs +7/−0
- src/Network/Wai/EventSource.hs +32/−0
- src/Network/Wai/EventSource/EventStream.hs +83/−0
- wai-eventsource.cabal +33/−0
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2012, Chris Smith, Mathias Biilmann Christensen. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ src/Network/Wai/EventSource.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.EventSource (+ ServerEvent(..),+ eventSourceApp+ ) where++import Blaze.ByteString.Builder (Builder)+import Control.Concurrent.Chan (Chan, dupChan, readChan)+import Control.Monad.IO.Class (liftIO)+import qualified Data.Conduit as C+import Network.HTTP.Types (statusOK)+import Network.Wai (Application, Response(..))++import Network.Wai.EventSource.EventStream++-- | Make a new WAI EventSource application reading events from+-- the given channel.+eventSourceApp :: Chan ServerEvent -> Application+eventSourceApp chan _ = do+ chan' <- liftIO $ dupChan chan+ return $ res chan'++res :: Chan ServerEvent -> Response+res chan = ResponseSource statusOK [("Content-Type", "text/event-stream")] $ resE chan++resE :: Chan ServerEvent -> C.Source IO Builder+resE chan =+ C.sourceIO ign (const ign) (const $ fmap (f . eventToBuilder) $ readChan chan)+ where+ ign = return ()+ f Nothing = C.Closed+ f (Just b) = C.Open b
+ src/Network/Wai/EventSource/EventStream.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}+{- code adapted by Mathias Billman originaly from Chris Smith https://github.com/cdsmith/gloss-web -}++{-|+ A WAI adapter to the HTML5 Server-Sent Events API. Push-mode and+ pull-mode interfaces are both available.+-}+module Network.Wai.EventSource.EventStream (+ ServerEvent(..),+ eventToBuilder+ ) where++import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char8+import Data.Monoid++{-|+ Type representing a communication over an event stream. This can be an+ actual event, a comment, a modification to the retry timer, or a special+ "close" event indicating the server should close the connection.+-}+data ServerEvent+ = ServerEvent {+ eventName :: Maybe Builder,+ eventId :: Maybe Builder,+ eventData :: [Builder]+ }+ | CommentEvent {+ eventComment :: Builder+ }+ | RetryEvent {+ eventRetry :: Int+ }+ | CloseEvent+++{-|+ Newline as a Builder.+-}+nl :: Builder+nl = fromChar '\n'+++{-|+ Field names as Builder+-}+nameField, idField, dataField, retryField, commentField :: Builder+nameField = fromString "event:"+idField = fromString "id:"+dataField = fromString "data:"+retryField = fromString "retry:"+commentField = fromChar ':'+++{-|+ Wraps the text as a labeled field of an event stream.+-}+field :: Builder -> Builder -> Builder+field l b = l `mappend` b `mappend` nl+++{-|+ Appends a buffer flush to the end of a Builder.+-}+flushAfter :: Builder -> Builder+flushAfter b = b `mappend` flush+++{-|+ Converts a 'ServerEvent' to its wire representation as specified by the+ @text/event-stream@ content type.+-}+eventToBuilder :: ServerEvent -> Maybe Builder+eventToBuilder (CommentEvent txt) = Just $ flushAfter $ field commentField txt+eventToBuilder (RetryEvent n) = Just $ flushAfter $ field retryField (fromShow n)+eventToBuilder (CloseEvent) = Nothing+eventToBuilder (ServerEvent n i d)= Just $ flushAfter $+ (name n $ evid i $ mconcat (map (field dataField) d)) `mappend` nl+ where+ name Nothing = id+ name (Just n') = mappend (field nameField n')+ evid Nothing = id+ evid (Just i') = mappend (field idField i')
+ wai-eventsource.cabal view
@@ -0,0 +1,33 @@+Name: wai-eventsource+Version: 1.0.0+Synopsis: WAI support for server-sent events+Description: WAI support for server-sent events+License: BSD3+Author: Chris Smith, Mathias Biilmann Christensen+Maintainer: greg@gregweber.info+Stability: Experimental+Category: Web+Build-type: Simple+Cabal-version: >=1.8+homepage: http://www.yesodweb.com/book/wai+license-file: LICENSE++Library+ Build-depends:+ base >= 4.3 && < 5+ , bytestring >= 0.9.1.4 && < 0.10+ , blaze-builder >= 0.3 && < 0.4+ , conduit+ , http-types >= 0.6 && < 0.7+ , wai >= 1.0+ , warp >= 1.0+ , transformers++ ghc-options: -Wall+ hs-source-dirs: src+ exposed-modules: Network.Wai.EventSource+ other-modules: Network.Wai.EventSource.EventStream++source-repository head+ type: git+ location: git://github.com/yesodweb/wai.git