{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}

{-

It's a box. It's a socket. It's an example.

-}

module Box.Socket.Example where

import Box
import Box.Socket
import Control.Concurrent.Async
import Data.Bool
import Data.Functor.Contravariant
import Data.Text (Text, pack)

serverIO :: IO ()
serverIO :: IO ()
serverIO =
  SocketConfig -> ServerApp -> IO ()
runServer
    SocketConfig
defaultSocketConfig
    ((Text -> Either Text Text) -> ServerApp
responderApp (\Text
x -> forall a. a -> a -> Bool -> a
bool (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text
"echo:" forall a. Semigroup a => a -> a -> a
<> Text
x) (forall a b. a -> Either a b
Left Text
"quit") (Text
x forall a. Eq a => a -> a -> Bool
== Text
"q")))

clientIO :: IO ()
clientIO :: IO ()
clientIO =
  (SocketConfig -> ClientApp () -> IO ()
runClient SocketConfig
defaultSocketConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box IO (Either Text Text) Text -> ClientApp ()
clientApp)
    (forall (m :: * -> *) c e. Committer m c -> Emitter m e -> Box m c e
Box (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Committer IO Text
toStdout) Emitter IO Text
fromStdin)

q' :: IO a -> IO (Either () a)
q' :: forall a. IO a -> IO (Either () a)
q' IO a
f = forall a b. IO a -> IO b -> IO (Either a b)
race (Emitter IO Text -> IO ()
cancelQ Emitter IO Text
fromStdin) IO a
f

cancelQ :: Emitter IO Text -> IO ()
cancelQ :: Emitter IO Text -> IO ()
cancelQ Emitter IO Text
e = do
  Maybe Text
e' <- forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO Text
e
  case Maybe Text
e' of
    Just Text
"q" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Maybe Text
_notQ -> do
      String -> IO ()
putStrLn String
"nothing happens"
      Emitter IO Text -> IO ()
cancelQ Emitter IO Text
e

-- | test of clientApp via a cRef committer and a canned list of Text
tClient :: [Text] -> IO [Either Text Text]
tClient :: [Text] -> IO [Either Text Text]
tClient [Text]
xs = do
  (Committer IO (Either Text Text)
c, IO [Either Text Text]
r) <- forall a. IO (Committer IO a, IO [a])
refCommitter
  SocketConfig -> ClientApp () -> IO ()
runClient
    SocketConfig
defaultSocketConfig
    ( \Connection
conn ->
        (\Box IO (Either Text Text) Text
b -> Box IO (Either Text Text) Text -> ClientApp ()
clientApp Box IO (Either Text Text) Text
b Connection
conn) forall a (m :: * -> *) r. (a -> m r) -> Codensity m a -> m r
<$|>
          ( forall (m :: * -> *) c e. Committer m c -> Emitter m e -> Box m c e
Box Committer IO (Either Text Text)
c
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> CoEmitter IO a
qList ([Text]
xs forall a. Semigroup a => a -> a -> a
<> [Text
"q"])
          )
    )
  IO [Either Text Text]
r

tClientIO :: [Text] -> IO ()
tClientIO :: [Text] -> IO ()
tClientIO [Text]
xs =
  (SocketConfig -> ClientApp () -> IO ()
runClient SocketConfig
defaultSocketConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box IO (Either Text Text) Text -> ClientApp ()
clientApp) forall a (m :: * -> *) r. (a -> m r) -> Codensity m a -> m r
<$|>
    (forall (m :: * -> *) c e. Committer m c -> Emitter m e -> Box m c e
Box (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Committer IO Text
toStdout) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> CoEmitter IO a
qList ([Text]
xs forall a. Semigroup a => a -> a -> a
<> [Text
"q"]))

-- | main test run of client-server functionality
-- the code starts a server in a thread, starts the client in the main thread, and cancels the server on completion.
-- > testRun
-- [Left "receiver: received: echo:1",Right "echo:1",Left "receiver: received: echo:2",Right "echo:2",Left "receiver: received: echo:3",Right "echo:3",Left "receiver: received: close: 1000 \"received close signal: responder closed.\""]
testRun :: IO [Either Text Text]
testRun :: IO [Either Text Text]
testRun = do
  Async ()
a <- forall a. IO a -> IO (Async a)
async (SocketConfig -> ServerApp -> IO ()
runServer SocketConfig
defaultSocketConfig ((Text -> Either Text Text) -> ServerApp
responderApp (\Text
x -> forall a. a -> a -> Bool -> a
bool (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text
"echo:" forall a. Semigroup a => a -> a -> a
<> Text
x) (forall a b. a -> Either a b
Left Text
"quit") (Text
x forall a. Eq a => a -> a -> Bool
== Text
"q"))))
  Double -> IO ()
sleep Double
0.1
  [Either Text Text]
r <- [Text] -> IO [Either Text Text]
tClient (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. Int
3 :: Int])
  forall a. Async a -> IO ()
cancel Async ()
a
  forall (f :: * -> *) a. Applicative f => a -> f a
pure [Either Text Text]
r