{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# OPTIONS_GHC -Wno-error=unused-imports #-}

-- | Server-sent events
--
-- See <https://www.w3.org/TR/2009/WD-eventsource-20090421/> for more details
-- on server-sent events (SSE).
--
module Servant.Client.Core.ServerSentEvents (
    EventMessage (..),
    EventIgnoreReason (..),
    Event (..),
    EventStreamT (..),
    JsonEventStreamT (..),
    EventMessageStreamT (..)
) where

import           Control.Applicative        (Alternative ((<|>)))
import           Control.Monad.IO.Class     (MonadIO)
import qualified Data.Aeson                 as Aeson
import qualified Data.Attoparsec.ByteString as Attoparsec
import qualified Data.ByteString            as ByteString
import qualified Data.ByteString.Char8      as ByteString.Char8
import qualified Data.ByteString.Lazy       as ByteString.Lazy
import           Data.Char                  (chr)
import           Data.Coerce                (coerce)
import           Data.Foldable              (traverse_)
import           Data.Functor               (void)
import qualified Data.Text                  as Text
import           Data.Text.Encoding         (encodeUtf8)
import           GHC.Generics               (Generic)
import           Numeric.Natural            (Natural)
import           Servant.API.ContentTypes   (EventStreamChunk (..))
import           Servant.API.Stream         (FromSourceIO (..))
import           Servant.Types.SourceT
                 (SourceT, StepT (..), foreachYieldStep, mapStepT,
                 transformStepWithAtto)

-- For compatibility with GHC <= 8.2
import           Data.Semigroup             (Semigroup (..))

-- | Line (or frame) of an event stream
newtype EventStreamLine = EventStreamLine
    { EventStreamLine -> ByteString
unEventStreamLine :: ByteString.ByteString }
    deriving Int -> EventStreamLine -> ShowS
[EventStreamLine] -> ShowS
EventStreamLine -> String
(Int -> EventStreamLine -> ShowS)
-> (EventStreamLine -> String)
-> ([EventStreamLine] -> ShowS)
-> Show EventStreamLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventStreamLine -> ShowS
showsPrec :: Int -> EventStreamLine -> ShowS
$cshow :: EventStreamLine -> String
show :: EventStreamLine -> String
$cshowList :: [EventStreamLine] -> ShowS
showList :: [EventStreamLine] -> ShowS
Show

-- | Consume chunks to produce event stream lines.
eventLinesFromRawChunks
    :: Monad m
    => StepT m ByteString.ByteString
    -> StepT m EventStreamLine
eventLinesFromRawChunks :: forall (m :: Type -> Type).
Monad m =>
StepT m ByteString -> StepT m EventStreamLine
eventLinesFromRawChunks =
    Parser EventStreamLine
-> StepT m ByteString -> StepT m EventStreamLine
forall a (m :: Type -> Type).
Monad m =>
Parser a -> StepT m ByteString -> StepT m a
transformStepWithAtto Parser EventStreamLine
eventLine

-- | Consume event stream chunks to produce event stream lines.
eventLinesFromChunks
    :: Monad m
    => StepT m EventStreamChunk
    -> StepT m EventStreamLine
eventLinesFromChunks :: forall (m :: Type -> Type).
Monad m =>
StepT m EventStreamChunk -> StepT m EventStreamLine
eventLinesFromChunks =
    -- 'coerce' efficiently unpacks the 'EventStreamChunk'
    StepT m ByteString -> StepT m EventStreamLine
forall (m :: Type -> Type).
Monad m =>
StepT m ByteString -> StepT m EventStreamLine
eventLinesFromRawChunks (StepT m ByteString -> StepT m EventStreamLine)
-> (StepT m EventStreamChunk -> StepT m ByteString)
-> StepT m EventStreamChunk
-> StepT m EventStreamLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventStreamChunk -> ByteString)
-> StepT m EventStreamChunk -> StepT m ByteString
forall a b. (a -> b) -> StepT m a -> StepT m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LazyByteString -> ByteString) -> EventStreamChunk -> ByteString
forall a b. Coercible a b => a -> b
coerce LazyByteString -> ByteString
ByteString.Lazy.toStrict)

-- | Apply a 'Attoparsec.Parser' to each line of the event stream individually.
parseEventLines
    :: Monad m
    => Attoparsec.Parser a
    -> StepT m EventStreamLine
    -> StepT m a
parseEventLines :: forall (m :: Type -> Type) a.
Monad m =>
Parser a -> StepT m EventStreamLine -> StepT m a
parseEventLines Parser a
parser =
    (EventStreamLine -> StepT m a -> StepT m a)
-> StepT m EventStreamLine -> StepT m a
forall (m :: Type -> Type) a b.
Functor m =>
(a -> StepT m b -> StepT m b) -> StepT m a -> StepT m b
foreachYieldStep ((EventStreamLine -> StepT m a -> StepT m a)
 -> StepT m EventStreamLine -> StepT m a)
-> (EventStreamLine -> StepT m a -> StepT m a)
-> StepT m EventStreamLine
-> StepT m a
forall a b. (a -> b) -> a -> b
$ \(EventStreamLine ByteString
line) StepT m a
next ->
        case Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
Attoparsec.parseOnly Parser a
parser ByteString
line of
            Left String
err    -> String -> StepT m a
forall (m :: Type -> Type) a. String -> StepT m a
Error String
err
            Right a
value -> a -> StepT m a -> StepT m a
forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
Yield a
value StepT m a
next

-- | A line of an event stream
eventLine :: Attoparsec.Parser EventStreamLine
eventLine :: Parser EventStreamLine
eventLine = do
    () -> Parser ByteString () -> Parser ByteString ()
forall (f :: Type -> Type) a. Alternative f => a -> f a -> f a
Attoparsec.option () Parser ByteString ()
byteOrderMark -- A line may be prefixed with a byte order mark
    ByteString -> EventStreamLine
EventStreamLine (ByteString -> EventStreamLine)
-> Parser ByteString ByteString -> Parser EventStreamLine
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
untilLineEnd Parser EventStreamLine
-> Parser ByteString () -> Parser EventStreamLine
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
lineEnd

-- | Byte order mark (U+FEFF) in UTF-8 representation
byteOrderMark :: Attoparsec.Parser ()
byteOrderMark :: Parser ByteString ()
byteOrderMark =
    (Word8 -> Parser ByteString Word8)
-> [Word8] -> Parser ByteString ()
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Word8 -> Parser ByteString Word8
Attoparsec.word8
    ([Word8] -> Parser ByteString ())
-> [Word8] -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
ByteString.unpack
    (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8
    (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Char -> Text
Text.singleton
    (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
0xFEFF

-- | Event stream line ending
lineEnd :: Attoparsec.Parser ()
lineEnd :: Parser ByteString ()
lineEnd =
    (Parser ByteString ()
cr Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Parser ByteString ()
lf) Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
cr Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
lf Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
forall t. Chunk t => Parser t ()
Attoparsec.endOfInput
    where
        cr :: Parser ByteString ()
cr = Parser ByteString Word8 -> Parser ByteString ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Word8 -> Parser ByteString Word8
Attoparsec.word8 Word8
0x0D)
        lf :: Parser ByteString ()
lf = Parser ByteString Word8 -> Parser ByteString ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Word8 -> Parser ByteString Word8
Attoparsec.word8 Word8
0x0A)

-- | Consume all contents until the end of the line.
untilLineEnd :: Attoparsec.Parser ByteString.ByteString
untilLineEnd :: Parser ByteString ByteString
untilLineEnd = (Word8 -> Bool) -> Parser ByteString ByteString
Attoparsec.takeWhile (\Word8
w8 -> Word8
w8 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x0D Bool -> Bool -> Bool
&& Word8
w8 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x0A)

-- | Structured variant of an event line of an event stream
data EventMessage
    = EventDispatch
        -- ^ Dispatch on the accumulated event.
    | EventSetName ByteString.ByteString
        -- ^ Set the name of the current event.
    | EventSetLastId ByteString.ByteString
        -- ^ Set the last event identifier.
    | EventData ByteString.ByteString
        -- ^ Append data to the event's data buffer.
    | EventRetry Natural
        -- ^ Set the event stream's reconnection time.
    | EventIgnore EventIgnoreReason
        -- ^ Ignored
    deriving (Int -> EventMessage -> ShowS
[EventMessage] -> ShowS
EventMessage -> String
(Int -> EventMessage -> ShowS)
-> (EventMessage -> String)
-> ([EventMessage] -> ShowS)
-> Show EventMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventMessage -> ShowS
showsPrec :: Int -> EventMessage -> ShowS
$cshow :: EventMessage -> String
show :: EventMessage -> String
$cshowList :: [EventMessage] -> ShowS
showList :: [EventMessage] -> ShowS
Show, EventMessage -> EventMessage -> Bool
(EventMessage -> EventMessage -> Bool)
-> (EventMessage -> EventMessage -> Bool) -> Eq EventMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventMessage -> EventMessage -> Bool
== :: EventMessage -> EventMessage -> Bool
$c/= :: EventMessage -> EventMessage -> Bool
/= :: EventMessage -> EventMessage -> Bool
Eq, Eq EventMessage
Eq EventMessage =>
(EventMessage -> EventMessage -> Ordering)
-> (EventMessage -> EventMessage -> Bool)
-> (EventMessage -> EventMessage -> Bool)
-> (EventMessage -> EventMessage -> Bool)
-> (EventMessage -> EventMessage -> Bool)
-> (EventMessage -> EventMessage -> EventMessage)
-> (EventMessage -> EventMessage -> EventMessage)
-> Ord EventMessage
EventMessage -> EventMessage -> Bool
EventMessage -> EventMessage -> Ordering
EventMessage -> EventMessage -> EventMessage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EventMessage -> EventMessage -> Ordering
compare :: EventMessage -> EventMessage -> Ordering
$c< :: EventMessage -> EventMessage -> Bool
< :: EventMessage -> EventMessage -> Bool
$c<= :: EventMessage -> EventMessage -> Bool
<= :: EventMessage -> EventMessage -> Bool
$c> :: EventMessage -> EventMessage -> Bool
> :: EventMessage -> EventMessage -> Bool
$c>= :: EventMessage -> EventMessage -> Bool
>= :: EventMessage -> EventMessage -> Bool
$cmax :: EventMessage -> EventMessage -> EventMessage
max :: EventMessage -> EventMessage -> EventMessage
$cmin :: EventMessage -> EventMessage -> EventMessage
min :: EventMessage -> EventMessage -> EventMessage
Ord)

-- | Reason why a event line can be ignored
data EventIgnoreReason
    = EventFieldNameUnknown ByteString.ByteString
    | EventRetryNonNumeric ByteString.ByteString
    | EventComment ByteString.ByteString
    deriving (Int -> EventIgnoreReason -> ShowS
[EventIgnoreReason] -> ShowS
EventIgnoreReason -> String
(Int -> EventIgnoreReason -> ShowS)
-> (EventIgnoreReason -> String)
-> ([EventIgnoreReason] -> ShowS)
-> Show EventIgnoreReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventIgnoreReason -> ShowS
showsPrec :: Int -> EventIgnoreReason -> ShowS
$cshow :: EventIgnoreReason -> String
show :: EventIgnoreReason -> String
$cshowList :: [EventIgnoreReason] -> ShowS
showList :: [EventIgnoreReason] -> ShowS
Show, EventIgnoreReason -> EventIgnoreReason -> Bool
(EventIgnoreReason -> EventIgnoreReason -> Bool)
-> (EventIgnoreReason -> EventIgnoreReason -> Bool)
-> Eq EventIgnoreReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventIgnoreReason -> EventIgnoreReason -> Bool
== :: EventIgnoreReason -> EventIgnoreReason -> Bool
$c/= :: EventIgnoreReason -> EventIgnoreReason -> Bool
/= :: EventIgnoreReason -> EventIgnoreReason -> Bool
Eq, Eq EventIgnoreReason
Eq EventIgnoreReason =>
(EventIgnoreReason -> EventIgnoreReason -> Ordering)
-> (EventIgnoreReason -> EventIgnoreReason -> Bool)
-> (EventIgnoreReason -> EventIgnoreReason -> Bool)
-> (EventIgnoreReason -> EventIgnoreReason -> Bool)
-> (EventIgnoreReason -> EventIgnoreReason -> Bool)
-> (EventIgnoreReason -> EventIgnoreReason -> EventIgnoreReason)
-> (EventIgnoreReason -> EventIgnoreReason -> EventIgnoreReason)
-> Ord EventIgnoreReason
EventIgnoreReason -> EventIgnoreReason -> Bool
EventIgnoreReason -> EventIgnoreReason -> Ordering
EventIgnoreReason -> EventIgnoreReason -> EventIgnoreReason
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EventIgnoreReason -> EventIgnoreReason -> Ordering
compare :: EventIgnoreReason -> EventIgnoreReason -> Ordering
$c< :: EventIgnoreReason -> EventIgnoreReason -> Bool
< :: EventIgnoreReason -> EventIgnoreReason -> Bool
$c<= :: EventIgnoreReason -> EventIgnoreReason -> Bool
<= :: EventIgnoreReason -> EventIgnoreReason -> Bool
$c> :: EventIgnoreReason -> EventIgnoreReason -> Bool
> :: EventIgnoreReason -> EventIgnoreReason -> Bool
$c>= :: EventIgnoreReason -> EventIgnoreReason -> Bool
>= :: EventIgnoreReason -> EventIgnoreReason -> Bool
$cmax :: EventIgnoreReason -> EventIgnoreReason -> EventIgnoreReason
max :: EventIgnoreReason -> EventIgnoreReason -> EventIgnoreReason
$cmin :: EventIgnoreReason -> EventIgnoreReason -> EventIgnoreReason
min :: EventIgnoreReason -> EventIgnoreReason -> EventIgnoreReason
Ord)

-- | Parse the event stream lines into more structured messages.
eventMessagesFromLines
    :: Monad m
    => StepT m EventStreamLine
    -> StepT m EventMessage
eventMessagesFromLines :: forall (m :: Type -> Type).
Monad m =>
StepT m EventStreamLine -> StepT m EventMessage
eventMessagesFromLines =
    Bool -> StepT m EventMessage -> StepT m EventMessage
forall {m :: Type -> Type}.
Functor m =>
Bool -> StepT m EventMessage -> StepT m EventMessage
ensureLastDispatch Bool
False (StepT m EventMessage -> StepT m EventMessage)
-> (StepT m EventStreamLine -> StepT m EventMessage)
-> StepT m EventStreamLine
-> StepT m EventMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser EventMessage
-> StepT m EventStreamLine -> StepT m EventMessage
forall (m :: Type -> Type) a.
Monad m =>
Parser a -> StepT m EventStreamLine -> StepT m a
parseEventLines Parser EventMessage
eventMessage
    where
        -- | Make sure the last event message is a dispatch.
        ensureLastDispatch :: Bool -> StepT m EventMessage -> StepT m EventMessage
ensureLastDispatch Bool
didDispatch StepT m EventMessage
step = case StepT m EventMessage
step of
            StepT m EventMessage
Stop ->
                if Bool -> Bool
not Bool
didDispatch then EventMessage -> StepT m EventMessage -> StepT m EventMessage
forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
Yield EventMessage
EventDispatch StepT m EventMessage
forall (m :: Type -> Type) a. StepT m a
Stop else StepT m EventMessage
forall (m :: Type -> Type) a. StepT m a
Stop
            Yield EventMessage
other StepT m EventMessage
next ->
                EventMessage -> StepT m EventMessage -> StepT m EventMessage
forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
Yield EventMessage
other (StepT m EventMessage -> StepT m EventMessage)
-> StepT m EventMessage -> StepT m EventMessage
forall a b. (a -> b) -> a -> b
$ Bool -> StepT m EventMessage -> StepT m EventMessage
ensureLastDispatch (EventMessage
other EventMessage -> EventMessage -> Bool
forall a. Eq a => a -> a -> Bool
== EventMessage
EventDispatch) StepT m EventMessage
next
            Skip StepT m EventMessage
next ->
                StepT m EventMessage -> StepT m EventMessage
forall (m :: Type -> Type) a. StepT m a -> StepT m a
Skip (StepT m EventMessage -> StepT m EventMessage)
-> StepT m EventMessage -> StepT m EventMessage
forall a b. (a -> b) -> a -> b
$ Bool -> StepT m EventMessage -> StepT m EventMessage
ensureLastDispatch Bool
didDispatch StepT m EventMessage
next
            Effect m (StepT m EventMessage)
eff ->
                m (StepT m EventMessage) -> StepT m EventMessage
forall (m :: Type -> Type) a. m (StepT m a) -> StepT m a
Effect (m (StepT m EventMessage) -> StepT m EventMessage)
-> m (StepT m EventMessage) -> StepT m EventMessage
forall a b. (a -> b) -> a -> b
$ Bool -> StepT m EventMessage -> StepT m EventMessage
ensureLastDispatch Bool
didDispatch (StepT m EventMessage -> StepT m EventMessage)
-> m (StepT m EventMessage) -> m (StepT m EventMessage)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m (StepT m EventMessage)
eff
            err :: StepT m EventMessage
err@Error{} ->
                 StepT m EventMessage
err

-- | Event line parser for an event message.
eventMessage :: Attoparsec.Parser EventMessage
eventMessage :: Parser EventMessage
eventMessage =
    Parser EventMessage
ignore Parser EventMessage -> Parser EventMessage -> Parser EventMessage
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Parser EventMessage
field Parser EventMessage -> Parser EventMessage -> Parser EventMessage
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Parser EventMessage
dispatch
    where
        ignore :: Parser EventMessage
ignore = do
            _ <- Word8 -> Parser ByteString Word8
Attoparsec.word8 Word8
0x3A -- ':'
            EventIgnore . EventComment <$> Attoparsec.takeByteString

        dispatch :: Parser EventMessage
dispatch = do
            Parser ByteString ()
forall t. Chunk t => Parser t ()
Attoparsec.endOfInput
            EventMessage -> Parser EventMessage
forall a. a -> Parser ByteString a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure EventMessage
EventDispatch

        field :: Parser EventMessage
field = do
            name <- (Word8 -> Bool) -> Parser ByteString ByteString
Attoparsec.takeWhile1 (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x3A) -- Up to ':' or the end

            value <- Attoparsec.option ByteString.empty $ do
                _ <- Attoparsec.word8 0x3A -- ':'
                _ <- Attoparsec.option 0x20 $ Attoparsec.word8 0x20 -- Optional ' '
                Attoparsec.takeByteString

            pure $ case name of
                ByteString
"event" -> ByteString -> EventMessage
EventSetName ByteString
value

                ByteString
"data" -> ByteString -> EventMessage
EventData ByteString
value

                ByteString
"id" -> ByteString -> EventMessage
EventSetLastId ByteString
value

                ByteString
"retry" ->
                    -- The retry value consist of digits.
                    if (Word8 -> Bool) -> ByteString -> Bool
ByteString.all (\Word8
w8 -> Word8
0x30 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w8 Bool -> Bool -> Bool
&& Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x39) ByteString
value then
                        Natural -> EventMessage
EventRetry (String -> Natural
forall a. Read a => String -> a
read (ByteString -> String
ByteString.Char8.unpack ByteString
value))
                    else
                        EventIgnoreReason -> EventMessage
EventIgnore (ByteString -> EventIgnoreReason
EventRetryNonNumeric ByteString
value)

                ByteString
_ -> EventIgnoreReason -> EventMessage
EventIgnore (ByteString -> EventIgnoreReason
EventFieldNameUnknown ByteString
name)

-- | Event sent by the remote
data Event a = Event
    { forall a. Event a -> Maybe ByteString
eventName :: Maybe ByteString.ByteString
    , forall a. Event a -> a
eventData :: a
    }
    deriving (Int -> Event a -> ShowS
[Event a] -> ShowS
Event a -> String
(Int -> Event a -> ShowS)
-> (Event a -> String) -> ([Event a] -> ShowS) -> Show (Event a)
forall a. Show a => Int -> Event a -> ShowS
forall a. Show a => [Event a] -> ShowS
forall a. Show a => Event a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Event a -> ShowS
showsPrec :: Int -> Event a -> ShowS
$cshow :: forall a. Show a => Event a -> String
show :: Event a -> String
$cshowList :: forall a. Show a => [Event a] -> ShowS
showList :: [Event a] -> ShowS
Show, Event a -> Event a -> Bool
(Event a -> Event a -> Bool)
-> (Event a -> Event a -> Bool) -> Eq (Event a)
forall a. Eq a => Event a -> Event a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Event a -> Event a -> Bool
== :: Event a -> Event a -> Bool
$c/= :: forall a. Eq a => Event a -> Event a -> Bool
/= :: Event a -> Event a -> Bool
Eq, Eq (Event a)
Eq (Event a) =>
(Event a -> Event a -> Ordering)
-> (Event a -> Event a -> Bool)
-> (Event a -> Event a -> Bool)
-> (Event a -> Event a -> Bool)
-> (Event a -> Event a -> Bool)
-> (Event a -> Event a -> Event a)
-> (Event a -> Event a -> Event a)
-> Ord (Event a)
Event a -> Event a -> Bool
Event a -> Event a -> Ordering
Event a -> Event a -> Event a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Event a)
forall a. Ord a => Event a -> Event a -> Bool
forall a. Ord a => Event a -> Event a -> Ordering
forall a. Ord a => Event a -> Event a -> Event a
$ccompare :: forall a. Ord a => Event a -> Event a -> Ordering
compare :: Event a -> Event a -> Ordering
$c< :: forall a. Ord a => Event a -> Event a -> Bool
< :: Event a -> Event a -> Bool
$c<= :: forall a. Ord a => Event a -> Event a -> Bool
<= :: Event a -> Event a -> Bool
$c> :: forall a. Ord a => Event a -> Event a -> Bool
> :: Event a -> Event a -> Bool
$c>= :: forall a. Ord a => Event a -> Event a -> Bool
>= :: Event a -> Event a -> Bool
$cmax :: forall a. Ord a => Event a -> Event a -> Event a
max :: Event a -> Event a -> Event a
$cmin :: forall a. Ord a => Event a -> Event a -> Event a
min :: Event a -> Event a -> Event a
Ord, (forall a b. (a -> b) -> Event a -> Event b)
-> (forall a b. a -> Event b -> Event a) -> Functor Event
forall a b. a -> Event b -> Event a
forall a b. (a -> b) -> Event a -> Event b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Event a -> Event b
fmap :: forall a b. (a -> b) -> Event a -> Event b
$c<$ :: forall a b. a -> Event b -> Event a
<$ :: forall a b. a -> Event b -> Event a
Functor, (forall x. Event a -> Rep (Event a) x)
-> (forall x. Rep (Event a) x -> Event a) -> Generic (Event a)
forall x. Rep (Event a) x -> Event a
forall x. Event a -> Rep (Event a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Event a) x -> Event a
forall a x. Event a -> Rep (Event a) x
$cfrom :: forall a x. Event a -> Rep (Event a) x
from :: forall x. Event a -> Rep (Event a) x
$cto :: forall a x. Rep (Event a) x -> Event a
to :: forall x. Rep (Event a) x -> Event a
Generic)

-- | Accumulate event messages to build individual 'Event's.
eventsFromMessages
    :: Functor m
    => StepT m EventMessage
    -> StepT m (Event ByteString.ByteString)
eventsFromMessages :: forall (m :: Type -> Type).
Functor m =>
StepT m EventMessage -> StepT m (Event ByteString)
eventsFromMessages =
    StepT m EventMessage -> StepT m (Event ByteString)
initGo
    where
        initGo :: StepT m EventMessage -> StepT m (Event ByteString)
initGo = Maybe ByteString
-> LazyByteString
-> StepT m EventMessage
-> StepT m (Event ByteString)
go Maybe ByteString
forall a. Maybe a
Nothing LazyByteString
ByteString.Lazy.empty

        combineData :: LazyByteString -> ByteString -> LazyByteString
combineData LazyByteString
dataBuffer ByteString
newData =
            if LazyByteString -> Bool
ByteString.Lazy.null LazyByteString
dataBuffer then
                ByteString -> LazyByteString
ByteString.Lazy.fromStrict ByteString
newData
            else
                [LazyByteString] -> LazyByteString
ByteString.Lazy.concat
                    [ LazyByteString
dataBuffer
                    , Word8 -> LazyByteString
ByteString.Lazy.singleton Word8
0x0A -- Line feed
                    , ByteString -> LazyByteString
ByteString.Lazy.fromStrict ByteString
newData
                    ]

        go :: Maybe ByteString
-> LazyByteString
-> StepT m EventMessage
-> StepT m (Event ByteString)
go Maybe ByteString
name LazyByteString
dataBuffer StepT m EventMessage
step = case StepT m EventMessage
step of
            StepT m EventMessage
Stop ->
                StepT m (Event ByteString)
forall (m :: Type -> Type) a. StepT m a
Stop
            Skip StepT m EventMessage
next ->
                Maybe ByteString
-> LazyByteString
-> StepT m EventMessage
-> StepT m (Event ByteString)
go Maybe ByteString
name LazyByteString
dataBuffer StepT m EventMessage
next
            Effect m (StepT m EventMessage)
eff ->
                m (StepT m (Event ByteString)) -> StepT m (Event ByteString)
forall (m :: Type -> Type) a. m (StepT m a) -> StepT m a
Effect (Maybe ByteString
-> LazyByteString
-> StepT m EventMessage
-> StepT m (Event ByteString)
go Maybe ByteString
name LazyByteString
dataBuffer (StepT m EventMessage -> StepT m (Event ByteString))
-> m (StepT m EventMessage) -> m (StepT m (Event ByteString))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m (StepT m EventMessage)
eff)
            Error String
err ->
                String -> StepT m (Event ByteString)
forall (m :: Type -> Type) a. String -> StepT m a
Error String
err
            Yield EventMessage
message StepT m EventMessage
next -> case EventMessage
message of
                EventSetName ByteString
newName ->
                    Maybe ByteString
-> LazyByteString
-> StepT m EventMessage
-> StepT m (Event ByteString)
go (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
newName) LazyByteString
dataBuffer StepT m EventMessage
next
                EventData ByteString
newData ->
                    Maybe ByteString
-> LazyByteString
-> StepT m EventMessage
-> StepT m (Event ByteString)
go Maybe ByteString
name (LazyByteString -> ByteString -> LazyByteString
combineData LazyByteString
dataBuffer ByteString
newData) StepT m EventMessage
next
                EventMessage
EventDispatch ->
                    Event ByteString
-> StepT m (Event ByteString) -> StepT m (Event ByteString)
forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
Yield
                        (Maybe ByteString -> ByteString -> Event ByteString
forall a. Maybe ByteString -> a -> Event a
Event Maybe ByteString
name (LazyByteString -> ByteString
ByteString.Lazy.toStrict LazyByteString
dataBuffer))
                        (StepT m EventMessage -> StepT m (Event ByteString)
initGo StepT m EventMessage
next)
                EventMessage
_ ->
                    -- We ignore other message because they don't fit into
                    -- the 'Event' type. If a user needs more fine grained
                    -- control, the 'EventMessage' interface is better suited.
                    Maybe ByteString
-> LazyByteString
-> StepT m EventMessage
-> StepT m (Event ByteString)
go Maybe ByteString
name LazyByteString
dataBuffer StepT m EventMessage
next

-- | Server-sent event stream (SSE)
--
-- See <https://www.w3.org/TR/2009/WD-eventsource-20090421/> for more details.
--
newtype EventMessageStreamT m = EventMessageStreamT
    { forall (m :: Type -> Type).
EventMessageStreamT m -> SourceT m EventMessage
unEventMessageStreamT :: SourceT m EventMessage }
    deriving stock (Int -> EventMessageStreamT m -> ShowS
[EventMessageStreamT m] -> ShowS
EventMessageStreamT m -> String
(Int -> EventMessageStreamT m -> ShowS)
-> (EventMessageStreamT m -> String)
-> ([EventMessageStreamT m] -> ShowS)
-> Show (EventMessageStreamT m)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: Type -> Type).
(Applicative m, Show1 m) =>
Int -> EventMessageStreamT m -> ShowS
forall (m :: Type -> Type).
(Applicative m, Show1 m) =>
[EventMessageStreamT m] -> ShowS
forall (m :: Type -> Type).
(Applicative m, Show1 m) =>
EventMessageStreamT m -> String
$cshowsPrec :: forall (m :: Type -> Type).
(Applicative m, Show1 m) =>
Int -> EventMessageStreamT m -> ShowS
showsPrec :: Int -> EventMessageStreamT m -> ShowS
$cshow :: forall (m :: Type -> Type).
(Applicative m, Show1 m) =>
EventMessageStreamT m -> String
show :: EventMessageStreamT m -> String
$cshowList :: forall (m :: Type -> Type).
(Applicative m, Show1 m) =>
[EventMessageStreamT m] -> ShowS
showList :: [EventMessageStreamT m] -> ShowS
Show)
    deriving newtype (NonEmpty (EventMessageStreamT m) -> EventMessageStreamT m
EventMessageStreamT m
-> EventMessageStreamT m -> EventMessageStreamT m
(EventMessageStreamT m
 -> EventMessageStreamT m -> EventMessageStreamT m)
-> (NonEmpty (EventMessageStreamT m) -> EventMessageStreamT m)
-> (forall b.
    Integral b =>
    b -> EventMessageStreamT m -> EventMessageStreamT m)
-> Semigroup (EventMessageStreamT m)
forall b.
Integral b =>
b -> EventMessageStreamT m -> EventMessageStreamT m
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (m :: Type -> Type).
Functor m =>
NonEmpty (EventMessageStreamT m) -> EventMessageStreamT m
forall (m :: Type -> Type).
Functor m =>
EventMessageStreamT m
-> EventMessageStreamT m -> EventMessageStreamT m
forall (m :: Type -> Type) b.
(Functor m, Integral b) =>
b -> EventMessageStreamT m -> EventMessageStreamT m
$c<> :: forall (m :: Type -> Type).
Functor m =>
EventMessageStreamT m
-> EventMessageStreamT m -> EventMessageStreamT m
<> :: EventMessageStreamT m
-> EventMessageStreamT m -> EventMessageStreamT m
$csconcat :: forall (m :: Type -> Type).
Functor m =>
NonEmpty (EventMessageStreamT m) -> EventMessageStreamT m
sconcat :: NonEmpty (EventMessageStreamT m) -> EventMessageStreamT m
$cstimes :: forall (m :: Type -> Type) b.
(Functor m, Integral b) =>
b -> EventMessageStreamT m -> EventMessageStreamT m
stimes :: forall b.
Integral b =>
b -> EventMessageStreamT m -> EventMessageStreamT m
Semigroup, Semigroup (EventMessageStreamT m)
EventMessageStreamT m
Semigroup (EventMessageStreamT m) =>
EventMessageStreamT m
-> (EventMessageStreamT m
    -> EventMessageStreamT m -> EventMessageStreamT m)
-> ([EventMessageStreamT m] -> EventMessageStreamT m)
-> Monoid (EventMessageStreamT m)
[EventMessageStreamT m] -> EventMessageStreamT m
EventMessageStreamT m
-> EventMessageStreamT m -> EventMessageStreamT m
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (m :: Type -> Type).
Functor m =>
Semigroup (EventMessageStreamT m)
forall (m :: Type -> Type). Functor m => EventMessageStreamT m
forall (m :: Type -> Type).
Functor m =>
[EventMessageStreamT m] -> EventMessageStreamT m
forall (m :: Type -> Type).
Functor m =>
EventMessageStreamT m
-> EventMessageStreamT m -> EventMessageStreamT m
$cmempty :: forall (m :: Type -> Type). Functor m => EventMessageStreamT m
mempty :: EventMessageStreamT m
$cmappend :: forall (m :: Type -> Type).
Functor m =>
EventMessageStreamT m
-> EventMessageStreamT m -> EventMessageStreamT m
mappend :: EventMessageStreamT m
-> EventMessageStreamT m -> EventMessageStreamT m
$cmconcat :: forall (m :: Type -> Type).
Functor m =>
[EventMessageStreamT m] -> EventMessageStreamT m
mconcat :: [EventMessageStreamT m] -> EventMessageStreamT m
Monoid)

-- | Server-sent event messages
--
-- 'EventMessage' gives you more control over the communication with the server
-- than 'Event'.
--
instance MonadIO m => FromSourceIO EventStreamChunk (EventMessageStreamT m) where
    fromSourceIO :: SourceIO EventStreamChunk -> IO (EventMessageStreamT m)
fromSourceIO SourceIO EventStreamChunk
src =
        SourceT m EventMessage -> EventMessageStreamT m
forall (m :: Type -> Type).
SourceT m EventMessage -> EventMessageStreamT m
EventMessageStreamT
        (SourceT m EventMessage -> EventMessageStreamT m)
-> (SourceT m EventStreamChunk -> SourceT m EventMessage)
-> SourceT m EventStreamChunk
-> EventMessageStreamT m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StepT m EventStreamChunk -> StepT m EventMessage)
-> SourceT m EventStreamChunk -> SourceT m EventMessage
forall (m :: Type -> Type) a b.
(StepT m a -> StepT m b) -> SourceT m a -> SourceT m b
mapStepT (StepT m EventStreamLine -> StepT m EventMessage
forall (m :: Type -> Type).
Monad m =>
StepT m EventStreamLine -> StepT m EventMessage
eventMessagesFromLines (StepT m EventStreamLine -> StepT m EventMessage)
-> (StepT m EventStreamChunk -> StepT m EventStreamLine)
-> StepT m EventStreamChunk
-> StepT m EventMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StepT m EventStreamChunk -> StepT m EventStreamLine
forall (m :: Type -> Type).
Monad m =>
StepT m EventStreamChunk -> StepT m EventStreamLine
eventLinesFromChunks)
        (SourceT m EventStreamChunk -> EventMessageStreamT m)
-> IO (SourceT m EventStreamChunk) -> IO (EventMessageStreamT m)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceIO EventStreamChunk -> IO (SourceT m EventStreamChunk)
forall chunk a. FromSourceIO chunk a => SourceIO chunk -> IO a
fromSourceIO SourceIO EventStreamChunk
src

-- | Server-sent event stream (SSE)
--
-- See <https://www.w3.org/TR/2009/WD-eventsource-20090421/> for more details.
--
newtype EventStreamT m = EventStreamT
    { forall (m :: Type -> Type).
EventStreamT m -> SourceT m (Event ByteString)
unEventStreamT :: SourceT m (Event ByteString.ByteString) }
    deriving stock (Int -> EventStreamT m -> ShowS
[EventStreamT m] -> ShowS
EventStreamT m -> String
(Int -> EventStreamT m -> ShowS)
-> (EventStreamT m -> String)
-> ([EventStreamT m] -> ShowS)
-> Show (EventStreamT m)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: Type -> Type).
(Applicative m, Show1 m) =>
Int -> EventStreamT m -> ShowS
forall (m :: Type -> Type).
(Applicative m, Show1 m) =>
[EventStreamT m] -> ShowS
forall (m :: Type -> Type).
(Applicative m, Show1 m) =>
EventStreamT m -> String
$cshowsPrec :: forall (m :: Type -> Type).
(Applicative m, Show1 m) =>
Int -> EventStreamT m -> ShowS
showsPrec :: Int -> EventStreamT m -> ShowS
$cshow :: forall (m :: Type -> Type).
(Applicative m, Show1 m) =>
EventStreamT m -> String
show :: EventStreamT m -> String
$cshowList :: forall (m :: Type -> Type).
(Applicative m, Show1 m) =>
[EventStreamT m] -> ShowS
showList :: [EventStreamT m] -> ShowS
Show)
    deriving newtype (NonEmpty (EventStreamT m) -> EventStreamT m
EventStreamT m -> EventStreamT m -> EventStreamT m
(EventStreamT m -> EventStreamT m -> EventStreamT m)
-> (NonEmpty (EventStreamT m) -> EventStreamT m)
-> (forall b. Integral b => b -> EventStreamT m -> EventStreamT m)
-> Semigroup (EventStreamT m)
forall b. Integral b => b -> EventStreamT m -> EventStreamT m
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (m :: Type -> Type).
Functor m =>
NonEmpty (EventStreamT m) -> EventStreamT m
forall (m :: Type -> Type).
Functor m =>
EventStreamT m -> EventStreamT m -> EventStreamT m
forall (m :: Type -> Type) b.
(Functor m, Integral b) =>
b -> EventStreamT m -> EventStreamT m
$c<> :: forall (m :: Type -> Type).
Functor m =>
EventStreamT m -> EventStreamT m -> EventStreamT m
<> :: EventStreamT m -> EventStreamT m -> EventStreamT m
$csconcat :: forall (m :: Type -> Type).
Functor m =>
NonEmpty (EventStreamT m) -> EventStreamT m
sconcat :: NonEmpty (EventStreamT m) -> EventStreamT m
$cstimes :: forall (m :: Type -> Type) b.
(Functor m, Integral b) =>
b -> EventStreamT m -> EventStreamT m
stimes :: forall b. Integral b => b -> EventStreamT m -> EventStreamT m
Semigroup, Semigroup (EventStreamT m)
EventStreamT m
Semigroup (EventStreamT m) =>
EventStreamT m
-> (EventStreamT m -> EventStreamT m -> EventStreamT m)
-> ([EventStreamT m] -> EventStreamT m)
-> Monoid (EventStreamT m)
[EventStreamT m] -> EventStreamT m
EventStreamT m -> EventStreamT m -> EventStreamT m
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (m :: Type -> Type). Functor m => Semigroup (EventStreamT m)
forall (m :: Type -> Type). Functor m => EventStreamT m
forall (m :: Type -> Type).
Functor m =>
[EventStreamT m] -> EventStreamT m
forall (m :: Type -> Type).
Functor m =>
EventStreamT m -> EventStreamT m -> EventStreamT m
$cmempty :: forall (m :: Type -> Type). Functor m => EventStreamT m
mempty :: EventStreamT m
$cmappend :: forall (m :: Type -> Type).
Functor m =>
EventStreamT m -> EventStreamT m -> EventStreamT m
mappend :: EventStreamT m -> EventStreamT m -> EventStreamT m
$cmconcat :: forall (m :: Type -> Type).
Functor m =>
[EventStreamT m] -> EventStreamT m
mconcat :: [EventStreamT m] -> EventStreamT m
Monoid)

-- | Server-sent events
instance MonadIO m => FromSourceIO EventStreamChunk (EventStreamT m) where
    fromSourceIO :: SourceIO EventStreamChunk -> IO (EventStreamT m)
fromSourceIO SourceIO EventStreamChunk
input = do
        src :: EventMessageStreamT m <- SourceIO EventStreamChunk -> IO (EventMessageStreamT m)
forall chunk a. FromSourceIO chunk a => SourceIO chunk -> IO a
fromSourceIO SourceIO EventStreamChunk
input
        pure $
            -- 'coerce' is used in place of unpacking and repacking 'EventStreamT'
            coerce (mapStepT eventsFromMessages) src

-- | Try to parse event data to JSON.
jsonEventsFromEvents
    :: (Functor m, Aeson.FromJSON a)
    => StepT m (Event ByteString.ByteString)
    -> StepT m (Event a)
jsonEventsFromEvents :: forall (m :: Type -> Type) a.
(Functor m, FromJSON a) =>
StepT m (Event ByteString) -> StepT m (Event a)
jsonEventsFromEvents =
    (Event ByteString -> StepT m (Event a) -> StepT m (Event a))
-> StepT m (Event ByteString) -> StepT m (Event a)
forall (m :: Type -> Type) a b.
Functor m =>
(a -> StepT m b -> StepT m b) -> StepT m a -> StepT m b
foreachYieldStep ((Event ByteString -> StepT m (Event a) -> StepT m (Event a))
 -> StepT m (Event ByteString) -> StepT m (Event a))
-> (Event ByteString -> StepT m (Event a) -> StepT m (Event a))
-> StepT m (Event ByteString)
-> StepT m (Event a)
forall a b. (a -> b) -> a -> b
$ \(Event Maybe ByteString
name ByteString
datas) StepT m (Event a)
next ->
        (String -> StepT m (Event a))
-> (a -> StepT m (Event a)) -> Either String a -> StepT m (Event a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            String -> StepT m (Event a)
forall (m :: Type -> Type) a. String -> StepT m a
Error
            (\a
value -> Event a -> StepT m (Event a) -> StepT m (Event a)
forall (m :: Type -> Type) a. a -> StepT m a -> StepT m a
Yield (Maybe ByteString -> a -> Event a
forall a. Maybe ByteString -> a -> Event a
Event Maybe ByteString
name a
value) StepT m (Event a)
next)
            (LazyByteString -> Either String a
forall a. FromJSON a => LazyByteString -> Either String a
Aeson.eitherDecode (ByteString -> LazyByteString
ByteString.Lazy.fromStrict ByteString
datas))

-- | Server-sent event stream (SSE) for JSON values
newtype JsonEventStreamT m a = JsonEventStreamT
    { forall (m :: Type -> Type) a.
JsonEventStreamT m a -> SourceT m (Event a)
unJsonEventStreamT :: SourceT m (Event a) }
    deriving stock (Int -> JsonEventStreamT m a -> ShowS
[JsonEventStreamT m a] -> ShowS
JsonEventStreamT m a -> String
(Int -> JsonEventStreamT m a -> ShowS)
-> (JsonEventStreamT m a -> String)
-> ([JsonEventStreamT m a] -> ShowS)
-> Show (JsonEventStreamT m a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: Type -> Type) a.
(Applicative m, Show1 m, Show a) =>
Int -> JsonEventStreamT m a -> ShowS
forall (m :: Type -> Type) a.
(Applicative m, Show1 m, Show a) =>
[JsonEventStreamT m a] -> ShowS
forall (m :: Type -> Type) a.
(Applicative m, Show1 m, Show a) =>
JsonEventStreamT m a -> String
$cshowsPrec :: forall (m :: Type -> Type) a.
(Applicative m, Show1 m, Show a) =>
Int -> JsonEventStreamT m a -> ShowS
showsPrec :: Int -> JsonEventStreamT m a -> ShowS
$cshow :: forall (m :: Type -> Type) a.
(Applicative m, Show1 m, Show a) =>
JsonEventStreamT m a -> String
show :: JsonEventStreamT m a -> String
$cshowList :: forall (m :: Type -> Type) a.
(Applicative m, Show1 m, Show a) =>
[JsonEventStreamT m a] -> ShowS
showList :: [JsonEventStreamT m a] -> ShowS
Show, (forall a b.
 (a -> b) -> JsonEventStreamT m a -> JsonEventStreamT m b)
-> (forall a b. a -> JsonEventStreamT m b -> JsonEventStreamT m a)
-> Functor (JsonEventStreamT m)
forall a b. a -> JsonEventStreamT m b -> JsonEventStreamT m a
forall a b.
(a -> b) -> JsonEventStreamT m a -> JsonEventStreamT m b
forall (m :: Type -> Type) a b.
Functor m =>
a -> JsonEventStreamT m b -> JsonEventStreamT m a
forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> JsonEventStreamT m a -> JsonEventStreamT m b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> JsonEventStreamT m a -> JsonEventStreamT m b
fmap :: forall a b.
(a -> b) -> JsonEventStreamT m a -> JsonEventStreamT m b
$c<$ :: forall (m :: Type -> Type) a b.
Functor m =>
a -> JsonEventStreamT m b -> JsonEventStreamT m a
<$ :: forall a b. a -> JsonEventStreamT m b -> JsonEventStreamT m a
Functor)
    deriving newtype (NonEmpty (JsonEventStreamT m a) -> JsonEventStreamT m a
JsonEventStreamT m a
-> JsonEventStreamT m a -> JsonEventStreamT m a
(JsonEventStreamT m a
 -> JsonEventStreamT m a -> JsonEventStreamT m a)
-> (NonEmpty (JsonEventStreamT m a) -> JsonEventStreamT m a)
-> (forall b.
    Integral b =>
    b -> JsonEventStreamT m a -> JsonEventStreamT m a)
-> Semigroup (JsonEventStreamT m a)
forall b.
Integral b =>
b -> JsonEventStreamT m a -> JsonEventStreamT m a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (m :: Type -> Type) a.
Functor m =>
NonEmpty (JsonEventStreamT m a) -> JsonEventStreamT m a
forall (m :: Type -> Type) a.
Functor m =>
JsonEventStreamT m a
-> JsonEventStreamT m a -> JsonEventStreamT m a
forall (m :: Type -> Type) a b.
(Functor m, Integral b) =>
b -> JsonEventStreamT m a -> JsonEventStreamT m a
$c<> :: forall (m :: Type -> Type) a.
Functor m =>
JsonEventStreamT m a
-> JsonEventStreamT m a -> JsonEventStreamT m a
<> :: JsonEventStreamT m a
-> JsonEventStreamT m a -> JsonEventStreamT m a
$csconcat :: forall (m :: Type -> Type) a.
Functor m =>
NonEmpty (JsonEventStreamT m a) -> JsonEventStreamT m a
sconcat :: NonEmpty (JsonEventStreamT m a) -> JsonEventStreamT m a
$cstimes :: forall (m :: Type -> Type) a b.
(Functor m, Integral b) =>
b -> JsonEventStreamT m a -> JsonEventStreamT m a
stimes :: forall b.
Integral b =>
b -> JsonEventStreamT m a -> JsonEventStreamT m a
Semigroup, Semigroup (JsonEventStreamT m a)
JsonEventStreamT m a
Semigroup (JsonEventStreamT m a) =>
JsonEventStreamT m a
-> (JsonEventStreamT m a
    -> JsonEventStreamT m a -> JsonEventStreamT m a)
-> ([JsonEventStreamT m a] -> JsonEventStreamT m a)
-> Monoid (JsonEventStreamT m a)
[JsonEventStreamT m a] -> JsonEventStreamT m a
JsonEventStreamT m a
-> JsonEventStreamT m a -> JsonEventStreamT m a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (m :: Type -> Type) a.
Functor m =>
Semigroup (JsonEventStreamT m a)
forall (m :: Type -> Type) a. Functor m => JsonEventStreamT m a
forall (m :: Type -> Type) a.
Functor m =>
[JsonEventStreamT m a] -> JsonEventStreamT m a
forall (m :: Type -> Type) a.
Functor m =>
JsonEventStreamT m a
-> JsonEventStreamT m a -> JsonEventStreamT m a
$cmempty :: forall (m :: Type -> Type) a. Functor m => JsonEventStreamT m a
mempty :: JsonEventStreamT m a
$cmappend :: forall (m :: Type -> Type) a.
Functor m =>
JsonEventStreamT m a
-> JsonEventStreamT m a -> JsonEventStreamT m a
mappend :: JsonEventStreamT m a
-> JsonEventStreamT m a -> JsonEventStreamT m a
$cmconcat :: forall (m :: Type -> Type) a.
Functor m =>
[JsonEventStreamT m a] -> JsonEventStreamT m a
mconcat :: [JsonEventStreamT m a] -> JsonEventStreamT m a
Monoid)

-- | Server-sent JSON event stream
instance (MonadIO m, Aeson.FromJSON a) => FromSourceIO EventStreamChunk (JsonEventStreamT m a) where
    fromSourceIO :: SourceIO EventStreamChunk -> IO (JsonEventStreamT m a)
fromSourceIO SourceIO EventStreamChunk
input = do
        src :: EventStreamT m <- SourceIO EventStreamChunk -> IO (EventStreamT m)
forall chunk a. FromSourceIO chunk a => SourceIO chunk -> IO a
fromSourceIO SourceIO EventStreamChunk
input
        pure $
            -- The 'coerce' efficiently unwraps the 'EventStreamT' and wraps the
            -- JsonEventStreamT.
            coerce
                (mapStepT jsonEventsFromEvents)
                src