git.iko.soy/typeable/wai
on master help sign in
Merge pull request #50 from maoe/feature/eventsource-other-interfaces
0c93546Michael Snoyman
wai-eventsource/src/Main.hs+27−6
compare with master
unifiedsplit
@@ -3,6 +3,7 @@ module Main where
3
3
4import Control.Monad
4import Control.Monad
5import Control.Concurrent (forkIO, threadDelay)
5import Control.Concurrent (forkIO, threadDelay)
6+import Control.Monad.Trans (liftIO)
6import Control.Concurrent.Chan
7import Control.Concurrent.Chan
7import Network.Wai.Handler.Warp (run)
8import Network.Wai.Handler.Warp (run)
8import Network.Wai.Middleware.Gzip (gzip, def)
9import Network.Wai.Middleware.Gzip (gzip, def)
@@ -10,6 +11,7 @@ import Network.Wai
10import Network.HTTP.Types (statusOK)
11import Network.HTTP.Types (statusOK)
11import Data.Time.Clock.POSIX
12import Data.Time.Clock.POSIX
12import Blaze.ByteString.Builder.Char.Utf8 (fromString)
13import Blaze.ByteString.Builder.Char.Utf8 (fromString)
14+import qualified Data.Conduit as C
13
15
14import Network.Wai.EventSource
16import Network.Wai.EventSource
15
17
@@ -17,19 +19,38 @@ app :: Chan ServerEvent -> Application
17app chan req =
19app chan req =
18 case pathInfo req of
20 case pathInfo req of
19 [] -> return $ ResponseFile statusOK [("Content-Type", "text/html")] "static/index.html" Nothing
21 [] -> return $ ResponseFile statusOK [("Content-Type", "text/html")] "static/index.html" Nothing
20− ["es"] -> eventSourceApp chan req
22+ ["esold"] -> eventSourceApp chan req
23+ ["eschan"] -> eventSourceAppChan chan req
24+ ["esio"] -> eventSourceAppIO eventIO req
25+ ["essrc"] -> eventSourceAppSource eventSource req
21 _ -> error "unexpected pathInfo"
26 _ -> error "unexpected pathInfo"
22
27
23−
24−source :: Chan ServerEvent -> IO ()
28+eventChan :: Chan ServerEvent -> IO ()
25−source chan = forever $ do
29+eventChan chan = forever $ do
26 threadDelay 1000000
30 threadDelay 1000000
27 time <- getPOSIXTime
31 time <- getPOSIXTime
28 writeChan chan (ServerEvent Nothing Nothing [fromString . show $ time])
32 writeChan chan (ServerEvent Nothing Nothing [fromString . show $ time])
29
33
34+eventIO :: IO ServerEvent
35+eventIO = do
36+ threadDelay 1000000
37+ time <- getPOSIXTime
38+ return $ ServerEvent (Just $ fromString "io")
39+ Nothing
40+ [fromString . show $ time]
41+
42+eventSource :: C.Source IO ServerEvent
43+eventSource = C.sourceState () (const pull)
44+ where
45+ pull = do
46+ time <- liftIO $ do
47+ threadDelay 1000000
48+ getPOSIXTime
49+ return $ C.StateOpen () $ ServerEvent (Just $ fromString "source")
50+ Nothing
51+ [fromString . show $ time]
30
52
31−main :: IO ()
32main = do
53main = do
33 chan <- newChan
54 chan <- newChan
34− _ <- forkIO . source $ chan
55+ _ <- forkIO . eventChan $ chan
35 run 8000 (gzip def $ app chan)
56 run 8000 (gzip def $ app chan)
wai-eventsource/src/Network/Wai/EventSource.hs+47−7
@@ -1,13 +1,18 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2module Network.Wai.EventSource (
2module Network.Wai.EventSource (
3 ServerEvent(..),
3 ServerEvent(..),
4− eventSourceApp
4+ eventSourceApp,
5+ eventSourceAppChan,
6+ eventSourceAppSource,
7+ eventSourceAppIO
5 ) where
8 ) where
6
9
7import Blaze.ByteString.Builder (Builder)
10import Blaze.ByteString.Builder (Builder)
8import Control.Concurrent.Chan (Chan, dupChan, readChan)
11import Control.Concurrent.Chan (Chan, dupChan, readChan)
9import Control.Monad.IO.Class (liftIO)
12import Control.Monad.IO.Class (liftIO)
13+import Data.Conduit (($=))
10import qualified Data.Conduit as C
14import qualified Data.Conduit as C
15+import qualified Data.Conduit.List as CL
11import Network.HTTP.Types (statusOK)
16import Network.HTTP.Types (statusOK)
12import Network.Wai (Application, Response(..))
17import Network.Wai (Application, Response(..))
13
18
@@ -16,15 +21,31 @@ import Network.Wai.EventSource.EventStream
16-- | Make a new WAI EventSource application reading events from
21-- | Make a new WAI EventSource application reading events from
17-- the given channel.
22-- the given channel.
18eventSourceApp :: Chan ServerEvent -> Application
23eventSourceApp :: Chan ServerEvent -> Application
19−eventSourceApp chan _ = do
24+eventSourceApp = eventSourceAppChan
25+{-# DEPRECATED eventSourceApp "Use evnetSourceAppChan instead." #-}
26+
27+-- | Make a new WAI EventSource application reading events from
28+-- the given channel.
29+eventSourceAppChan :: Chan ServerEvent -> Application
30+eventSourceAppChan chan _ = do
20 chan' <- liftIO $ dupChan chan
31 chan' <- liftIO $ dupChan chan
21− return $ res chan'
32+ return $ response chanToSource chan'
22
33
23−res :: Chan ServerEvent -> Response
34+-- | Make a new WAI EventSource application reading events from
24−res chan = ResponseSource statusOK [("Content-Type", "text/event-stream")] $ resE chan
35+-- the given source.
36+eventSourceAppSource :: C.Source IO ServerEvent -> Application
37+eventSourceAppSource src _ = return $ response sourceToSource src
25
38
39+-- | Make a new WAI EventSource application reading events from
40+-- the given IO action.
41+eventSourceAppIO :: IO ServerEvent -> Application
42+eventSourceAppIO act _ = return $ response ioToSource act
43+
44+response :: (a -> C.Source IO (C.Flush Builder)) -> a -> Response
45+response f a = ResponseSource statusOK [("Content-Type", "text/event-stream")] $ f a
46+
26−resE :: Chan ServerEvent -> C.Source IO (C.Flush Builder)
47+chanToSource :: Chan ServerEvent -> C.Source IO (C.Flush Builder)
27−resE chan =
48+chanToSource chan =
28 C.sourceState Nothing pull
49 C.sourceState Nothing pull
29 where
50 where
30 pull Nothing = do
51 pull Nothing = do
@@ -33,3 +54,22 @@ resE chan =
33 Nothing -> C.StateClosed
54 Nothing -> C.StateClosed
34 Just y -> C.StateOpen (Just C.Flush) (C.Chunk y)
55 Just y -> C.StateOpen (Just C.Flush) (C.Chunk y)
35 pull (Just x) = return $ C.StateOpen Nothing x
56 pull (Just x) = return $ C.StateOpen Nothing x
57+
58+ioToSource :: IO ServerEvent -> C.Source IO (C.Flush Builder)
59+ioToSource act =
60+ C.sourceState Nothing pull
61+ where
62+ pull Nothing = do
63+ x <- liftIO act
64+ return $ case eventToBuilder x of
65+ Nothing -> C.StateClosed
66+ Just y -> C.StateOpen (Just C.Flush) (C.Chunk y)
67+ pull (Just x) = return $ C.StateOpen Nothing x
68+
69+sourceToSource :: C.Source IO ServerEvent -> C.Source IO (C.Flush Builder)
70+sourceToSource src = src $= CL.concatMap eventToFlushBuilder
71+ where
72+ eventToFlushBuilder event =
73+ case eventToBuilder event of
74+ Nothing -> []
75+ Just x -> [C.Chunk x, C.Flush]