box-socket 0.1.2 → 0.2.0
raw patch · 5 files changed
+92/−113 lines, 5 filesdep +asyncdep +textdep −doctestdep −numhaskdep ~basedep ~boxdep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependencies added: async, text
Dependencies removed: doctest, numhask
Dependency ranges changed: base, box, bytestring, concurrency, exceptions, generic-lens, lens, network, network-simple, optparse-generic, websockets
API changes (from Hackage documentation)
Files
- app/box-socket.hs +30/−28
- box-socket.cabal +44/−62
- src/Box/Socket.hs +9/−5
- src/Box/TCP.hs +9/−4
- test/test.hs +0/−14
app/box-socket.hs view
@@ -1,11 +1,8 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wall #-}@@ -21,11 +18,12 @@ import Box import Box.Socket-import Control.Lens hiding (Wrapped, Unwrapped)+import Control.Concurrent.Classy.Async as C+import Control.Lens hiding (Unwrapped, Wrapped)+import Data.Bool import Data.Generics.Labels ()-import NumHask.Prelude hiding (STM, bracket)+import Data.Text (pack) import Options.Generic-import Control.Concurrent.Classy.Async as C data SocketType = Client | Responder | TestRun deriving (Eq, Read, Show, Generic) @@ -35,10 +33,9 @@ instance ParseFields SocketType -data Opts w- = Opts- { apptype :: w ::: SocketType <?> "type of websocket app"- }+newtype Opts w = Opts+ { apptype :: w ::: SocketType <?> "type of websocket app"+ } deriving (Generic) instance ParseRecord (Opts Wrapped)@@ -46,21 +43,24 @@ main :: IO () main = do o :: Opts Unwrapped <- unwrapRecord "example websocket apps"- r :: Text <- case apptype o of+ r :: String <- case apptype o of Client -> show <$> clientIO 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")))+serverIO =+ runServer+ defaultSocketConfig+ (responderApp (\x -> bool (Right $ "echo:" <> x) (Left "quit") (x == "q"))) clientIO :: IO () clientIO = (runClient defaultSocketConfig . clientApp)- (Box (contramap show toStdout) fromStdin)+ (Box (contramap (pack . show) toStdout) fromStdin) q' :: IO a -> IO (Either () a) q' f = C.race (cancelQ fromStdin) f@@ -70,25 +70,28 @@ e' <- emit e case e' of Just "q" -> pure ()- _ -> do- putStrLn ("nothing happens" :: Text)+ _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"])))+ (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 show toStdout) <$> (fromListE (xs <> ["q"])))+ (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.@@ -96,9 +99,8 @@ -- [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"))))+ a <- C.async (runServer defaultSocketConfig (responderApp (\x -> bool (Right $ "echo:" <> x) (Left "quit") (x == "q")))) sleep 0.1- r <- tClient (show <$> [1..3::Int])+ r <- tClient (pack . show <$> [1 .. 3 :: Int]) C.cancel a pure r-
box-socket.cabal view
@@ -1,80 +1,62 @@ cabal-version: 2.4 name: box-socket-version: 0.1.2-synopsis: Box websockets-description: Websockets built with the box library.-category: project-author: Tony Day-maintainer: tonyday567@gmail.com-copyright: Tony Day (c) AfterTimes-license: BSD-3-Clause-homepage: https://github.com/tonyday567/box-socket#readme-bug-reports: https://github.com/tonyday567/box-socket/issues-build-type: Simple+version: 0.2.0+synopsis: Box websockets+description: Websockets built with the box library.+category: project+author: Tony Day+maintainer: tonyday567@gmail.com+copyright: Tony Day (c) AfterTimes+license: BSD-3-Clause+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+ source-repository head- type: git+ type: git location: https://github.com/tonyday567/box-socket library exposed-modules: Box.Socket Box.TCP- hs-source-dirs:- src++ hs-source-dirs: src build-depends:- base >= 4.12 && <5,- box >= 0.6 && < 0.7,- bytestring >= 0.10 && < 0.11,- concurrency >= 1.11 && < 1.12,- exceptions >= 0.10 && < 0.11,- generic-lens >= 1.1.0 && < 3.0,- lens >= 4.17.1 && < 4.20,- network >= 3.1 && < 3.2,- network-simple >= 0.4 && < 0.5,- numhask >= 0.7 && < 0.8,- websockets >= 0.12 && < 0.13,+ , async ^>=2.2.3+ , base >=4.12 && <5+ , box ^>=0.7+ , bytestring ^>=0.10+ , concurrency ^>=1.11+ , exceptions ^>=0.10+ , generic-lens ^>=2.2+ , lens ^>=5.0+ , network ^>=3.1+ , network-simple ^>=0.4+ , text ^>=1.2.4+ , websockets ^>=0.12+ default-language: Haskell2010 ghc-options:- -Wall- -Wcompat- -Wincomplete-record-updates- -Wincomplete-uni-patterns- -Wredundant-constraints+ -Wall -Wcompat -Wincomplete-record-updates+ -Wincomplete-uni-patterns -Wredundant-constraints -fwrite-ide-info+ -hiedir=.hie -Wunused-packages executable box-socket- main-is: box-socket.hs- hs-source-dirs: app+ main-is: box-socket.hs+ hs-source-dirs: app build-depends:- base >= 4.7 && < 5,- box >= 0.6 && < 0.7,- box-socket,- concurrency >= 1.11 && < 1.12,- generic-lens >= 2.0 && < 3,- lens >= 4.19 && < 4.20,- numhask >= 0.7 && < 0.8,- optparse-generic >= 1.3 && < 1.4,- default-language: Haskell2010- ghc-options:- -funbox-strict-fields- -fforce-recomp- -threaded- -rtsopts- -with-rtsopts=-N+ , base >=4.7 && <5+ , box ^>=0.7+ , box-socket+ , concurrency ^>=1.11+ , generic-lens ^>=2.2+ , lens ^>=5.0+ , optparse-generic ^>=1.3+ , text ^>=1.2.4 -test-suite test- type: exitcode-stdio-1.0- main-is: test.hs- hs-source-dirs:- test- build-depends:- base >=4.7 && <5,- box-socket,- doctest >= 0.16 && < 0.18,- numhask >= 0.7 && < 0.8, default-language: Haskell2010 ghc-options:- -Wall- -Wcompat- -Wincomplete-record-updates- -Wincomplete-uni-patterns- -Wredundant-constraints+ -funbox-strict-fields -fforce-recomp -threaded -rtsopts+ -with-rtsopts=-N -fwrite-ide-info -hiedir=.hie -Wunused-packages
src/Box/Socket.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE StrictData #-} {-# OPTIONS_GHC -Wall #-} -- | Websocket components built with 'Box'es.@@ -24,11 +24,15 @@ 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-import NumHask.Prelude hiding (bracket) -- | Socket configuration --@@ -61,7 +65,7 @@ (\conn -> liftIO $ WS.sendClose conn ("Bye from connect!" :: Text)) ( \conn -> C.withAsync- (liftIO $ forever $ WS.sendPing conn ("ping" :: ByteString) >> sleep 30)+ (liftIO $ forever $ WS.sendPing conn ("ping" :: BS.ByteString) >> sleep 30) (\_ -> action conn) ) @@ -116,7 +120,7 @@ commit c ( Left- ( "receiver: received: close: " <> show w <> " " <> show b+ ( "receiver: received: close: " <> (pack . show) w <> " " <> (pack . show) b ) ) WS.ControlMessage _ -> go@@ -151,7 +155,7 @@ case msg of Nothing -> pure () Just msg' -> do- _ <- commit c $ "sender: sending: " <> (show msg' :: Text)+ _ <- commit c $ "sender: sending: " <> ((pack . show) msg' :: Text) liftIO $ WS.sendTextData conn msg' -- | A receiver that responds based on received Text.
src/Box/TCP.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE StrictData #-} {-# OPTIONS_GHC -Wall #-} -- | TCP Boxes.@@ -25,9 +24,15 @@ where import Box+import Control.Concurrent.Async import Control.Lens+import Control.Monad+import Data.ByteString (ByteString)+import Data.Functor+import Data.Text (Text, unpack)+import Data.Text.Encoding+import GHC.Generics import Network.Simple.TCP-import NumHask.Prelude hiding (check, handle) -- | TCP configuration --@@ -141,7 +146,7 @@ e' <- emit e case e' of Just "q" -> pure ()- Just x -> putStrLn ("badly handled: " <> x)+ Just x -> putStrLn ("badly handled: " <> unpack x) Nothing -> pure () -- | @"echo: " <>@ Responder
− test/test.hs
@@ -1,14 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# OPTIONS_GHC -Wall #-}--module Main where--import NumHask.Prelude-import Test.DocTest--main :: IO ()-main = doctest- [ "app/box-socket.hs",- "src/Box/Socket.hs",- "src/Box/TCP.hs"- ]