{-# LANGUAGE CPP #-}

{- code adapted by Mathias Billman originally from Chris Smith https://github.com/cdsmith/gloss-web -}

-- |
--     Internal module, usually you don't need to use it.
module Network.Wai.EventSource.EventStream (
    ServerEvent (..),
    eventToBuilder,
) where

import Data.ByteString.Builder
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
import Data.Word8 (_colon, _lf)

-- |
--     Type representing a communication over an event stream.  This can be an
--     actual event, a comment, a modification to the retry timer, or a special
--     "close" event indicating the server should close the connection.
data ServerEvent
    = ServerEvent
        { ServerEvent -> Maybe Builder
eventName :: Maybe Builder
        , ServerEvent -> Maybe Builder
eventId :: Maybe Builder
        , ServerEvent -> [Builder]
eventData :: [Builder]
        }
    | CommentEvent
        { ServerEvent -> Builder
eventComment :: Builder
        }
    | RetryEvent
        { ServerEvent -> Int
eventRetry :: Int
        }
    | CloseEvent

-- |
--     Newline as a Builder.
nl :: Builder
nl :: Builder
nl = Word8 -> Builder
word8 Word8
_lf

-- |
--     Field names as Builder
nameField, idField, dataField, retryField, commentField :: Builder
nameField :: Builder
nameField = String -> Builder
string7 String
"event:"
idField :: Builder
idField = String -> Builder
string7 String
"id:"
dataField :: Builder
dataField = String -> Builder
string7 String
"data:"
retryField :: Builder
retryField = String -> Builder
string7 String
"retry:"
commentField :: Builder
commentField = Word8 -> Builder
word8 Word8
_colon

-- |
--     Wraps the text as a labeled field of an event stream.
field :: Builder -> Builder -> Builder
field :: Builder -> Builder -> Builder
field Builder
l Builder
b = Builder
l Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
nl

-- |
--     Converts a 'ServerEvent' to its wire representation as specified by the
--     @text/event-stream@ content type.
eventToBuilder :: ServerEvent -> Maybe Builder
eventToBuilder :: ServerEvent -> Maybe Builder
eventToBuilder (CommentEvent Builder
txt) = Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder -> Builder
field Builder
commentField Builder
txt
eventToBuilder (RetryEvent Int
n) = Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder -> Builder
field Builder
retryField (String -> Builder
string8 (String -> Builder) -> (Int -> String) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ Int
n)
eventToBuilder ServerEvent
CloseEvent = Maybe Builder
forall a. Maybe a
Nothing
eventToBuilder (ServerEvent Maybe Builder
n Maybe Builder
i [Builder]
d) =
    Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$
        Maybe Builder -> Builder -> Builder
name Maybe Builder
n (Maybe Builder -> Builder -> Builder
evid Maybe Builder
i (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Builder -> Builder) -> [Builder] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Builder -> Builder
field Builder
dataField) [Builder]
d)) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
nl
  where
    name :: Maybe Builder -> Builder -> Builder
name Maybe Builder
Nothing = Builder -> Builder
forall a. a -> a
id
    name (Just Builder
n') = Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend (Builder -> Builder -> Builder
field Builder
nameField Builder
n')
    evid :: Maybe Builder -> Builder -> Builder
evid Maybe Builder
Nothing = Builder -> Builder
forall a. a -> a
id
    evid (Just Builder
i') = Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend (Builder -> Builder -> Builder
field Builder
idField Builder
i')