git.iko.soy/typeable/wai
on master help sign in
Move ServerEvent channel handling to separate module.
commite1d17c5db7dc4382d672e6d5cdbc5700143d766d authorBardur Arantsson <bardur@scientician.net> dateThu 12 Jan 2012, 22:34 (15 years ago) parent2f7f82f
4 files changed+52−23
compare with master
unifiedsplit
wai-eventsource/src/Main.hs+2−21 wai-eventsource/src/Network/Wai/EventSource.hs+32 wai-eventsource/src/EventStream.hs → wai-eventsource/src/Network/Wai/EventSource/EventStream.hs+1−1 wai-eventsource/wai-eventsource.cabal+17−1
wai-eventsource/src/Main.hs+2−21
@@ -2,43 +2,24 @@
22module Main where
33
44import Control.Monad
5−import Control.Monad.Trans
65import Control.Concurrent (forkIO, threadDelay)
76import Control.Concurrent.Chan
87import Network.Wai.Handler.Warp (run)
98import Network.Wai
109import Network.HTTP.Types (statusOK)
11−import qualified Data.Conduit as C
1210import Data.Time.Clock.POSIX
1311import Blaze.ByteString.Builder.Char.Utf8 (fromString)
14−import Blaze.ByteString.Builder (Builder)
15−
16−import EventStream
1712
13+import Network.Wai.EventSource
1814
1915app :: Chan ServerEvent -> Application
2016app chan req =
2117 case pathInfo req of
2218 [] -> return $ ResponseFile statusOK [("Content-Type", "text/html")] "static/index.html" Nothing
23− ["es"] -> do
24− chan' <- liftIO $ dupChan chan
25− return $ res chan'
19+ ["es"] -> eventSourceApp chan req
2620 _ -> error "unexpected pathInfo"
2721
2822
29−res :: Chan ServerEvent -> Response
30−res chan = ResponseSource statusOK [("Content-Type", "text/event-stream")] (resE chan)
31−
32−
33−resE :: Chan ServerEvent -> C.Source IO Builder
34−resE chan =
35− C.sourceIO ign (\_ -> ign) (\_ -> fmap (f . eventToBuilder) $ readChan chan)
36− where
37− ign = return ()
38− f Nothing = C.Closed
39− f (Just b) = C.Open b
40−
41−
4223source :: Chan ServerEvent -> IO ()
4324source chan = forever $ do
4425 threadDelay 1000000
wai-eventsource/src/Network/Wai/EventSource.hsnew file+32
@@ -0,0 +1,32 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Network.Wai.EventSource (
3+ ServerEvent(..),
4+ eventSourceApp
5+ ) where
6+
7+import Blaze.ByteString.Builder (Builder)
8+import Control.Concurrent.Chan (Chan, dupChan, readChan)
9+import Control.Monad.Trans (liftIO)
10+import qualified Data.Conduit as C
11+import Network.HTTP.Types (statusOK)
12+import Network.Wai (Application, Response(..))
13+
14+import Network.Wai.EventSource.EventStream
15+
16+-- | Make a new WAI EventSource application reading events from
17+-- the given channel.
18+eventSourceApp :: Chan ServerEvent -> Application
19+eventSourceApp chan _ = do
20+ chan' <- liftIO $ dupChan chan
21+ return $ res chan'
22+
23+res :: Chan ServerEvent -> Response
24+res chan = ResponseSource statusOK [("Content-Type", "text/event-stream")] $ resE chan
25+
26+resE :: Chan ServerEvent -> C.Source IO Builder
27+resE chan =
28+ C.sourceIO ign (const ign) (const $ fmap (f . eventToBuilder) $ readChan chan)
29+ where
30+ ign = return ()
31+ f Nothing = C.Closed
32+ f (Just b) = C.Open b
wai-eventsource/src/EventStream.hs → wai-eventsource/src/Network/Wai/EventSource/EventStream.hsrenamed+1−1
@@ -5,7 +5,7 @@
55 A WAI adapter to the HTML5 Server-Sent Events API. Push-mode and
66 pull-mode interfaces are both available.
77-}
8−module EventStream (
8+module Network.Wai.EventSource.EventStream (
99 ServerEvent(..),
1010 eventToBuilder
1111 ) where
wai-eventsource/wai-eventsource.cabal+17−1
@@ -12,7 +12,23 @@ Cabal-version: >=1.2
1212
1313flag example
1414
15−-- TODO: Library interface
15+
16+Library
17+ Build-depends:
18+ base >= 4.3 && < 5
19+ , bytestring >= 0.9.1.4 && < 0.10
20+ , blaze-builder >= 0.3 && < 0.4
21+ , conduit >= 0.0 && < 0.1
22+ , MonadCatchIO-transformers >= 0.2.1 && < 0.3
23+ , mtl >= 2 && < 3
24+ , http-types >= 0.6 && < 0.7
25+ , wai >= 0.4
26+ , warp >= 0.4
27+
28+ ghc-options: -Wall
29+ hs-source-dirs: src
30+ exposed-modules: Network.Wai.EventSource
31+ other-modules: Network.Wai.EventSource.EventStream
1632
1733Executable wai-eventsource
1834 if flag(example)