← Back to branch summary

~ubuntu-branches/ubuntu/wily/haskell-wai-extra/wily-proposed

« back to all changes in this revision

Viewing changes to Network/Wai/EventSource/EventStream.hs

  • Committer: Package Import Robot
  • Author(s): Clint Adams
  • Date: 2014-06-06 11:40:45 UTC
  • mfrom: (1.1.13)
  • Revision ID: package-import@ubuntu.com-20140606114045-er7ij5963lk64k70
Tags: 3.0.0-1
New upstream version.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Network/Wai/EventSource/EventStream.hs
 
1
{-# LANGUAGE OverloadedStrings #-}
 
2
{- code adapted by Mathias Billman originaly from Chris Smith https://github.com/cdsmith/gloss-web -}
 
3
 
 
4
{-|
 
5
    Internal module, usually you don't need to use it.
 
6
-}
 
7
module Network.Wai.EventSource.EventStream (
 
8
    ServerEvent(..),
 
9
    eventToBuilder
 
10
    ) where
 
11
 
 
12
import Blaze.ByteString.Builder
 
13
import Blaze.ByteString.Builder.Char8
 
14
import Data.Monoid
 
15
 
 
16
{-|
 
17
    Type representing a communication over an event stream.  This can be an
 
18
    actual event, a comment, a modification to the retry timer, or a special
 
19
    "close" event indicating the server should close the connection.
 
20
-}
 
21
data ServerEvent
 
22
    = ServerEvent {
 
23
        eventName :: Maybe Builder,
 
24
        eventId   :: Maybe Builder,
 
25
        eventData :: [Builder]
 
26
        }
 
27
    | CommentEvent {
 
28
        eventComment :: Builder
 
29
        }
 
30
    | RetryEvent {
 
31
        eventRetry :: Int
 
32
        }
 
33
    | CloseEvent
 
34
 
 
35
 
 
36
{-|
 
37
    Newline as a Builder.
 
38
-}
 
39
nl :: Builder
 
40
nl = fromChar '\n'
 
41
 
 
42
 
 
43
{-|
 
44
    Field names as Builder
 
45
-}
 
46
nameField, idField, dataField, retryField, commentField :: Builder
 
47
nameField = fromString "event:"
 
48
idField = fromString "id:"
 
49
dataField = fromString "data:"
 
50
retryField = fromString "retry:"
 
51
commentField = fromChar ':'
 
52
 
 
53
 
 
54
{-|
 
55
    Wraps the text as a labeled field of an event stream.
 
56
-}
 
57
field :: Builder -> Builder -> Builder
 
58
field l b = l `mappend` b `mappend` nl
 
59
 
 
60
 
 
61
{-|
 
62
    Converts a 'ServerEvent' to its wire representation as specified by the
 
63
    @text/event-stream@ content type.
 
64
-}
 
65
eventToBuilder :: ServerEvent -> Maybe Builder
 
66
eventToBuilder (CommentEvent txt) = Just $ field commentField txt
 
67
eventToBuilder (RetryEvent   n)   = Just $ field retryField (fromShow n)
 
68
eventToBuilder (CloseEvent)       = Nothing
 
69
eventToBuilder (ServerEvent n i d)= Just $
 
70
    (name n $ evid i $ mconcat (map (field dataField) d)) `mappend` nl
 
71
  where
 
72
    name Nothing  = id
 
73
    name (Just n') = mappend (field nameField n')
 
74
    evid Nothing  = id
 
75
    evid (Just i') = mappend (field idField   i')