wai-eventsource 1.2.1.1 → 1.3.0

raw patch · 3 files changed

+35/−38 lines, 3 filesdep ~conduitdep ~http-typesdep ~wai

Dependency ranges changed: conduit, http-types, wai, warp

Files

• src/Network/Wai/EventSource.hs +16/−26
• src/Network/Wai/EventSource/EventStream.hs +12/−4
• wai-eventsource.cabal +7/−8

@@ -1,7 +1,4 @@ {-# LANGUAGE OverloadedStrings #-}-{-|-    A WAI adapter to the HTML5 Server-Sent Events API.--} module Network.Wai.EventSource (     ServerEvent(..),     eventSourceAppChan,@@ -13,8 +10,7 @@ import           Blaze.ByteString.Builder (Builder) import           Control.Concurrent.Chan (Chan, dupChan, readChan) import           Control.Monad.IO.Class (liftIO)-import           Data.Conduit (($=))-import qualified Data.Conduit as C+import           Data.Conduit import qualified Data.Conduit.List as CL import           Network.HTTP.Types (status200) import           Network.Wai (Application, Response(..))@@ -30,7 +26,7 @@  -- | Make a new WAI EventSource application reading events from -- the given source.-eventSourceAppSource :: C.Source (C.ResourceT IO) ServerEvent -> Application+eventSourceAppSource :: Source (ResourceT IO) ServerEvent -> Application eventSourceAppSource src _ = return $ response sourceToSource src  -- | Make a new WAI EventSource application reading events from@@ -38,37 +34,31 @@ eventSourceAppIO :: IO ServerEvent -> Application eventSourceAppIO act _ = return $ response ioToSource act -response :: (a -> C.Source (C.ResourceT IO) (C.Flush Builder)) -> a -> Response+response :: (a -> Source (ResourceT IO) (Flush Builder)) -> a -> Response response f a = ResponseSource status200 [("Content-Type", "text/event-stream")] $ f a -chanToSource :: Chan ServerEvent -> C.Source (C.ResourceT IO) (C.Flush Builder)-chanToSource chan =-    C.sourceState Nothing pull-  where-    pull Nothing = do-        x <- liftIO $ readChan chan-        return $ case eventToBuilder x of-            Nothing -> C.StateClosed-            Just y -> C.StateOpen (Just C.Flush) (C.Chunk y)-    pull (Just x) = return $ C.StateOpen Nothing x+chanToSource :: Chan ServerEvent -> Source (ResourceT IO) (Flush Builder)+chanToSource = ioToSource . readChan -ioToSource :: IO ServerEvent -> C.Source (C.ResourceT IO) (C.Flush Builder)+ioToSource :: IO ServerEvent -> Source (ResourceT IO) (Flush Builder) ioToSource act =-    C.sourceState Nothing pull+    loop   where-    pull Nothing = do+    loop = do         x <- liftIO act-        return $ case eventToBuilder x of-            Nothing -> C.StateClosed-            Just y -> C.StateOpen (Just C.Flush) (C.Chunk y)-    pull (Just x) = return $ C.StateOpen Nothing x+        case eventToBuilder x of+            Nothing -> return ()+            Just y -> do+                yield $ Chunk y+                yield Flush+                loop  -- | Convert a ServerEvent source into a Builder source of serialized -- events.-sourceToSource :: Monad m => C.Source m ServerEvent -> C.Source m (C.Flush Builder)+sourceToSource :: Monad m => Source m ServerEvent -> Source m (Flush Builder) sourceToSource src = src $= CL.concatMap eventToFlushBuilder   where     eventToFlushBuilder event =         case eventToBuilder event of             Nothing -> []-            Just x -> [C.Chunk x, C.Flush]+            Just x -> [Chunk x, Flush]

@@ -2,7 +2,8 @@ {- code adapted by Mathias Billman originaly from Chris Smith https://github.com/cdsmith/gloss-web -}  {-|-    Internal module, usually you don't need to use it.+    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(..),@@ -59,14 +60,21 @@   {-|+    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 $ field commentField txt-eventToBuilder (RetryEvent   n)   = Just $ field retryField (fromShow n)+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 $+eventToBuilder (ServerEvent n i d)= Just $ flushAfter $     (name n $ evid i $ mconcat (map (field dataField) d)) `mappend` nl   where     name Nothing  = id

@@ -1,5 +1,5 @@ Name:                wai-eventsource-Version:             1.2.1.1+Version:             1.3.0 Synopsis:            WAI support for server-sent events Description:         WAI support for server-sent events License:             MIT@@ -17,17 +17,16 @@       base                      >= 4.3 && < 5     , bytestring                >= 0.9.1.4     , blaze-builder             >= 0.3 && < 0.4-    , conduit                   >= 0.4      && < 0.5-    , http-types                >= 0.6      && < 0.7-    , wai                       >= 1.2      && < 1.3-    , warp                      >= 1.2      && < 1.3+    , conduit                   >= 0.5      && < 0.6+    , http-types                >= 0.7      && < 0.8+    , wai                       >= 1.3      && < 1.4+    , warp                      >= 1.3      && < 1.4     , transformers    ghc-options:     -Wall   hs-source-dirs:  src-  exposed-modules:-    Network.Wai.EventSource-    Network.Wai.EventSource.EventStream+  exposed-modules: Network.Wai.EventSource+  other-modules:   Network.Wai.EventSource.EventStream  source-repository head   type:     git