{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Subscription.SSE
-- Copyright   :  (C) 2016-2018 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
----------------------------------------------------------------------------
module Miso.Subscription.SSE
 ( -- * Subscription
   sseSub
   -- * Types
 , SSE (..)
 ) where

import           Control.Monad.IO.Class
import           Data.Aeson
import           Miso.Effect (Sub)
import           Miso.FFI
import           Miso.String

import qualified Miso.FFI.SSE as SSE

-- | Server-sent events Subscription
sseSub :: FromJSON msg => MisoString -> (SSE msg -> action) -> Sub action
sseSub :: MisoString -> (SSE msg -> action) -> Sub action
sseSub MisoString
url SSE msg -> action
f = \Sink action
sink -> do
  EventSource
es <- MisoString -> JSM EventSource
SSE.new MisoString
url
  EventSource -> MisoString -> (JSVal -> JSM ()) -> JSM ()
SSE.addEventListener EventSource
es MisoString
"message" ((JSVal -> JSM ()) -> JSM ()) -> (JSVal -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSVal
val -> do
    msg
dat <- JSVal -> JSM msg
forall json. FromJSON json => JSVal -> JSM json
parse (JSVal -> JSM msg) -> JSM JSVal -> JSM msg
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal -> JSM JSVal
SSE.data' JSVal
val
    (IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> Sink action -> action -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sink action
sink) (SSE msg -> action
f (msg -> SSE msg
forall message. message -> SSE message
SSEMessage msg
dat))
  EventSource -> MisoString -> (JSVal -> JSM ()) -> JSM ()
SSE.addEventListener EventSource
es MisoString
"error" ((JSVal -> JSM ()) -> JSM ()) -> (JSVal -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSVal
_ ->
    (IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> Sink action -> action -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sink action
sink) (SSE msg -> action
f SSE msg
forall message. SSE message
SSEError)
  EventSource -> MisoString -> (JSVal -> JSM ()) -> JSM ()
SSE.addEventListener EventSource
es MisoString
"close" ((JSVal -> JSM ()) -> JSM ()) -> (JSVal -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSVal
_ ->
    (IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> Sink action -> action -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sink action
sink) (SSE msg -> action
f SSE msg
forall message. SSE message
SSEClose)

-- | Server-sent events data
data SSE message
  = SSEMessage message
  | SSEClose
  | SSEError
  deriving (Int -> SSE message -> ShowS
[SSE message] -> ShowS
SSE message -> String
(Int -> SSE message -> ShowS)
-> (SSE message -> String)
-> ([SSE message] -> ShowS)
-> Show (SSE message)
forall message. Show message => Int -> SSE message -> ShowS
forall message. Show message => [SSE message] -> ShowS
forall message. Show message => SSE message -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SSE message] -> ShowS
$cshowList :: forall message. Show message => [SSE message] -> ShowS
show :: SSE message -> String
$cshow :: forall message. Show message => SSE message -> String
showsPrec :: Int -> SSE message -> ShowS
$cshowsPrec :: forall message. Show message => Int -> SSE message -> ShowS
Show, SSE message -> SSE message -> Bool
(SSE message -> SSE message -> Bool)
-> (SSE message -> SSE message -> Bool) -> Eq (SSE message)
forall message. Eq message => SSE message -> SSE message -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SSE message -> SSE message -> Bool
$c/= :: forall message. Eq message => SSE message -> SSE message -> Bool
== :: SSE message -> SSE message -> Bool
$c== :: forall message. Eq message => SSE message -> SSE message -> Bool
Eq)

-- | Test URL
-- http://sapid.sourceforge.net/ssetest/webkit.events.php
-- var source = new EventSource("demo_sse.php");