{-# LANGUAGE DataKinds     #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE PolyKinds     #-}

-- | Server-sent events
--
-- See <https://www.w3.org/TR/2009/WD-eventsource-20090421/>.
--
module Servant.API.ServerSentEvents
    ( ServerSentEvents'
    , ServerSentEvents
    , EventKind (..)
    )
where

import           Data.Kind          (Type)
import           Data.Typeable      (Typeable)
import           GHC.Generics       (Generic)
import           GHC.TypeLits       (Nat)
import           Network.HTTP.Types (StdMethod (GET))

-- | Determines the shape of events you may receive (i.e. the @a@ in
-- 'ServerSentEvents\'')
data EventKind
    = RawEvent
        -- ^ 'EventMessage' or 'Event' 'ByteString'
    | JsonEvent
        -- ^ Anything that implements 'FromJSON'

-- | Server-sent events (SSE)
--
-- See <https://www.w3.org/TR/2009/WD-eventsource-20090421/>.
--
data ServerSentEvents' (method :: k) (status :: Nat) (kind :: EventKind) (a :: Type)
    deriving (Typeable, (forall x.
 ServerSentEvents' method status kind a
 -> Rep (ServerSentEvents' method status kind a) x)
-> (forall x.
    Rep (ServerSentEvents' method status kind a) x
    -> ServerSentEvents' method status kind a)
-> Generic (ServerSentEvents' method status kind a)
forall x.
Rep (ServerSentEvents' method status kind a) x
-> ServerSentEvents' method status kind a
forall x.
ServerSentEvents' method status kind a
-> Rep (ServerSentEvents' method status kind a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (method :: k) (status :: Nat) (kind :: EventKind) a x.
Rep (ServerSentEvents' method status kind a) x
-> ServerSentEvents' method status kind a
forall k (method :: k) (status :: Nat) (kind :: EventKind) a x.
ServerSentEvents' method status kind a
-> Rep (ServerSentEvents' method status kind a) x
$cfrom :: forall k (method :: k) (status :: Nat) (kind :: EventKind) a x.
ServerSentEvents' method status kind a
-> Rep (ServerSentEvents' method status kind a) x
from :: forall x.
ServerSentEvents' method status kind a
-> Rep (ServerSentEvents' method status kind a) x
$cto :: forall k (method :: k) (status :: Nat) (kind :: EventKind) a x.
Rep (ServerSentEvents' method status kind a) x
-> ServerSentEvents' method status kind a
to :: forall x.
Rep (ServerSentEvents' method status kind a) x
-> ServerSentEvents' method status kind a
Generic)

type ServerSentEvents = ServerSentEvents' 'GET 200