packages feed

box-socket 0.2.0 → 0.3.0

raw patch · 5 files changed

+98/−96 lines, 5 filesdep −generic-lensdep −lensdep ~boxdep ~bytestringdep ~optparse-genericPVP ok

version bump matches the API change (PVP)

Dependencies removed: generic-lens, lens

Dependency ranges changed: box, bytestring, optparse-generic

API changes (from Hackage documentation)

+ Box.Socket.Example: cancelQ :: Emitter IO Text -> IO ()
+ Box.Socket.Example: clientIO :: IO ()
+ Box.Socket.Example: q' :: IO a -> IO (Either () a)
+ Box.Socket.Example: serverIO :: IO ()
+ Box.Socket.Example: tClient :: [Text] -> IO [Either Text Text]
+ Box.Socket.Example: tClientIO :: [Text] -> IO ()
+ Box.Socket.Example: testRun :: IO [Either Text Text]
- Box.Socket: connect :: (MonadIO m, MonadConc m) => PendingConnection -> Cont m Connection
+ Box.Socket: connect :: (MonadIO m, MonadConc m) => PendingConnection -> Codensity m Connection

Files

app/box-socket.hs view
@@ -6,23 +6,16 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wall #-}-{-# OPTIONS_GHC -Wno-unused-do-bind #-}  {- -It's a box. It's a socket.+It's a box. It's a socket. It's an app.  -}  module Main where -import Box-import Box.Socket-import Control.Concurrent.Classy.Async as C-import Control.Lens hiding (Unwrapped, Wrapped)-import Data.Bool-import Data.Generics.Labels ()-import Data.Text (pack)+import Box.Socket.Example import Options.Generic  data SocketType = Client | Responder | TestRun deriving (Eq, Read, Show, Generic)@@ -48,59 +41,3 @@     Responder -> show <$> q' serverIO     TestRun -> show <$> testRun   putStrLn r---- * older stuff--serverIO :: IO ()-serverIO =-  runServer-    defaultSocketConfig-    (responderApp (\x -> bool (Right $ "echo:" <> x) (Left "quit") (x == "q")))--clientIO :: IO ()-clientIO =-  (runClient defaultSocketConfig . clientApp)-    (Box (contramap (pack . show) toStdout) fromStdin)--q' :: IO a -> IO (Either () a)-q' f = C.race (cancelQ fromStdin) f--cancelQ :: Emitter IO Text -> IO ()-cancelQ e = do-  e' <- emit e-  case e' of-    Just "q" -> pure ()-    _notQ -> do-      putStrLn "nothing happens"-      cancelQ e---- | test of clientApp via a cRef committer and a canned list of Text-tClient :: [Text] -> IO [Either Text Text]-tClient xs = do-  (c, r) <- cRef-  runClient-    defaultSocketConfig-    ( \conn ->-        (\b -> clientApp b conn)-          <$.> ( Box c-                   <$> fromListE (xs <> ["q"])-               )-    )-  r--tClientIO :: [Text] -> IO ()-tClientIO xs =-  (runClient defaultSocketConfig . clientApp)-    <$.> (Box (contramap (pack . show) toStdout) <$> fromListE (xs <> ["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 = do-  a <- C.async (runServer defaultSocketConfig (responderApp (\x -> bool (Right $ "echo:" <> x) (Left "quit") (x == "q"))))-  sleep 0.1-  r <- tClient (pack . show <$> [1 .. 3 :: Int])-  C.cancel a-  pure r
box-socket.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name:          box-socket-version:       0.2.0+version:       0.3.0 synopsis:      Box websockets description:   Websockets built with the box library. category:      project@@ -11,7 +11,7 @@ homepage:      https://github.com/tonyday567/box-socket#readme bug-reports:   https://github.com/tonyday567/box-socket/issues build-type:    Simple-tested-with:   GHC ==8.8.4 || ==8.10.4 || ==9.0.1 || ==9.2.0.20210821+tested-with:   GHC ==8.8.4 || ==8.10.7 || ==9.2.1  source-repository head   type:     git@@ -20,18 +20,17 @@ library   exposed-modules:     Box.Socket+    Box.Socket.Example     Box.TCP    hs-source-dirs:   src   build-depends:     , async           ^>=2.2.3-    , base            >=4.12    && <5-    , box             ^>=0.7-    , bytestring      ^>=0.10+    , base            >=4.12  && <5+    , box             ^>=0.8+    , bytestring      >=0.10  && <0.12     , concurrency     ^>=1.11     , exceptions      ^>=0.10-    , generic-lens    ^>=2.2-    , lens            ^>=5.0     , network         ^>=3.1     , network-simple  ^>=0.4     , text            ^>=1.2.4@@ -41,22 +40,17 @@   ghc-options:     -Wall -Wcompat -Wincomplete-record-updates     -Wincomplete-uni-patterns -Wredundant-constraints -fwrite-ide-info-    -hiedir=.hie -Wunused-packages+    -hiedir=.hie  executable box-socket   main-is:          box-socket.hs   hs-source-dirs:   app   build-depends:-    , base              >=4.7     && <5-    , box               ^>=0.7+    , base              >=4.7 && <5     , box-socket-    , concurrency       ^>=1.11-    , generic-lens      ^>=2.2-    , lens              ^>=5.0-    , optparse-generic  ^>=1.3-    , text              ^>=1.2.4+    , optparse-generic  >=1.3 && <1.5    default-language: Haskell2010   ghc-options:     -funbox-strict-fields -fforce-recomp -threaded -rtsopts-    -with-rtsopts=-N -fwrite-ide-info -hiedir=.hie -Wunused-packages+    -with-rtsopts=-N -fwrite-ide-info -hiedir=.hie
src/Box/Socket.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-} {-# OPTIONS_GHC -Wall #-}@@ -23,13 +22,11 @@  import Box import qualified Control.Concurrent.Classy.Async as C-import Control.Lens import Control.Monad import Control.Monad.Catch import Control.Monad.Conc.Class as C import Control.Monad.IO.Class import qualified Data.ByteString as BS-import Data.Generics.Labels () import Data.Text (Text, pack, unpack) import GHC.Generics import qualified Network.WebSockets as WS@@ -51,15 +48,15 @@  -- | Run a client app. runClient :: (MonadIO m) => SocketConfig -> WS.ClientApp () -> m ()-runClient c app = liftIO $ WS.runClient (unpack $ c ^. #host) (c ^. #port) (unpack $ c ^. #path) app+runClient c app = liftIO $ WS.runClient (unpack $ host c) (port c) (unpack $ path c) app  -- | Run a server app. runServer :: (MonadIO m) => SocketConfig -> WS.ServerApp -> m ()-runServer c app = liftIO $ WS.runServer (unpack $ c ^. #host) (c ^. #port) app+runServer c app = liftIO $ WS.runServer (unpack $ host c) (port c) app  -- | Connection continuation.-connect :: (MonadIO m, MonadConc m) => WS.PendingConnection -> Cont m WS.Connection-connect p = Cont $ \action ->+connect :: (MonadIO m, MonadConc m) => WS.PendingConnection -> Codensity m WS.Connection+connect p = Codensity $ \action ->   bracket     (liftIO $ WS.acceptRequest p)     (\conn -> liftIO $ WS.sendClose conn ("Bye from connect!" :: Text))@@ -86,7 +83,7 @@   (Text -> Either Text Text) ->   WS.PendingConnection ->   IO ()-responderApp f p = with (connect p) (responder f mempty)+responderApp f p = process (responder f mempty) (connect p)  -- | Standard server app for a box. serverApp ::@@ -96,13 +93,13 @@   m () serverApp (Box c e) p =   void $-    with-      (connect p)+    process       ( \conn ->           C.race             (receiver c conn)             (sender (Box mempty e) conn)       )+      (connect p)  -- | default websocket receiver with messages -- Lefts are info/debug
+ src/Box/Socket/Example.hs view
@@ -0,0 +1,75 @@+{-# 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.Classy.Async as C+import Data.Bool+import Data.Functor.Contravariant+import Data.Text (Text, pack)++serverIO :: IO ()+serverIO =+  runServer+    defaultSocketConfig+    (responderApp (\x -> bool (Right $ "echo:" <> x) (Left "quit") (x == "q")))++clientIO :: IO ()+clientIO =+  (runClient defaultSocketConfig . clientApp)+    (Box (contramap (pack . show) toStdout) fromStdin)++q' :: IO a -> IO (Either () a)+q' f = C.race (cancelQ fromStdin) f++cancelQ :: Emitter IO Text -> IO ()+cancelQ e = do+  e' <- emit e+  case e' of+    Just "q" -> pure ()+    _notQ -> do+      putStrLn "nothing happens"+      cancelQ e++-- | test of clientApp via a cRef committer and a canned list of Text+tClient :: [Text] -> IO [Either Text Text]+tClient xs = do+  (c, r) <- refCommitter+  runClient+    defaultSocketConfig+    ( \conn ->+        (\b -> clientApp b conn)+          <$|> ( Box c+                   <$> qList (xs <> ["q"])+               )+    )+  r++tClientIO :: [Text] -> IO ()+tClientIO xs =+  (runClient defaultSocketConfig . clientApp)+    <$|> (Box (contramap (pack . show) toStdout) <$> qList (xs <> ["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 = do+  a <- C.async (runServer defaultSocketConfig (responderApp (\x -> bool (Right $ "echo:" <> x) (Left "quit") (x == "q"))))+  sleep 0.1+  r <- tClient (pack . show <$> [1 .. 3 :: Int])+  C.cancel a+  pure r
src/Box/TCP.hs view
@@ -23,12 +23,12 @@   ) where -import Box+import Box hiding (close) import Control.Concurrent.Async-import Control.Lens import Control.Monad import Data.ByteString (ByteString) import Data.Functor+import Data.Functor.Contravariant import Data.Text (Text, unpack) import Data.Text.Encoding import GHC.Generics@@ -101,8 +101,7 @@  -- | Response function. responder :: (ByteString -> IO ByteString) -> Box IO ByteString ByteString -> IO ()-responder f (Box c e) =-  glue c (mapE (fmap Just . f) e)+responder f = fuse (fmap Just . f)  -- | A server that explicitly responds to client messages. tcpResponder :: TCPConfig -> (ByteString -> IO ByteString) -> IO ()@@ -157,4 +156,4 @@ testServerSender :: IO () testServerSender =   testHarness $-    tcpSender defaultTCPConfig <$.> fromListE ["hi!"]+    tcpSender defaultTCPConfig <$|> qList ["hi!"]