{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module Miso.Subscription.SSE
(
sseSub
, 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
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)
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)