This post is merely about getting an EventSource app running in Yesod. For the JavaScript parts, I refer you to two articles:
Those are the two sources I have been using myself. Regarding the chapter in the Yesod book on the matter of EventSources, I think that particular example could have been somewhat clearer and more direct if there hadn't been several concepts involved at the same time (subsite, EventSource, the wiki thing). Hence this post, that in essence strips away everything but the EventSource skeleton. I have taken the liberty to put a little flesh on its clean-picked bones, however, and use three div's into which I write the data of three different events. This is just to exemplify how this is done both in the client side script and in the server handler.
There's also a new package called yesod-eventsource out. I'm sure it's great, but I couldn't wrap my head around it in 5 minutes since there are no working examples. I therefore went with using Wai's EventSource instead just as in the Yesod book.
But, I digress. The code is available in the Github repo https://github.com/obscaenvs/yest, aswell as here for your benefit:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 | {-# LANGUAGE OverloadedStrings, TypeFamilies, QuasiQuotes, TemplateHaskell, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} import Yesod import Yesod.Form.Jquery import Control.Concurrent.Chan (Chan, dupChan, writeChan, newChan) import Control.Concurrent (forkIO, threadDelay) import Data.Text (Text, pack) import Network.Wai.EventSource (ServerEvent (..), eventSourceAppChan) import Blaze.ByteString.Builder.Char.Utf8 (fromText, fromString) import Data.Monoid (mappend) data ESrc = ESrc (Chan ServerEvent) -- just a var pageTitleText = "The Great Yesod EventSource Experiment of September 2012" :: Text mkYesod "ESrc" [parseRoutes| /recv ReceiveR GET /setup SetupR GET |] instance Yesod ESrc where defaultLayout w = do y <- getYesod p <- widgetToPageContent (w `mappend` addScriptEither (urlJqueryJs y)) mmsg <- getMessage hamletToRepHtml [hamlet| $newline never $doctype 5 <html> <head> <title>#{pageTitle p} ^{pageHead p} <body> $maybe msg <- mmsg <p .message>#{msg} ^{pageBody p} |] instance YesodJquery ESrc where urlJqueryJs _ = Right "http://ajax.googleapis.com/ajax/libs/jquery/1.8.0/jquery.min.js" getReceiveR :: Handler () getReceiveR = do ESrc chan0 <- getYesod chan <- liftIO $ dupChan chan0 req <- waiRequest res <- lift $ eventSourceAppChan chan req sendWaiResponse res getSetupR :: Handler RepHtml getSetupR = do defaultLayout $ do setTitle $ toHtml pageTitleText eventSourceW eventSourceW = do receptacle0 <- lift newIdent -- css id for output div 0 receptacle1 <- lift newIdent -- css id for output div 1 receptacle2 <- lift newIdent -- css id for output div 2 [whamlet| $newline never <div ##{receptacle0} .outdiv>^^Unclassified output up here. <div ##{receptacle1} .outdiv>^^Output 1 up here. <div ##{receptacle2} .outdiv>^^Output 2 up here.|] toWidget [lucius| .outdiv { float:left; width:400px; font-family:courier,'courier new',sans-serif; } |] toWidget [julius| // setup the EventSource itself var source = new EventSource('/recv'); // listener for first type of events source.addEventListener('evstr1', function(event) { $('##{receptacle1}').prepend('EventStream 1: <strong>' + event.data + ' </strong><br>'); }, false); source.addEventListener('evstr2', function(event) { $('##{receptacle2}').prepend('EventStream 2: <strong>' + event.data + ' </strong><br>'); }, false); source.onmessage = function (event) { // a message without a type was fired $('##{receptacle0}').prepend('Event: <strong>' + event.data + ' </strong><br>'); }; |] talk :: Chan ServerEvent -> Int -> IO () talk ch n = do writeChan ch $ ServerEvent Nothing (Just $ fromString $ show n) $ return $ fromText "Hello World! " `mappend` fromString (show n) threadDelay micros writeChan ch $ ServerEvent (Just $ fromText "evstr1") (Just $ fromString $ show n) $ return $ fromText "Hello World 1! " `mappend` fromString (show n) threadDelay micros writeChan ch $ ServerEvent (Just $ fromText "evstr2") (Just $ fromString $ show n) $ return $ fromText "Hello World 2! " `mappend` fromString (show n) threadDelay micros talk ch (n+1) where micros = (1*(10^6)) main = do ch <- newChan forkIO $ talk ch 0 warpDebug 3000 $ ESrc ch |
Some comments about this:
- Line 24:
defaultLayoutis defined. Actually, there is only one tiny difference from Yesod's default one: the inclusion of a call toaddScriptEither. This is done in order to get the version of jQuery that we desire; c.f. line 43. - Line 43: we override Yesod's default Google CDN URL with a slightly more modern one.
- Line 46:
getReceiveRis the handler resposible for sending stuff on the wire to the client. In order to do so, we duplicate the channel boxed inside theESrcfoundation data type, into whichtalkis writing data. For more on this, consult the documentation forControl.Concurrent.ChanandNetwork.Wai.EventSource. - Line 95:
talkuses theServerEventdata constructor directly—yes, it's actually exposed to the world. For the full story on how to use it, see the API doc atNetwork.Wai.EventSource. - Lines 99, 102, 105:
threadDelayis used to pause the forked thread thattalkis running in in order not to flood the listening clients with data. It takes a number of microseconds as argument.
With Yesod version 1.0 or 1.1, this should just work.
