{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}
module Box.Websocket.Example where
import Box
import Box.Socket.Types
import Box.Websocket
import Control.Concurrent.Async
import Data.Functor.Contravariant
import Data.Text (Text)
senderExample :: [Text] -> IO [Text]
senderExample :: [Text] -> IO [Text]
senderExample [Text]
ts = do
(Committer IO Text
c, IO [Text]
r) <- forall a. IO (Committer IO a, IO [a])
refCommitter
Async ()
a <- forall a. IO a -> IO (Async a)
async (forall a.
WebSocketsData a =>
SocketConfig -> PostSend -> Box IO a a -> IO ()
serverBox SocketConfig
defaultSocketConfig (Double -> PostSend
CloseAfter Double
0.2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) c e. Committer m c -> Emitter m e -> Box m c e
Box forall a. Monoid a => a
mempty forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> forall a. [a] -> CoEmitter IO a
qList [Text]
ts)
Double -> IO ()
sleep Double
0.1
forall a.
WebSocketsData a =>
SocketConfig -> PostSend -> Box IO a a -> IO ()
clientBox SocketConfig
defaultSocketConfig PostSend
StayOpen (forall (m :: * -> *) c e. Committer m c -> Emitter m e -> Box m c e
Box Committer IO Text
c forall a. Monoid a => a
mempty)
Double -> IO ()
sleep Double
0.1
forall a. Async a -> IO ()
cancel Async ()
a
IO [Text]
r
echoExample :: [Text] -> IO [Text]
echoExample :: [Text] -> IO [Text]
echoExample [Text]
ts = do
(Committer IO Text
c, IO [Text]
r) <- forall a. IO (Committer IO a, IO [a])
refCommitter
Async ()
a <-
forall a. IO a -> IO (Async a)
async
(forall a.
WebSocketsData a =>
SocketConfig -> (a -> Maybe a) -> IO ()
responseServer SocketConfig
defaultSocketConfig (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text
"echo: " :: Text) <>)))
Double -> IO ()
sleep Double
0.1
forall a.
WebSocketsData a =>
SocketConfig -> PostSend -> Box IO a a -> IO ()
clientBox SocketConfig
defaultSocketConfig (Double -> PostSend
CloseAfter Double
0.2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) c e. Committer m c -> Emitter m e -> Box m c e
Box Committer IO Text
c forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> forall a. [a] -> CoEmitter IO a
qList [Text]
ts
Double -> IO ()
sleep Double
0.1
forall a. Async a -> IO ()
cancel Async ()
a
IO [Text]
r
echoLogExample :: [Text] -> IO ([Text], [Text])
echoLogExample :: [Text] -> IO ([Text], [Text])
echoLogExample [Text]
ts = do
(Committer IO Text
c, IO [Text]
r) <- forall a. IO (Committer IO a, IO [a])
refCommitter
(Committer IO Text
cLog, IO [Text]
resLog) <- forall a. IO (Committer IO a, IO [a])
refCommitter
Async ()
a <-
forall a. IO a -> IO (Async a)
async
(forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Box m b a -> m ()
fuse (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text
"echo: " :: Text) <>)) forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> forall a b r. (Box IO a b -> IO r) -> CoBox IO b a
fromAction (\Box IO Text Text
b -> forall a.
(WebSocketsData a, Show a) =>
PostSend -> Committer IO Text -> Box IO a a -> Connection -> IO ()
duplex_ (Double -> PostSend
CloseAfter Double
0.5) (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (Text
"server:" <>) Committer IO Text
cLog) Box IO Text Text
b forall {k} a (m :: k -> *) (r :: k).
(a -> m r) -> Codensity m a -> m r
<$|> SocketConfig -> Codensity IO Connection
serve SocketConfig
defaultSocketConfig))
Double -> IO ()
sleep Double
0.1
forall a.
(WebSocketsData a, Show a) =>
PostSend -> Committer IO Text -> Box IO a a -> Connection -> IO ()
duplex_ (Double -> PostSend
CloseAfter Double
0.2) (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (Text
"client:" <>) Committer IO Text
cLog) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) c e. Committer m c -> Emitter m e -> Box m c e
Box Committer IO Text
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> CoEmitter IO a
qList [Text]
ts forall {k} (m :: k -> *) a (r :: k).
Codensity m (a -> m r) -> Codensity m a -> m r
<*|> SocketConfig -> Codensity IO Connection
connect SocketConfig
defaultSocketConfig
Double -> IO ()
sleep Double
0.1
forall a. Async a -> IO ()
cancel Async ()
a
(,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Text]
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO [Text]
resLog
clientIO :: IO ()
clientIO :: IO ()
clientIO =
forall a.
WebSocketsData a =>
SocketConfig -> PostSend -> Box IO a a -> IO ()
clientBox SocketConfig
defaultSocketConfig (Double -> PostSend
CloseAfter Double
0) (Text -> Box IO Text Text
stdBox Text
"q")
serverIO :: IO ()
serverIO :: IO ()
serverIO = forall a.
WebSocketsData a =>
SocketConfig -> PostSend -> Box IO a a -> IO ()
serverBox SocketConfig
defaultSocketConfig (Double -> PostSend
CloseAfter Double
0) (Text -> Box IO Text Text
stdBox Text
"q")