git.iko.soy/typeable/wai
on master help sign in
Move ServerEvent channel handling to separate module.
e1d17c5Bardur Arantsson
wai-eventsource/src/Main.hs+2−21
compare with master
unifiedsplit
@@ -2,43 +2,24 @@
2module Main where
2module Main where
3
3
4import Control.Monad
4import Control.Monad
5−import Control.Monad.Trans
6import Control.Concurrent (forkIO, threadDelay)
5import Control.Concurrent (forkIO, threadDelay)
7import Control.Concurrent.Chan
6import Control.Concurrent.Chan
8import Network.Wai.Handler.Warp (run)
7import Network.Wai.Handler.Warp (run)
9import Network.Wai
8import Network.Wai
10import Network.HTTP.Types (statusOK)
9import Network.HTTP.Types (statusOK)
11−import qualified Data.Conduit as C
12import Data.Time.Clock.POSIX
10import Data.Time.Clock.POSIX
13import Blaze.ByteString.Builder.Char.Utf8 (fromString)
11import Blaze.ByteString.Builder.Char.Utf8 (fromString)
14−import Blaze.ByteString.Builder (Builder)
15−
16−import EventStream
17
12
13+import Network.Wai.EventSource
18
14
19app :: Chan ServerEvent -> Application
15app :: Chan ServerEvent -> Application
20app chan req =
16app chan req =
21 case pathInfo req of
17 case pathInfo req of
22 [] -> return $ ResponseFile statusOK [("Content-Type", "text/html")] "static/index.html" Nothing
18 [] -> return $ ResponseFile statusOK [("Content-Type", "text/html")] "static/index.html" Nothing
23− ["es"] -> do
19+ ["es"] -> eventSourceApp chan req
24− chan' <- liftIO $ dupChan chan
25− return $ res chan'
26 _ -> error "unexpected pathInfo"
20 _ -> error "unexpected pathInfo"
27
21
28
22
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−
42source :: Chan ServerEvent -> IO ()
23source :: Chan ServerEvent -> IO ()
43source chan = forever $ do
24source chan = forever $ do
44 threadDelay 1000000
25 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 @@
5 A WAI adapter to the HTML5 Server-Sent Events API. Push-mode and
5 A WAI adapter to the HTML5 Server-Sent Events API. Push-mode and
6 pull-mode interfaces are both available.
6 pull-mode interfaces are both available.
7-}
7-}
8−module EventStream (
8+module Network.Wai.EventSource.EventStream (
9 ServerEvent(..),
9 ServerEvent(..),
10 eventToBuilder
10 eventToBuilder
11 ) where
11 ) where
wai-eventsource/wai-eventsource.cabal+17−1
@@ -12,7 +12,23 @@ Cabal-version: >=1.2
12
12
13flag example
13flag example
14
14
15+
15−-- TODO: Library interface
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
16
32
17Executable wai-eventsource
33Executable wai-eventsource
18 if flag(example)
34 if flag(example)