deckool/Main.hs

## index.html
<!doctype html>
<html>
  <head><title>Index</title>
  </head>
  <body>
    <script type="text/javascript">
      var source = new EventSource('eventsource');
      source.onmessage = function (e) {
          var newListItem = document.createElement("LI");
          newListItem.appendChild(document.createTextNode(e.data));
          document.getElementById("list").appendChild(newListItem);
      };
    </script>
    <ul id="list">
    </ul>
  </body>
</html>

## Main.hs
{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Applicative
import Snap.Core
import Snap.Util.FileServe
import Snap.Http.Server
import Data.Monoid (mconcat)
import Blaze.ByteString.Builder.Char8
import Blaze.ByteString.Builder
import Data.Enumerator.List (generateM)

import Database.Redis

getVal :: IO Builder
getVal = do
    conn <- connect defaultConnectInfo
    runRedis conn $ do
        Right (Just (_, val)) <- brpop ["val"] 1000
        return $ fromByteString val

dataField :: Builder -> Builder
dataField b = mconcat [fromString "data: ", b, fromString "\n\n", flush]

eventHandler :: Snap ()
eventHandler = do
    modifyResponse $
      setContentType "text/event-stream" .
      setResponseCode 200 .
      setResponseBody (generateM $ fmap (Just . dataField) getVal)

main :: IO ()
main = quickHttpServe $
    ifTop (serveFile "static/index.html") <|>
    route [ ("eventsource", eventHandler) ]
	<!doctype html>
	<html>
	<head><title>Index</title>
	</head>
	<body>
	<script type="text/javascript">
	var source = new EventSource('eventsource');
	source.onmessage = function (e) {
	var newListItem = document.createElement("LI");
	newListItem.appendChild(document.createTextNode(e.data));
	document.getElementById("list").appendChild(newListItem);
	};
	</script>
	<ul id="list">
	</ul>
	</body>
	</html>
	{-# LANGUAGE OverloadedStrings #-}
	module Main where

	import Control.Applicative
	import Snap.Core
	import Snap.Util.FileServe
	import Snap.Http.Server
	import Data.Monoid (mconcat)
	import Blaze.ByteString.Builder.Char8
	import Blaze.ByteString.Builder
	import Data.Enumerator.List (generateM)

	import Database.Redis

	getVal :: IO Builder
	getVal = do
	conn <- connect defaultConnectInfo
	runRedis conn $ do
	Right (Just (_, val)) <- brpop ["val"] 1000
	return $ fromByteString val

	dataField :: Builder -> Builder
	dataField b = mconcat [fromString "data: ", b, fromString "\n\n", flush]

	eventHandler :: Snap ()
	eventHandler = do
	modifyResponse $
	setContentType "text/event-stream" .
	setResponseCode 200 .
	setResponseBody (generateM $ fmap (Just . dataField) getVal)

	main :: IO ()
	main = quickHttpServe $
	ifTop (serveFile "static/index.html") <\|>
	route [ ("eventsource", eventHandler) ]