{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Miso.Subscription.WebSocket
(
websocketSub
, send
, close
, connect
, getSocketState
, WebSocket (..)
, URL (..)
, Protocols (..)
, SocketState (..)
, CloseCode (..)
, WasClean (..)
, Reason (..)
) where
import Control.Concurrent (threadDelay)
import Control.Monad (when, void, unless)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (FromJSON, ToJSON)
import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef)
import GHC.Generics (Generic)
import Language.Javascript.JSaddle hiding (create)
import System.IO.Unsafe (unsafePerformIO)
import Miso.Effect (Sub)
import qualified Miso.FFI.Internal as FFI
import Miso.String (MisoString)
websocket :: IORef (Maybe Socket)
{-# NOINLINE websocket #-}
websocket :: IORef (Maybe Socket)
websocket = IO (IORef (Maybe Socket)) -> IORef (Maybe Socket)
forall a. IO a -> a
unsafePerformIO (Maybe Socket -> IO (IORef (Maybe Socket))
forall a. a -> IO (IORef a)
newIORef Maybe Socket
forall a. Maybe a
Nothing)
closedCode :: IORef (Maybe CloseCode)
{-# NOINLINE closedCode #-}
closedCode :: IORef (Maybe CloseCode)
closedCode = IO (IORef (Maybe CloseCode)) -> IORef (Maybe CloseCode)
forall a. IO a -> a
unsafePerformIO (Maybe CloseCode -> IO (IORef (Maybe CloseCode))
forall a. a -> IO (IORef a)
newIORef Maybe CloseCode
forall a. Maybe a
Nothing)
secs :: Int -> Int
secs :: Int -> Int
secs = (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
1000000)
websocketSub
:: FromJSON m
=> URL
-> Protocols
-> (WebSocket m -> action)
-> Sub action
websocketSub :: forall m action.
FromJSON m =>
URL -> Protocols -> (WebSocket m -> action) -> Sub action
websocketSub (URL MisoString
u) (Protocols [MisoString]
ps) WebSocket m -> action
f Sink action
sink = do
socket <- MisoString -> [MisoString] -> JSM Socket
createWebSocket MisoString
u [MisoString]
ps
liftIO (writeIORef websocket (Just socket))
void . FFI.forkJSM $ handleReconnect
addEventListener socket "open" $ \JSVal
_ -> do
IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe CloseCode) -> Maybe CloseCode -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe CloseCode)
closedCode Maybe CloseCode
forall a. Maybe a
Nothing)
Sink action
sink (WebSocket m -> action
f WebSocket m
forall action. WebSocket action
WebSocketOpen)
addEventListener socket "message" $ \JSVal
v -> do
d <- JSVal -> JSM m
forall json. FromJSON json => JSVal -> JSM json
FFI.jsonParse (JSVal -> JSM m) -> JSM JSVal -> JSM m
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> MisoString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (MisoString
"data" :: MisoString)
sink $ f (WebSocketMessage d)
addEventListener socket "close" $ \JSVal
e -> do
code <- Int -> CloseCode
codeToCloseCode (Int -> CloseCode) -> JSM Int -> JSM CloseCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal -> JSM Int
getCode JSVal
e
liftIO (writeIORef closedCode (Just code))
reason <- getReason e
clean <- wasClean e
sink $ f (WebSocketClose code clean reason)
addEventListener socket "error" $ \JSVal
v -> do
IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe CloseCode) -> Maybe CloseCode -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe CloseCode)
closedCode Maybe CloseCode
forall a. Maybe a
Nothing)
d' <- JSVal
v JSVal -> MisoString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (MisoString
"data" :: MisoString)
#ifndef ghcjs_HOST_OS
undef <- FFI.ghcjsPure (isUndefined d')
#else
let undef = isUndefined d'
#endif
if undef
then do
sink $ f (WebSocketError mempty)
else do
Just d <- fromJSVal d'
sink $ f (WebSocketError d)
where
handleReconnect :: JSM ()
handleReconnect = do
IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ()
threadDelay (Int -> Int
secs Int
3))
Just s <- IO (Maybe Socket) -> JSM (Maybe Socket)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe Socket) -> IO (Maybe Socket)
forall a. IORef a -> IO a
readIORef IORef (Maybe Socket)
websocket)
status <- socketState s
code <- liftIO (readIORef closedCode)
if status == 3
then do
unless (code == Just CLOSE_NORMAL) $
websocketSub (URL u) (Protocols ps) f sink
else handleReconnect
send :: ToJSON a => a -> JSM ()
{-# INLINE send #-}
send :: forall a. ToJSON a => a -> JSM ()
send a
x = do
Just socket <- IO (Maybe Socket) -> JSM (Maybe Socket)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe Socket) -> IO (Maybe Socket)
forall a. IORef a -> IO a
readIORef IORef (Maybe Socket)
websocket)
sendJson' socket x
close :: JSM ()
{-# INLINE close #-}
close :: JSM ()
close = (Socket -> JSM ()) -> Maybe Socket -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Socket -> JSM ()
closeSocket (Maybe Socket -> JSM ()) -> JSM (Maybe Socket) -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe Socket) -> JSM (Maybe Socket)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe Socket) -> IO (Maybe Socket)
forall a. IORef a -> IO a
readIORef IORef (Maybe Socket)
websocket)
connect :: URL -> Protocols -> JSM ()
{-# INLINE connect #-}
connect :: URL -> Protocols -> JSM ()
connect (URL MisoString
url') (Protocols [MisoString]
ps) = do
Just ws <- IO (Maybe Socket) -> JSM (Maybe Socket)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe Socket) -> IO (Maybe Socket)
forall a. IORef a -> IO a
readIORef IORef (Maybe Socket)
websocket)
s <- socketState ws
when (s == 3) $ do
socket <- createWebSocket url' ps
liftIO (atomicWriteIORef websocket (Just socket))
getSocketState :: JSM SocketState
getSocketState :: JSM SocketState
getSocketState = do
Just ws <- IO (Maybe Socket) -> JSM (Maybe Socket)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe Socket) -> IO (Maybe Socket)
forall a. IORef a -> IO a
readIORef IORef (Maybe Socket)
websocket)
toEnum <$> socketState ws
sendJson' :: ToJSON json => Socket -> json -> JSM ()
sendJson' :: forall json. ToJSON json => Socket -> json -> JSM ()
sendJson' Socket
socket json
m = Socket -> MisoString -> JSM ()
sendSocket Socket
socket (MisoString -> JSM ()) -> JSM MisoString -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< json -> JSM MisoString
forall json. ToJSON json => json -> JSM MisoString
FFI.jsonStringify json
m
createWebSocket :: MisoString -> [MisoString] -> JSM Socket
{-# INLINE createWebSocket #-}
createWebSocket :: MisoString -> [MisoString] -> JSM Socket
createWebSocket MisoString
url' [MisoString]
protocols = MisoString -> JSVal -> JSM Socket
createSocket MisoString
url' (JSVal -> JSM Socket) -> JSM JSVal -> JSM Socket
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [MisoString] -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal [MisoString]
protocols
codeToCloseCode :: Int -> CloseCode
codeToCloseCode :: Int -> CloseCode
codeToCloseCode = Int -> CloseCode
go
where
go :: Int -> CloseCode
go Int
1000 = CloseCode
CLOSE_NORMAL
go Int
1001 = CloseCode
CLOSE_GOING_AWAY
go Int
1002 = CloseCode
CLOSE_PROTOCOL_ERROR
go Int
1003 = CloseCode
CLOSE_UNSUPPORTED
go Int
1005 = CloseCode
CLOSE_NO_STATUS
go Int
1006 = CloseCode
CLOSE_ABNORMAL
go Int
1007 = CloseCode
Unsupported_Data
go Int
1008 = CloseCode
Policy_Violation
go Int
1009 = CloseCode
CLOSE_TOO_LARGE
go Int
1010 = CloseCode
Missing_Extension
go Int
1011 = CloseCode
Internal_Error
go Int
1012 = CloseCode
Service_Restart
go Int
1013 = CloseCode
Try_Again_Later
go Int
1015 = CloseCode
TLS_Handshake
go Int
n = Int -> CloseCode
OtherCode Int
n
data WebSocket action
= WebSocketMessage action
| WebSocketClose CloseCode WasClean Reason
| WebSocketOpen
| WebSocketError MisoString
deriving (Int -> WebSocket action -> ShowS
[WebSocket action] -> ShowS
WebSocket action -> String
(Int -> WebSocket action -> ShowS)
-> (WebSocket action -> String)
-> ([WebSocket action] -> ShowS)
-> Show (WebSocket action)
forall action. Show action => Int -> WebSocket action -> ShowS
forall action. Show action => [WebSocket action] -> ShowS
forall action. Show action => WebSocket action -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall action. Show action => Int -> WebSocket action -> ShowS
showsPrec :: Int -> WebSocket action -> ShowS
$cshow :: forall action. Show action => WebSocket action -> String
show :: WebSocket action -> String
$cshowList :: forall action. Show action => [WebSocket action] -> ShowS
showList :: [WebSocket action] -> ShowS
Show, WebSocket action -> WebSocket action -> Bool
(WebSocket action -> WebSocket action -> Bool)
-> (WebSocket action -> WebSocket action -> Bool)
-> Eq (WebSocket action)
forall action.
Eq action =>
WebSocket action -> WebSocket action -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall action.
Eq action =>
WebSocket action -> WebSocket action -> Bool
== :: WebSocket action -> WebSocket action -> Bool
$c/= :: forall action.
Eq action =>
WebSocket action -> WebSocket action -> Bool
/= :: WebSocket action -> WebSocket action -> Bool
Eq)
newtype URL = URL MisoString
deriving (Int -> URL -> ShowS
[URL] -> ShowS
URL -> String
(Int -> URL -> ShowS)
-> (URL -> String) -> ([URL] -> ShowS) -> Show URL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> URL -> ShowS
showsPrec :: Int -> URL -> ShowS
$cshow :: URL -> String
show :: URL -> String
$cshowList :: [URL] -> ShowS
showList :: [URL] -> ShowS
Show, URL -> URL -> Bool
(URL -> URL -> Bool) -> (URL -> URL -> Bool) -> Eq URL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: URL -> URL -> Bool
== :: URL -> URL -> Bool
$c/= :: URL -> URL -> Bool
/= :: URL -> URL -> Bool
Eq)
newtype Protocols = Protocols [MisoString]
deriving (Int -> Protocols -> ShowS
[Protocols] -> ShowS
Protocols -> String
(Int -> Protocols -> ShowS)
-> (Protocols -> String)
-> ([Protocols] -> ShowS)
-> Show Protocols
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Protocols -> ShowS
showsPrec :: Int -> Protocols -> ShowS
$cshow :: Protocols -> String
show :: Protocols -> String
$cshowList :: [Protocols] -> ShowS
showList :: [Protocols] -> ShowS
Show, Protocols -> Protocols -> Bool
(Protocols -> Protocols -> Bool)
-> (Protocols -> Protocols -> Bool) -> Eq Protocols
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Protocols -> Protocols -> Bool
== :: Protocols -> Protocols -> Bool
$c/= :: Protocols -> Protocols -> Bool
/= :: Protocols -> Protocols -> Bool
Eq)
newtype WasClean = WasClean Bool deriving (Int -> WasClean -> ShowS
[WasClean] -> ShowS
WasClean -> String
(Int -> WasClean -> ShowS)
-> (WasClean -> String) -> ([WasClean] -> ShowS) -> Show WasClean
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WasClean -> ShowS
showsPrec :: Int -> WasClean -> ShowS
$cshow :: WasClean -> String
show :: WasClean -> String
$cshowList :: [WasClean] -> ShowS
showList :: [WasClean] -> ShowS
Show, WasClean -> WasClean -> Bool
(WasClean -> WasClean -> Bool)
-> (WasClean -> WasClean -> Bool) -> Eq WasClean
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WasClean -> WasClean -> Bool
== :: WasClean -> WasClean -> Bool
$c/= :: WasClean -> WasClean -> Bool
/= :: WasClean -> WasClean -> Bool
Eq)
newtype Reason = Reason MisoString deriving (Int -> Reason -> ShowS
[Reason] -> ShowS
Reason -> String
(Int -> Reason -> ShowS)
-> (Reason -> String) -> ([Reason] -> ShowS) -> Show Reason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reason -> ShowS
showsPrec :: Int -> Reason -> ShowS
$cshow :: Reason -> String
show :: Reason -> String
$cshowList :: [Reason] -> ShowS
showList :: [Reason] -> ShowS
Show, Reason -> Reason -> Bool
(Reason -> Reason -> Bool)
-> (Reason -> Reason -> Bool) -> Eq Reason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reason -> Reason -> Bool
== :: Reason -> Reason -> Bool
$c/= :: Reason -> Reason -> Bool
/= :: Reason -> Reason -> Bool
Eq)
data SocketState
= CONNECTING
| OPEN
| CLOSING
| CLOSED
deriving (Int -> SocketState -> ShowS
[SocketState] -> ShowS
SocketState -> String
(Int -> SocketState -> ShowS)
-> (SocketState -> String)
-> ([SocketState] -> ShowS)
-> Show SocketState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SocketState -> ShowS
showsPrec :: Int -> SocketState -> ShowS
$cshow :: SocketState -> String
show :: SocketState -> String
$cshowList :: [SocketState] -> ShowS
showList :: [SocketState] -> ShowS
Show, SocketState -> SocketState -> Bool
(SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> Bool) -> Eq SocketState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SocketState -> SocketState -> Bool
== :: SocketState -> SocketState -> Bool
$c/= :: SocketState -> SocketState -> Bool
/= :: SocketState -> SocketState -> Bool
Eq, Eq SocketState
Eq SocketState =>
(SocketState -> SocketState -> Ordering)
-> (SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> SocketState)
-> (SocketState -> SocketState -> SocketState)
-> Ord SocketState
SocketState -> SocketState -> Bool
SocketState -> SocketState -> Ordering
SocketState -> SocketState -> SocketState
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 :: SocketState -> SocketState -> Ordering
compare :: SocketState -> SocketState -> Ordering
$c< :: SocketState -> SocketState -> Bool
< :: SocketState -> SocketState -> Bool
$c<= :: SocketState -> SocketState -> Bool
<= :: SocketState -> SocketState -> Bool
$c> :: SocketState -> SocketState -> Bool
> :: SocketState -> SocketState -> Bool
$c>= :: SocketState -> SocketState -> Bool
>= :: SocketState -> SocketState -> Bool
$cmax :: SocketState -> SocketState -> SocketState
max :: SocketState -> SocketState -> SocketState
$cmin :: SocketState -> SocketState -> SocketState
min :: SocketState -> SocketState -> SocketState
Ord, Int -> SocketState
SocketState -> Int
SocketState -> [SocketState]
SocketState -> SocketState
SocketState -> SocketState -> [SocketState]
SocketState -> SocketState -> SocketState -> [SocketState]
(SocketState -> SocketState)
-> (SocketState -> SocketState)
-> (Int -> SocketState)
-> (SocketState -> Int)
-> (SocketState -> [SocketState])
-> (SocketState -> SocketState -> [SocketState])
-> (SocketState -> SocketState -> [SocketState])
-> (SocketState -> SocketState -> SocketState -> [SocketState])
-> Enum SocketState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SocketState -> SocketState
succ :: SocketState -> SocketState
$cpred :: SocketState -> SocketState
pred :: SocketState -> SocketState
$ctoEnum :: Int -> SocketState
toEnum :: Int -> SocketState
$cfromEnum :: SocketState -> Int
fromEnum :: SocketState -> Int
$cenumFrom :: SocketState -> [SocketState]
enumFrom :: SocketState -> [SocketState]
$cenumFromThen :: SocketState -> SocketState -> [SocketState]
enumFromThen :: SocketState -> SocketState -> [SocketState]
$cenumFromTo :: SocketState -> SocketState -> [SocketState]
enumFromTo :: SocketState -> SocketState -> [SocketState]
$cenumFromThenTo :: SocketState -> SocketState -> SocketState -> [SocketState]
enumFromThenTo :: SocketState -> SocketState -> SocketState -> [SocketState]
Enum)
data CloseCode
= CLOSE_NORMAL
| CLOSE_GOING_AWAY
| CLOSE_PROTOCOL_ERROR
| CLOSE_UNSUPPORTED
| CLOSE_NO_STATUS
| CLOSE_ABNORMAL
| Unsupported_Data
| Policy_Violation
| CLOSE_TOO_LARGE
| Missing_Extension
| Internal_Error
| Service_Restart
| Try_Again_Later
| TLS_Handshake
| OtherCode Int
deriving (Int -> CloseCode -> ShowS
[CloseCode] -> ShowS
CloseCode -> String
(Int -> CloseCode -> ShowS)
-> (CloseCode -> String)
-> ([CloseCode] -> ShowS)
-> Show CloseCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CloseCode -> ShowS
showsPrec :: Int -> CloseCode -> ShowS
$cshow :: CloseCode -> String
show :: CloseCode -> String
$cshowList :: [CloseCode] -> ShowS
showList :: [CloseCode] -> ShowS
Show, CloseCode -> CloseCode -> Bool
(CloseCode -> CloseCode -> Bool)
-> (CloseCode -> CloseCode -> Bool) -> Eq CloseCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CloseCode -> CloseCode -> Bool
== :: CloseCode -> CloseCode -> Bool
$c/= :: CloseCode -> CloseCode -> Bool
/= :: CloseCode -> CloseCode -> Bool
Eq, (forall x. CloseCode -> Rep CloseCode x)
-> (forall x. Rep CloseCode x -> CloseCode) -> Generic CloseCode
forall x. Rep CloseCode x -> CloseCode
forall x. CloseCode -> Rep CloseCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CloseCode -> Rep CloseCode x
from :: forall x. CloseCode -> Rep CloseCode x
$cto :: forall x. Rep CloseCode x -> CloseCode
to :: forall x. Rep CloseCode x -> CloseCode
Generic)
instance ToJSVal CloseCode
instance FromJSVal CloseCode
newtype Socket = Socket JSVal
createSocket :: MisoString -> JSVal -> JSM Socket
createSocket :: MisoString -> JSVal -> JSM Socket
createSocket MisoString
url JSVal
protocols = JSVal -> Socket
Socket (JSVal -> Socket) -> JSM JSVal -> JSM Socket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JSVal -> (MisoString, JSVal) -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new (JSString -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg (JSString
"WebSocket" :: JSString)) (MisoString
url, JSVal
protocols)
socketState :: Socket -> JSM Int
socketState :: Socket -> JSM Int
socketState (Socket JSVal
s) = JSVal -> JSM Int
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Int) -> JSM JSVal -> JSM Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
s JSVal -> JSString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (JSString
"readyState" :: JSString)
addEventListener :: Socket -> MisoString -> (JSVal -> JSM ()) -> JSM ()
addEventListener :: Socket -> MisoString -> (JSVal -> JSM ()) -> JSM ()
addEventListener (Socket JSVal
s) MisoString
name JSVal -> JSM ()
cb = do
JSVal -> MisoString -> (JSVal -> JSM ()) -> JSM ()
FFI.addEventListener JSVal
s MisoString
name JSVal -> JSM ()
cb
wasClean :: JSVal -> JSM WasClean
wasClean :: JSVal -> JSM WasClean
wasClean JSVal
v = Bool -> WasClean
WasClean (Bool -> WasClean) -> JSM Bool -> JSM WasClean
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSVal -> JSM Bool
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Bool) -> JSM JSVal -> JSM Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> JSString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (JSString
"wasClean" :: JSString))
getCode :: JSVal -> JSM Int
getCode :: JSVal -> JSM Int
getCode JSVal
v = JSVal -> JSM Int
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Int) -> JSM JSVal -> JSM Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> JSString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (JSString
"code" :: JSString)
getReason :: JSVal -> JSM Reason
getReason :: JSVal -> JSM Reason
getReason JSVal
v = MisoString -> Reason
Reason (MisoString -> Reason) -> JSM MisoString -> JSM Reason
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSVal -> JSM MisoString
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM MisoString) -> JSM JSVal -> JSM MisoString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> JSString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (JSString
"reason" :: JSString))
closeSocket :: Socket -> JSM ()
closeSocket :: Socket -> JSM ()
closeSocket (Socket JSVal
s) = do
_ <- JSVal
s JSVal -> JSString -> [JSString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (JSString
"close" :: JSString) ([JSString] -> JSM JSVal) -> [JSString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ([] :: [JSString])
pure ()
sendSocket :: Socket -> MisoString -> JSM ()
sendSocket :: Socket -> MisoString -> JSM ()
sendSocket (Socket JSVal
s) MisoString
msg = do
_ <- JSVal
s JSVal -> JSString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (JSString
"send" :: JSString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString
msg]
pure ()