Z-IO 0.1.8.1 → 0.1.9.0

raw patch · 24 files changed

+577/−311 lines, 24 filesdep +containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: containers

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• README.md +2/−3
• Z-IO.cabal +3/−2
• Z/IO/BIO.hs +69/−11
• Z/IO/BIO/Zlib.hsc +3/−2
• Z/IO/Buffered.hs +34/−62
• Z/IO/FileSystem.hs +34/−7
• Z/IO/FileSystem/Threaded.hs +32/−10
• Z/IO/Network/DNS.hsc +10/−5
• Z/IO/Network/IPC.hs +7/−2
• Z/IO/Network/SocketAddr.hsc +221/−117
• Z/IO/Network/TCP.hs +9/−4
• Z/IO/Network/UDP.hs +22/−14
• Z/IO/StdStream.hs +19/−5
• Z/IO/UV/FFI.hsc +16/−0
• Z/IO/UV/Manager.hs +23/−21
• Z/IO/UV/UVStream.hs +19/−15
• cbits/hs_uv_file.c +13/−0
• include/hs_uv.h +4/−0
• test/Z/IO/BIO/ConcurrentSpec.hs +3/−3
• test/Z/IO/LowResTimerSpec.hs +1/−1
• test/Z/IO/Network/TCPSpec.hs +3/−3
• test/Z/IO/Network/UDPSpec.hs +5/−5
• test/Z/IO/ResourceSpec.hs +16/−19

@@ -1,5 +1,14 @@ # Revision history for Z-IO +## 0.1.9.0  -- 2020-10-24++* Clean up API in `Z.IO.Buffered`, remove `readToMagic'`, `readLine'`, `readExactly'`.+* `readExactly` now throw exception when not reading enough bytes before EOF.+* Add `Show/ShowT` instance to `UVStream`, `StdStream`, `UDP`, `UVManager`.+* Add JSON instance to various types: `SocketAddr` and all configure types.+* Rename `InetAddr` to `IPv4`, `Inet6Addr` to `IPv6`, change `SocketAddr` 's constructor name, and payload order.+* Add `seek` to `Z.IO.FileSystem`.+ ## 0.1.8.1  -- 2020-10-24  * Export `ZStream` type from `Z.IO.BIO.Zlib`

@@ -33,8 +33,7 @@ > import qualified Z.Data.Text as T > -- send a simple HTTP request > :{-let addr = SocketAddrInet 80 (tupleToInetAddr (13,107,21,200))--- addr = ipv4 "13.107.21.200" 80+let addr = ipv4 "13.107.21.200" 80 in withResource (initTCPClient defaultTCPClientConfig{ tcpRemoteAddr = addr}) $ \ tcp -> do     i <- newBufferedInput tcp      o <- newBufferedOutput tcp@@ -47,7 +46,7 @@ > -- Start a TCP echo server, use @nc -v localhost 8080@ to test > :{ startTCPServer defaultTCPServerConfig{ -    tcpListenAddr = SocketAddrInet 8080 inetLoopback} $ \ tcp -> do+    tcpListenAddr = SocketAddrIPv4 ipv4Loopback 8080} $ \ tcp -> do         i <- newBufferedInput tcp          o <- newBufferedOutput tcp         forever $ readBuffer i >>= writeBuffer o >> flushBuffer o

@@ -1,6 +1,6 @@ cabal-version:              2.4 name:                       Z-IO-version:                    0.1.8.1+version:                    0.1.9.0 synopsis:                   Simple and high performance IO toolkit for Haskell description:                Simple and high performance IO toolkit for Haskell, including                             file system, network, ipc and more!@@ -127,6 +127,7 @@                           , time                    >= 1.8 && < 2.0                           , unix-time               >= 0.4.7 && < 0.5                           , unordered-containers    == 0.2.*+                          , containers              == 0.6.*                           , Z-Data                  >= 0.1.9.1 && < 0.2.0      default-language:       Haskell2010@@ -184,7 +185,7 @@                             zconf.h                             hs_cwalk.h -    cc-options:             -march=native+    cc-options:             -march=native -D_FILE_OFFSET_BITS=64     c-sources:              cbits/hs_uv_base.c                             cbits/hs_uv_dns.c                             cbits/hs_uv_file.c

@@ -48,7 +48,7 @@   -- * The BIO type     BIO(..), Source, Sink   , (>|>), (>~>), (>!>), appendSource-  , concatSource, zipSource+  , concatSource, zipSource, zipBIO   , joinSink, fuseSink   , pureBIO, ioBIO   , ParseException(..)@@ -90,6 +90,8 @@ import           Data.Void import           Data.Word import           Data.Bits             ((.|.))+import qualified Data.Sequence         as Seq+import           Data.Sequence         (Seq(..)) import           System.IO.Unsafe      (unsafePerformIO) import qualified Z.Data.Array          as A import qualified Z.Data.Builder        as B@@ -134,7 +136,7 @@ --   * You shouldn't use a 'BIO' node across multiple 'BIO' chain unless the state can be reset. --   * You shouldn't use a 'BIO' node across multiple threads unless document states otherwise. ----- Note 'BIO' is just a convenient way to construct single-thread streaming computation, to use 'BIO'+-- 'BIO' is simply a convenient way to construct single-thread streaming computation, to use 'BIO' -- in multiple threads, check "Z.IO.BIO.Concurrent" module. -- data BIO inp out = BIO@@ -257,13 +259,68 @@   -- | Zip two 'BIO' source into one, reach EOF when either one reached EOF.-zipSource :: Source a -> Source b -> Source (a,b)+zipSource :: Source a -> Source b -> IO (Source (a,b)) {-# INLINABLE zipSource #-}-zipSource (BIO _ pullA) (BIO _ pullB) = BIO { pull = do-    mA <- pullA-    mB <- pullB-    return ((,) <$> mA <*> mB)}+zipSource (BIO _ pullA) (BIO _ pullB) = do+    finRef <- newIORef False+    return $ BIO { pull = do+        fin <- readIORef finRef+        if fin+        then return Nothing+        else do+            mA <- pullA+            mB <- pullB+            let r = (,) <$> mA <*> mB+            case r of+                Just _ -> return r+                _ -> writeIORef finRef True >> return Nothing+            } +-- | Zip two 'BIO' node into one, reach EOF when either one reached EOF.+--+-- The output item number should match, unmatched output will be discarded.+zipBIO :: BIO a b -> BIO a c -> IO (BIO a (b, c))+{-# INLINABLE zipBIO #-}+zipBIO (BIO pushA pullA) (BIO pushB pullB) = do+    finRef <- newIORef False+    aSeqRef <- newIORef Seq.Empty+    bSeqRef <- newIORef Seq.Empty+    return (BIO (push_ aSeqRef bSeqRef) (pull_ finRef aSeqRef bSeqRef))+  where+    push_ aSeqRef bSeqRef x = do+        ma <- pushA x+        mb <- pushB x+        forM_ ma (\ a -> modifyIORef' aSeqRef (a :<|))+        forM_ mb (\ b -> modifyIORef' bSeqRef (b :<|))+        aSeq <- readIORef aSeqRef+        bSeq <- readIORef bSeqRef+        case aSeq of+            (!as :|> a) -> case bSeq of+                (!bs :|> b) -> do+                    writeIORef aSeqRef as+                    writeIORef bSeqRef bs+                    return (Just (a, b))+                _ -> return Nothing+            _ -> return Nothing++    pull_ finRef aSeqRef bSeqRef = do+        fin <- readIORef finRef+        if fin+        then return Nothing+        else do+            aSeq <- readIORef aSeqRef+            bSeq <- readIORef bSeqRef+            ma <- case aSeq of (_ :|> a) -> return (Just a)+                               _ -> pullA+            mb <- case bSeq of (_ :|> b) -> return (Just b)+                               _ -> pullB+            case ma of+                Just a -> case mb of+                    Just b -> return (Just (a, b))+                    _ -> writeIORef finRef True >> return Nothing+                _ -> writeIORef finRef True >> return Nothing++ -- | Run a 'BIO' loop (source >|> ... >|> sink). runBIO :: BIO Void Void -> IO () {-# INLINABLE runBIO #-}@@ -648,13 +705,14 @@   where     push_ trailingRef bs = do         trailing <- readIORef trailingRef-        let chunk =  trailing `V.append` bs-        case V.elemIndex magic chunk of+        case V.elemIndex magic bs of             Just i -> do-                let (line, rest) = V.splitAt (i+1) chunk+                let (!line, !rest) = V.splitAt (i+1) bs+                    !line' = trailing `V.append` line                 writeIORef trailingRef rest-                return (Just line)+                return (Just line')             Nothing -> do+                let !chunk =  trailing `V.append` bs                 writeIORef trailingRef chunk                 return Nothing 

@@ -57,6 +57,7 @@ import           Z.Data.CBytes      as CBytes import           Z.Data.Vector.Base as V import           Z.Data.Text.ShowT  (ShowT)+import           Z.Data.JSON        (EncodeJSON, ToValue, FromValue) import           Z.Foreign import           Z.IO.BIO import           Z.IO.Exception@@ -110,7 +111,7 @@     , compressStrategy :: Strategy     , compressBufferSize :: Int     }   deriving (Show, Eq, Ord, Generic)-        deriving anyclass ShowT+        deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)  defaultCompressConfig :: CompressConfig defaultCompressConfig =@@ -204,7 +205,7 @@     , decompressDictionary :: V.Bytes     , decompressBufferSize :: Int     }   deriving (Show, Eq, Ord, Generic)-        deriving anyclass ShowT+        deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)  defaultDecompressConfig :: DecompressConfig defaultDecompressConfig = DecompressConfig defaultWindowBits V.empty V.defaultChunkSize

@@ -22,9 +22,9 @@   , readBuffer, readBufferText   , unReadBuffer   , readParser-  , readExactly,  readExactly'-  , readToMagic, readToMagic'-  , readLine, readLine'+  , readExactly+  , readToMagic+  , readLine   , readAll, readAll'     -- * Buffered Output   , BufferedOutput, bufOutput@@ -166,7 +166,8 @@  -- | Request UTF8 'T.Text' chunk from 'BufferedInput'. ----- The buffer size must be larger than 4 bytes to guarantee decoding progress.+-- The buffer size must be larger than 4 bytes to guarantee decoding progress. If there're+-- trailing bytes before EOF, 'IncompleteInput' are thrown. readBufferText :: HasCallStack => BufferedInput -> IO T.Text readBufferText BufferedInput{..} = do     pb <- readIORef bufPushBack@@ -224,8 +225,7 @@  -- | Read N bytes(may be smaller than N if EOF reached). ----- If EOF reached before N bytes read, trailing bytes will be returned.---+-- If EOF reached before N bytes read, a 'IncompleteInput' will be thrown readExactly :: HasCallStack => Int -> BufferedInput -> IO V.Bytes readExactly n0 h0 = V.concat `fmap` (go h0 n0)   where@@ -234,28 +234,17 @@         let l = V.length chunk         if l > n         then do-            let (lastChunk, rest) = V.splitAt n chunk+            let (chunk', rest) = V.splitAt n chunk             unReadBuffer rest h-            return [lastChunk]+            return [chunk']         else if l == n             then return [chunk]             else if l == 0-                then return [chunk]+                then throwIO (IncompleteInput callStack)                 else do                     chunks <- go h (n - l)                     return (chunk : chunks) --- | Read exactly N bytes------ If EOF reached before N bytes read, a 'IncompleteInput' will be thrown----readExactly' :: HasCallStack => Int -> BufferedInput -> IO V.Bytes-readExactly' n h = do-    v <- readExactly n h-    if (V.length v /= n)-    then throwIO (IncompleteInput callStack)-    else return v- -- | Read all chunks from a 'BufferedInput'. -- -- This function will loop read until meet EOF('Input' device return 'V.empty'),@@ -303,11 +292,19 @@     unReadBuffer rest i     return r --- | Read until reach a magic bytes, return bytes(including the magic bytes)------ If EOF is reached before meet a magic byte, partial bytes are returned.+{-| Read until reach a magic bytes, return bytes(including the magic bytes).++Empty bytes indicate EOF. if EOF is reached before meet a magic byte, partial bytes are returned.++@+ \/----- readToMagic ----- \\ \/----- readToMagic -----\\ ...++------------------+-------+-----------------+-------++|       ...        | magic |       ...       | magic | ...++------------------+-------+-----------------+-------++@+-} readToMagic :: HasCallStack => Word8 -> BufferedInput -> IO V.Bytes-readToMagic magic0 h0 = V.concat `fmap` (go h0 magic0)+readToMagic magic0 h0 = V.concat <$> go h0 magic0   where     go h magic = do         chunk <- readBuffer h@@ -315,53 +312,28 @@         then return []         else case V.elemIndex magic chunk of             Just i -> do-                let (lastChunk, rest) = V.splitAt (i+1) chunk+                let (chunk', rest) = V.splitAt (i+1) chunk                 unReadBuffer rest h-                return [lastChunk]+                return [chunk']             Nothing -> do                 chunks <- go h magic                 return (chunk : chunks) --- | Read until reach a magic bytes, return bytes(including the magic bytes)------ If EOF is reached before meet a magic byte, a 'IncompleteInput' will be thrown.-readToMagic' :: HasCallStack => Word8 -> BufferedInput -> IO V.Bytes-readToMagic' magic0 h0 = V.concat `fmap` (go h0 magic0)-  where-    go h magic = do-        chunk <- readBuffer h-        if V.null chunk-        then throwIO (IncompleteInput callStack)-        else case V.elemIndex magic chunk of-            Just i -> do-                let (lastChunk, rest) = V.splitAt (i+1) chunk-                unReadBuffer rest h-                return [lastChunk]-            Nothing -> do-                chunks <- go h magic-                return (chunk : chunks)+{-| Read to a linefeed ('\n' or '\r\n'), return 'Bytes' before it. --- | Read to a linefeed ('\n' or '\r\n'), return 'Bytes' before it.------ Return bytes don't include linefeed, empty bytes indicate empty line, 'Nothing' indicate EOF.--- If EOF is reached before meet a line feed, partial line is returned.+Return bytes don't include linefeed, empty bytes indicate empty line, 'Nothing' indicate EOF.+If EOF is reached before meet a line feed, partial line is returned.++@+ \/--- readLine ---\\ discarded \/--- readLine ---\\ discarded \/ ...++------------------+---------+------------------+---------++|      ...         | \\r\\n\/\\n |       ...        | \\r\\n\/\\n | ...++------------------+---------+------------------+---------++@+-} readLine :: HasCallStack => BufferedInput -> IO (Maybe V.Bytes) readLine i = do     bs@(V.PrimVector arr s l) <- readToMagic 10 i-    if l == 0-    then return Nothing-    else return $ case bs `V.indexMaybe` (l-2) of-        Nothing -> Just (V.PrimVector arr s (l-1))-        Just r | r == 13   -> Just (V.PrimVector arr s (l-2))-               | otherwise -> Just (V.PrimVector arr s (l-1))---- | Read to a linefeed ('\n' or '\r\n'), return 'Bytes' before it.------ Return bytes don't include linefeed, empty bytes indicate empty line, 'Nothing' indicate EOF.--- If EOF reached before meet a line feed, a 'IncompleteInput' will be thrown.-readLine' :: HasCallStack => BufferedInput -> IO (Maybe V.Bytes)-readLine' i = do-    bs@(V.PrimVector arr s l) <- readToMagic' 10 i     if l == 0     then return Nothing     else return $ case bs `V.indexMaybe` (l-2) of

@@ -13,10 +13,10 @@  module Z.IO.FileSystem   ( -- * regular file devices-    File, initFile, readFile, writeFile, getFileFD+    File, initFile, readFile, writeFile, getFileFD, seek   , quickReadFile, quickReadTextFile, quickWriteFile, quickWriteTextFile     -- * file offset bundle-  , FilePtr, newFilePtr, getFileOffset, setFileOffset+  , FilePtr, newFilePtr, getFilePtrOffset, setFilePtrOffset   -- * filesystem operations   , mkdir, mkdirp   , unlink@@ -95,6 +95,11 @@   , pattern SYMLINK_DEFAULT   , pattern SYMLINK_DIR   , pattern SYMLINK_JUNCTION+  -- ** Whence+  , Whence+  , pattern SEEK_SET+  , pattern SEEK_CUR+  , pattern SEEK_END   ) where  import           Control.Monad@@ -108,6 +113,7 @@ import           Z.Data.CBytes                  as CBytes import           Z.Data.PrimRef.PrimIORef import qualified Z.Data.Text                    as T+import qualified Z.Data.Text.ShowT              as T import qualified Z.Data.Vector                  as V import           Z.Foreign import           Z.IO.Buffered@@ -129,6 +135,11 @@ data File =  File  {-# UNPACK #-} !FD      -- ^ the file                    {-# UNPACK #-} !(IORef Bool)  -- ^ closed flag +instance Show File where show = T.toString++instance T.ShowT File where+    toUTF8BuilderP _ (File fd _) = "File " >> T.int fd+ -- | Return File fd. getFileFD :: File -> IO FD getFileFD (File fd closedRef) = do@@ -141,6 +152,12 @@     closed <- readIORef closedRef     if closed then throwECLOSED else f fd +-- | Set file's system offset.+--+-- Equivalent to <https://linux.die.net/man/3/lseek64 lseek64(3)>.+seek :: HasCallStack => File -> Int64 -> Whence -> IO Int64+seek uvf off w = checkFileClosed uvf $ \ fd -> throwUVIfMinus $ hs_seek fd off w+ instance Input File where     -- readInput :: HasCallStack => File -> Ptr Word8 -> Int -> IO Int     -- use -1 offset to use fd's default offset@@ -164,6 +181,15 @@ -- | Write buffer to file -- -- This function will loop until all bytes are written.+--+-- Note on linux files opened with 'O_APPEND' behave differently since this function use @pwrite@:+--+-- @+-- POSIX requires that opening a file with the O_APPEND flag should have no effect+-- on the location at which pwrite() writes data. However, on Linux,+-- if a file is opened with O_APPEND, pwrite() appends data to the end of the file,+-- regardless of the value of offset.+-- @ writeFile :: HasCallStack             => File             -> Ptr Word8 -- ^ buffer@@ -191,6 +217,7 @@ -- Reading or writing using 'Input' \/ 'Output' instance will automatically increase offset. -- 'FilePtr' and its operations are NOT thread safe, use 'MVar' 'FilePtr' in multiple threads. --+-- The notes on linux 'writeFile' applied to 'FilePtr' too. data FilePtr = FilePtr {-# UNPACK #-} !File                        {-# UNPACK #-} !(PrimIORef Int64) @@ -202,12 +229,12 @@ newFilePtr uvf off = FilePtr uvf <$> newPrimIORef off  -- | Get current offset.-getFileOffset :: FilePtr -> IO Int64-getFileOffset (FilePtr _ offsetRef) = readPrimIORef offsetRef+getFilePtrOffset :: FilePtr -> IO Int64+getFilePtrOffset (FilePtr _ offsetRef) = readPrimIORef offsetRef  -- | Change current offset.-setFileOffset :: FilePtr -> Int64 -> IO ()-setFileOffset (FilePtr _ offsetRef) = writePrimIORef offsetRef+setFilePtrOffset :: FilePtr -> Int64 -> IO ()+setFilePtrOffset (FilePtr _ offsetRef) = writePrimIORef offsetRef  instance Input FilePtr where     readInput (FilePtr file offsetRef) buf bufSiz =@@ -364,7 +391,7 @@ -- @ --  import Z.IO.FileSystem.FilePath (splitExtension) --  -- find all haskell source file within current dir---  scandirRecursively "."  (\ p _ -> (== ".hs") . snd <$> splitExtension p)+--  scandirRecursively "."  (\\ p _ -> (== ".hs") . snd \<$\> splitExtension p) -- @ scandirRecursively :: HasCallStack => CBytes -> (CBytes -> DirEntType -> IO Bool) -> IO [CBytes] scandirRecursively dir p = loop [] =<< P.normalize dir

@@ -7,7 +7,7 @@ Stability   : experimental Portability : non-portable -This module provides filesystem API exactly same with `Z.IO.FileSystem`, operations are implemented using libuv's threadpool to achieve non-block behavior (non-block here meaning won't block other haskell threads), which would be prefered when the operations' estimated time is long(>1ms) or running with a non-threaded haskell runtime, such as accessing network filesystem or scan a very large directory. Otherwise you may block RTS's capability thus all the other haskell threads live on it.+This module provides filesystem API exactly same with `Z.IO.FileSystem`, operations(except 'seek') are implemented using libuv's threadpool to achieve non-block behavior (non-block here meaning won't block other haskell threads), which would be prefered when the operations' estimated time is long(>1ms) or running with a non-threaded haskell runtime, such as accessing network filesystem or scan a very large directory. Otherwise you may block RTS's capability thus all the other haskell threads live on it.  The threadpool version operations have overheads similar to safe FFI, but provide same adventages: @@ -21,10 +21,10 @@  module Z.IO.FileSystem.Threaded   ( -- * regular file devices-    File, initFile, readFile, writeFile, getFileFD+    File, initFile, readFile, writeFile, getFileFD, seek   , quickReadFile, quickReadTextFile, quickWriteFile, quickWriteTextFile     -- * file offset bundle-  , FilePtrT, newFilePtrT, getFileOffset, setFileOffset+  , FilePtrT, newFilePtrT, getFilePtrOffset, setFilePtrOffset   -- * filesystem operations   , mkdir, mkdirp   , unlink@@ -116,6 +116,7 @@ import           Z.Data.CBytes                  as CBytes import           Z.Data.PrimRef.PrimIORef import qualified Z.Data.Text                    as T+import qualified Z.Data.Text.ShowT              as T import qualified Z.Data.Vector                  as V import           Z.Foreign import           Z.IO.Buffered@@ -124,7 +125,7 @@ import           Z.IO.Resource import           Z.IO.UV.FFI import           Z.IO.UV.Manager-import           Prelude hiding (writeFile, readFile)+import           Prelude hiding                 (writeFile, readFile)  -------------------------------------------------------------------------------- -- File@@ -138,9 +139,14 @@ -- Implict offset interface is provided by 'Input' \/ 'Output' instances. -- Explict offset interface is provided by 'readFile' \/ 'writeFile'. ---data File =  File  {-# UNPACK #-} !FD      -- ^ the file-                     {-# UNPACK #-} !(IORef Bool)  -- ^ closed flag+data File = File {-# UNPACK #-} !FD      -- ^ the file+                 {-# UNPACK #-} !(IORef Bool)  -- ^ closed flag +instance Show File where show = T.toString++instance T.ShowT File where+    toUTF8BuilderP _ (File fd _) = "File " >> T.int fd+ -- | Return File fd. getFileFD :: File -> IO FD getFileFD (File fd closedRef) = do@@ -153,6 +159,12 @@     closed <- readIORef closedRef     if closed then throwECLOSED else f fd +-- | Set file's system offset.+--+-- Equivalent to <https://linux.die.net/man/3/lseek64 lseek64(3)>.+seek :: HasCallStack => File -> Int64 -> Whence -> IO Int64+seek uvf off w = checkFileClosed uvf $ \ fd -> throwUVIfMinus $ hs_seek fd off w+ instance Input File where     readInput f buf bufSiz = readFile f buf bufSiz (-1) @@ -176,6 +188,15 @@ -- | Write buffer to file -- -- This function will loop until all bytes are written.+--+-- Note on linux files opened with 'O_APPEND' behave differently since this function use @pwrite@:+--+-- @+-- POSIX requires that opening a file with the O_APPEND flag should have no effect+-- on the location at which pwrite() writes data. However, on Linux,+-- if a file is opened with O_APPEND, pwrite() appends data to the end of the file,+-- regardless of the value of offset.+-- @ writeFile :: HasCallStack            => File            -> Ptr Word8 -- ^ buffer@@ -209,6 +230,7 @@ -- Reading or writing using 'Input' \/ 'Output' instance will automatically increase offset. -- 'FilePtrT' and its operations are NOT thread safe, use 'MVar' 'FilePtrT' in multiple threads. --+-- The notes on linux 'writeFile' applied to 'FilePtr' too. data FilePtrT = FilePtrT {-# UNPACK #-} !File                          {-# UNPACK #-} !(PrimIORef Int64) @@ -220,12 +242,12 @@ newFilePtrT uvf off = FilePtrT uvf <$> newPrimIORef off  -- | Get current offset.-getFileOffset :: FilePtrT -> IO Int64-getFileOffset (FilePtrT _ offsetRef) = readPrimIORef offsetRef+getFilePtrOffset :: FilePtrT -> IO Int64+getFilePtrOffset (FilePtrT _ offsetRef) = readPrimIORef offsetRef  -- | Change current offset.-setFileOffset :: FilePtrT -> Int64 -> IO ()-setFileOffset (FilePtrT _ offsetRef) = writePrimIORef offsetRef+setFilePtrOffset :: FilePtrT -> Int64 -> IO ()+setFilePtrOffset (FilePtrT _ offsetRef) = writePrimIORef offsetRef  instance Input FilePtrT where     readInput (FilePtrT file offsetRef) buf bufSiz =

@@ -23,13 +23,16 @@   ) where  import           Data.Bits-import           Data.List as List+import           Data.List                  as List import           Data.Word import           Foreign.C.Types import           Foreign.Marshal.Utils import           Foreign.Ptr import           Foreign.Storable -import           Z.Data.CBytes  as CBytes+import           GHC.Generics+import           Z.Data.CBytes              as CBytes+import           Z.Data.Text.ShowT          (ShowT(..))+import           Z.Data.JSON                (EncodeJSON, ToValue, FromValue) import           Z.Foreign import           Z.IO.Exception import           Z.IO.Network.SocketAddr@@ -82,7 +85,8 @@     --   addresses are found, IPv6-mapped IPv4 addresses will be     --   returned. (Only some platforms support this.)     | AI_V4MAPPED-    deriving (Eq, Read, Show)+    deriving (Eq, Ord, Read, Show, Generic)+    deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)  addrInfoFlagMapping :: [(AddrInfoFlag, CInt)] addrInfoFlagMapping =@@ -124,7 +128,8 @@   , addrProtocol :: ProtocolNumber   , addrAddress :: SocketAddr   , addrCanonName :: CBytes-  } deriving (Eq, Show)+  } deriving (Eq, Ord, Show, Generic)+    deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)   instance Storable AddrInfo where@@ -209,7 +214,7 @@   , addrFamily     = AF_UNSPEC   , addrSocketType = SOCK_ANY   , addrProtocol   = IPPROTO_DEFAULT-  , addrAddress    = SocketAddrInet portAny inetAny+  , addrAddress    = SocketAddrIPv4 ipv4Any portAny   , addrCanonName  = empty   } 

@@ -37,7 +37,10 @@ import           Control.Monad.IO.Class import           Data.Primitive.PrimArray import           Foreign.Ptr+import           GHC.Generics import           Z.Data.CBytes+import           Z.Data.Text.ShowT   (ShowT(..))+import           Z.Data.JSON         (EncodeJSON, ToValue, FromValue) import           Z.IO.Exception import           Z.IO.Resource import           Z.IO.UV.FFI@@ -53,7 +56,8 @@     { ipcClientName :: Maybe CBytes -- ^ bind to a local file path (Unix) or name (Windows),                                     -- won't bind if set to 'Nothing'.     , ipcTargetName :: CBytes       -- ^ target path (Unix) or a name (Windows).-    }+    } deriving (Eq, Ord, Show, Read, Generic)+      deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)  -- | Default config, connect to ".\/ipc". --@@ -83,7 +87,8 @@ data IPCServerConfig = IPCServerConfig     { ipcListenName       :: CBytes      -- ^ listening path (Unix) or a name (Windows).     , ipcListenBacklog    :: Int           -- ^ listening pipe's backlog size, should be large enough(>128)-    }+    } deriving (Eq, Ord, Show, Read, Generic)+      deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)  -- | A default hello world server on @.\/ipc@ --

@@ -23,22 +23,22 @@   , withSocketAddrStorageUnsafe   , sizeOfSocketAddrStorage    -- ** IPv4 address-  , InetAddr(..)-  , inetAny-  , inetBroadcast-  , inetNone-  , inetLoopback-  , inetUnspecificGroup-  , inetAllHostsGroup-  , inetMaxLocalGroup-  , inetAddrToTuple-  , tupleToInetAddr+  , IPv4(..)+  , ipv4Any+  , ipv4Broadcast+  , ipv4None+  , ipv4Loopback+  , ipv4UnspecificGroup+  , ipv4AllHostsGroup+  , ipv4MaxLocalGroup+  , ipv4AddrToTuple+  , tupleToIPv4Addr    -- ** IPv6 address-  , Inet6Addr(..)-  , inet6Any-  , inet6Loopback-  , inet6AddrToTuple-  , tupleToInet6Addr+  , IPv6(..)+  , ipv6Any+  , ipv6Loopback+  , ipv6AddrToTuple+  , tupleToIPv6Addr   , FlowInfo   , ScopeID   -- * port numbber@@ -74,15 +74,19 @@   ) where  import           Data.Bits-import qualified Data.List                as List-import           Data.Typeable import           Foreign import           Foreign.C import           GHC.Generics-import           Numeric                    (showHex)+import           Numeric                (showHex) import           System.IO.Unsafe import           Z.Data.CBytes-import           Z.Data.Text.ShowT          (ShowT)+import           Z.Data.Text.ShowT      (ShowT(..))+import qualified Z.Data.Text.ShowT      as T+import           Z.Data.JSON            (EncodeJSON(..), ToValue(..), FromValue(..), (.:))+import qualified Z.Data.JSON            as JSON+import qualified Z.Data.JSON.Builder    as B+import qualified Z.Data.Vector          as V+import qualified Z.Data.Vector.Extra    as V import           Z.IO.Exception import           Z.Foreign @@ -106,26 +110,90 @@  -- | IPv4 or IPv6 socket address, i.e. the `sockaddr_in` or `sockaddr_in6` struct. -- +-- Example on JSON instance:+--+-- @+-- > JSON.encodeText  $ ipv6 "3731:54:65fe:2::a8" 9090+-- "{\"addr\":[14129,84,26110,2,0,0,0,168],\"port\":9090,\"flow\":0,\"scope\":0}"+-- > JSON.encodeText  $ ipv4 "128.14.32.1" 9090+-- "{\"addr\":[128,14,32,1],\"port\":9090}"+-- @ data SocketAddr -    = SocketAddrInet+    = SocketAddrIPv4+        {-# UNPACK #-} !IPv4    -- sin_addr  (ditto)         {-# UNPACK #-} !PortNumber  -- sin_port  (network byte order)-        {-# UNPACK #-} !InetAddr    -- sin_addr  (ditto)-    | SocketAddrInet6+    | SocketAddrIPv6+        {-# UNPACK #-} !IPv6   -- sin6_addr (ditto)         {-# UNPACK #-} !PortNumber  -- sin6_port (network byte order)         {-# UNPACK #-} !FlowInfo    -- sin6_flowinfo (ditto)-        {-# UNPACK #-} !Inet6Addr   -- sin6_addr (ditto)         {-# UNPACK #-} !ScopeID     -- sin6_scope_id (ditto)-  deriving (Eq, Ord, Typeable)+    deriving (Eq, Ord, Generic) -instance Show SocketAddr where-    showsPrec _ (SocketAddrInet port ia)-       = shows ia . showString ":" . shows port-    showsPrec _ (SocketAddrInet6 port _ ia6 _)-       = ('[':) . shows ia6 . showString "]:" . shows port+instance EncodeJSON SocketAddr where +    encodeJSON (SocketAddrIPv4 addr port) = T.curly $ do+        "addr" `B.kv` encodeJSON addr+        T.char7 ','+        "port" `B.kv` encodeJSON port+    encodeJSON (SocketAddrIPv6 addr port flow scope) = T.curly $ do+        "addr" `B.kv` encodeJSON addr+        T.char7 ','+        "port" `B.kv` encodeJSON port+        T.char7 ','+        "flow" `B.kv` encodeJSON flow+        T.char7 ','+        "scope" `B.kv` encodeJSON scope +instance ToValue SocketAddr where +    toValue (SocketAddrIPv4 addr port) = JSON.Object . V.pack $ +        [ ("addr", toValue addr)+        , ("number", toValue port)+        ]+    toValue (SocketAddrIPv6 addr port flow scope) = JSON.Object . V.pack $ +        [ ("addr", toValue addr)+        , ("number", toValue port)+        , ("flow", toValue flow)+        , ("scope", toValue scope)+        ]++instance FromValue SocketAddr where +    fromValue = JSON.withFlatMapR "Z.IO.Network.SocketAddr" $ \ fm -> do+        (addrV :: V.PrimVector Word) <- fm .: "addr"+        case V.length addrV of+            4 -> do port <- fm .: "port"+                    let a = fromIntegral $ addrV `V.unsafeIndex` 0+                        b = fromIntegral $ addrV `V.unsafeIndex` 1+                        c = fromIntegral $ addrV `V.unsafeIndex` 2+                        d = fromIntegral $ addrV `V.unsafeIndex` 3+                        !addr = tupleToIPv4Addr (a,b,c,d)+                    return (SocketAddrIPv4 addr port)+            8 -> do port <- fm .: "port"+                    flow <- fm .: "flow"+                    scope <- fm .: "scope"+                    let a = fromIntegral $ addrV `V.unsafeIndex` 0+                        b = fromIntegral $ addrV `V.unsafeIndex` 1+                        c = fromIntegral $ addrV `V.unsafeIndex` 2+                        d = fromIntegral $ addrV `V.unsafeIndex` 3+                        e = fromIntegral $ addrV `V.unsafeIndex` 4+                        f = fromIntegral $ addrV `V.unsafeIndex` 5+                        g = fromIntegral $ addrV `V.unsafeIndex` 6+                        h = fromIntegral $ addrV `V.unsafeIndex` 7+                        !addr = tupleToIPv6Addr (a,b,c,d,e,f,g,h)+                    return (SocketAddrIPv6 addr port flow scope)+            _ -> JSON.fail' "wrong address length"++instance Show SocketAddr where show = T.toString++instance ShowT SocketAddr where+    toUTF8BuilderP _ (SocketAddrIPv4 addr port)+       = T.toUTF8Builder addr >> T.char7 ':' >> T.toUTF8Builder port+    toUTF8BuilderP _ (SocketAddrIPv6 addr port _ _) = do+        T.square (T.toUTF8Builder addr)+        T.char7 ':' +        T.toUTF8Builder port+ sockAddrFamily :: SocketAddr -> SocketFamily-sockAddrFamily (SocketAddrInet _ _) = AF_INET-sockAddrFamily (SocketAddrInet6 _ _ _ _) = AF_INET6+sockAddrFamily (SocketAddrIPv4 _ _) = AF_INET+sockAddrFamily (SocketAddrIPv6 _ _ _ _) = AF_INET6  type FlowInfo = Word32 type ScopeID = Word32@@ -148,130 +216,166 @@  -- | Independent of endianness. For example @127.0.0.1@ is stored as @(127, 0, 0, 1)@. ----- For direct manipulation prefer 'inetAddrToTuple' and 'tupleToInetAddr'.+-- For direct manipulation prefer 'ipv4AddrToTuple' and 'tupleToIPv4Addr'. ---newtype InetAddr = InetAddr { getInetAddr :: Word32 } deriving (Eq, Ord, Typeable)-instance Show InetAddr where-    showsPrec _ ia = -        let (a,b,c,d) = inetAddrToTuple ia-        in shows a . ('.':) . shows b . ('.':) . shows c . ('.':) . shows d +-- JSON instance encode ipv4 address into an array with 4 'Word8' octets.+newtype IPv4 = IPv4 { getIPv4Addr :: Word32 }+    deriving (Eq, Ord, Generic)+    +instance EncodeJSON IPv4 where+    {-# INLINE encodeJSON #-}+    encodeJSON = encodeJSON . ipv4AddrToTuple+instance ToValue IPv4 where+    {-# INLINE toValue #-}+    toValue = toValue . ipv4AddrToTuple+instance FromValue IPv4 where+    {-# INLINE fromValue #-}+    fromValue v = tupleToIPv4Addr <$> fromValue v +instance Show IPv4 where show = T.toString+instance ShowT IPv4 where+    toUTF8BuilderP _ ia = do+        let (a,b,c,d) = ipv4AddrToTuple ia+        T.int a +        T.char7 '.' +        T.int b  +        T.char7 '.' +        T.int c+        T.char7 '.' +        T.int d  + -- | @0.0.0.0@-inetAny             :: InetAddr-inetAny              = InetAddr 0+ipv4Any             :: IPv4+ipv4Any              = IPv4 0  -- | @255.255.255.255@-inetBroadcast       :: InetAddr-inetBroadcast        = tupleToInetAddr (255,255,255,255)+ipv4Broadcast       :: IPv4+ipv4Broadcast        = tupleToIPv4Addr (255,255,255,255)  -- | @255.255.255.255@-inetNone            :: InetAddr-inetNone             = tupleToInetAddr (255,255,255,255)+ipv4None            :: IPv4+ipv4None             = tupleToIPv4Addr (255,255,255,255)  -- | @127.0.0.1@-inetLoopback        :: InetAddr-inetLoopback         = tupleToInetAddr (127,  0,  0,  1)+ipv4Loopback        :: IPv4+ipv4Loopback         = tupleToIPv4Addr (127,  0,  0,  1)  -- | @224.0.0.0@-inetUnspecificGroup :: InetAddr-inetUnspecificGroup  = tupleToInetAddr (224,  0,  0,  0)+ipv4UnspecificGroup :: IPv4+ipv4UnspecificGroup  = tupleToIPv4Addr (224,  0,  0,  0)  -- | @224.0.0.1@-inetAllHostsGroup   :: InetAddr-inetAllHostsGroup    = tupleToInetAddr (224,  0,  0,  1)+ipv4AllHostsGroup   :: IPv4+ipv4AllHostsGroup    = tupleToIPv4Addr (224,  0,  0,  1)  -- | @224.0.0.255@-inetMaxLocalGroup   :: InetAddr-inetMaxLocalGroup    = tupleToInetAddr (224,  0,  0,255)+ipv4MaxLocalGroup   :: IPv4+ipv4MaxLocalGroup    = tupleToIPv4Addr (224,  0,  0,255) -instance Storable InetAddr where+instance Storable IPv4 where     sizeOf _ = 4     alignment _ = alignment (undefined :: Word32) -    peek p = (InetAddr . ntohl) `fmap` peekByteOff p 0-    poke p (InetAddr ia) = pokeByteOff p 0 (htonl ia)+    peek p = (IPv4 . ntohl) `fmap` peekByteOff p 0+    poke p (IPv4 ia) = pokeByteOff p 0 (htonl ia) -instance Unaligned InetAddr where+instance Unaligned IPv4 where     unalignedSize _ = 4-    pokeMBA p off x = pokeMBA p off (htonl (getInetAddr x))-    peekMBA p off = InetAddr . ntohl <$> peekMBA p off-    indexBA p off = InetAddr (ntohl (indexBA p off))+    pokeMBA p off x = pokeMBA p off (htonl (getIPv4Addr x))+    peekMBA p off = IPv4 . ntohl <$> peekMBA p off+    indexBA p off = IPv4 (ntohl (indexBA p off))     --- | Converts 'InetAddr' to representation-independent IPv4 quadruple.+-- | Converts 'IPv4' to representation-independent IPv4 quadruple. -- For example for @127.0.0.1@ the function will return @(127, 0, 0, 1)@ -- regardless of host endianness.-inetAddrToTuple :: InetAddr -> (Word8, Word8, Word8, Word8)-inetAddrToTuple (InetAddr ia) =+ipv4AddrToTuple :: IPv4 -> (Word8, Word8, Word8, Word8)+ipv4AddrToTuple (IPv4 ia) =     let byte i = fromIntegral (ia `shiftR` i) :: Word8     in (byte 24, byte 16, byte 8, byte 0) --- | Converts IPv4 quadruple to 'InetAddr'.-tupleToInetAddr :: (Word8, Word8, Word8, Word8) -> InetAddr-tupleToInetAddr (b3, b2, b1, b0) =+-- | Converts IPv4 quadruple to 'IPv4'.+tupleToIPv4Addr :: (Word8, Word8, Word8, Word8) -> IPv4+tupleToIPv4Addr (b3, b2, b1, b0) =     let x `sl` i = fromIntegral x `shiftL` i :: Word32-    in InetAddr $ (b3 `sl` 24) .|. (b2 `sl` 16) .|. (b1 `sl` 8) .|. (b0 `sl` 0)+    in IPv4 $ (b3 `sl` 24) .|. (b2 `sl` 16) .|. (b1 `sl` 8) .|. (b0 `sl` 0)  --------------------------------------------------------------------------------  -- | Independent of endianness. For example @::1@ is stored as @(0, 0, 0, 1)@. ----- For direct manipulation prefer 'inet6AddrToTuple' and 'tupleToInet6Addr'.+-- For direct manipulation prefer 'ipv6AddrToTuple' and 'tupleToIPv6Addr'. ---data Inet6Addr = Inet6Addr {-# UNPACK #-}!Word32-                           {-# UNPACK #-}!Word32-                           {-# UNPACK #-}!Word32-                           {-# UNPACK #-}!Word32 deriving (Eq, Ord, Typeable)+-- JSON instance encode ipv6 address into an array with 8 'Word16' octets.+data IPv6 = IPv6 {-# UNPACK #-}!Word32+                 {-# UNPACK #-}!Word32+                 {-# UNPACK #-}!Word32+                 {-# UNPACK #-}!Word32 +    deriving (Eq, Ord, Generic) +instance EncodeJSON IPv6 where+    {-# INLINE encodeJSON #-}+    encodeJSON addr = encodeJSON [a,b,c,d,e,f,g,h]+      where (a,b,c,d,e,f,g,h) = ipv6AddrToTuple addr+instance ToValue IPv6 where+    {-# INLINE toValue #-}+    toValue addr = toValue [a,b,c,d,e,f,g,h]+      where (a,b,c,d,e,f,g,h) = ipv6AddrToTuple addr+instance FromValue IPv6 where+    {-# INLINE fromValue #-}+    fromValue v = do+        [a,b,c,d,e,f,g,h] <- fromValue v+        return $! tupleToIPv6Addr (a,b,c,d,e,f,g,h) -instance Show Inet6Addr where-    showsPrec _ ia6@(Inet6Addr a1 a2 a3 a4)+instance Show IPv6 where show = T.toString+instance ShowT IPv6 where+    toUTF8BuilderP _ ia6@(IPv6 a1 a2 a3 a4)         -- IPv4-Mapped IPv6 Address         | a1 == 0 && a2 == 0 && a3 == 0xffff =-          showString "::ffff:" . shows (InetAddr a4)+            "::ffff:" >> T.toUTF8Builder (IPv4 a4)         -- IPv4-Compatible IPv6 Address (exclude IPRange ::/112)         | a1 == 0 && a2 == 0 && a3 == 0 && a4 >= 0x10000 =-            showString "::" . shows (InetAddr a4)+            "::" >> T.toUTF8Builder (IPv4 a4)         -- length of longest run > 1, replace it with "::"         | end - begin > 1 =-            showFields prefix . showString "::" . showFields suffix+            showFields prefix >> "::" >> showFields suffix         | otherwise =             showFields fields       where         fields =-            let (u7, u6, u5, u4, u3, u2, u1, u0) = inet6AddrToTuple ia6 in+            let (u7, u6, u5, u4, u3, u2, u1, u0) = ipv6AddrToTuple ia6 in             [u7, u6, u5, u4, u3, u2, u1, u0]-        showFields = foldr (.) id . List.intersperse (':':) . map showHex-        prefix = take begin fields  -- fields before "::"-        suffix = drop end fields    -- fields after "::"+        showFields = T.intercalateList (T.char7 ':') (\ f -> T.string7 (showHex f []))+        !prefix = take begin fields  -- fields before "::"+        !suffix = drop end fields    -- fields after "::"         begin = end + diff          -- the longest run of zeros         (diff, end) = minimum $             scanl (\c i -> if i == 0 then c - 1 else 0) 0 fields `zip` [0..]  -- | @::@-inet6Any      :: Inet6Addr-inet6Any       = Inet6Addr 0 0 0 0+ipv6Any      :: IPv6+ipv6Any       = IPv6 0 0 0 0  -- | @::1@-inet6Loopback :: Inet6Addr-inet6Loopback  = Inet6Addr 0 0 0 1+ipv6Loopback :: IPv6+ipv6Loopback  = IPv6 0 0 0 1 --- | convert 'Inet6Addr' to octets.-inet6AddrToTuple :: Inet6Addr -> (Word16, Word16, Word16, Word16,+-- | convert 'IPv6' to octets.+ipv6AddrToTuple :: IPv6 -> (Word16, Word16, Word16, Word16,                                         Word16, Word16, Word16, Word16)-inet6AddrToTuple (Inet6Addr w3 w2 w1 w0) =+ipv6AddrToTuple (IPv6 w3 w2 w1 w0) =     let high, low :: Word32 -> Word16         high w = fromIntegral (w `shiftR` 16)         low w = fromIntegral w     in (high w3, low w3, high w2, low w2, high w1, low w1, high w0, low w0) --- | convert 'Inet6Addr' from octets.-tupleToInet6Addr :: (Word16, Word16, Word16, Word16,-                        Word16, Word16, Word16, Word16) -> Inet6Addr-tupleToInet6Addr (w7, w6, w5, w4, w3, w2, w1, w0) =+-- | convert 'IPv6' from octets.+tupleToIPv6Addr :: (Word16, Word16, Word16, Word16,+                        Word16, Word16, Word16, Word16) -> IPv6+tupleToIPv6Addr (w7, w6, w5, w4, w3, w2, w1, w0) =     let add :: Word16 -> Word16 -> Word32         high `add` low = (fromIntegral high `shiftL` 16) .|. (fromIntegral low)-    in  Inet6Addr (w7 `add` w6) (w5 `add` w4) (w3 `add` w2) (w1 `add` w0)+    in  IPv6 (w7 `add` w6) (w5 `add` w4) (w3 `add` w2) (w1 `add` w0) -instance Storable Inet6Addr where+instance Storable IPv6 where     sizeOf _    = #size struct in6_addr     alignment _ = #alignment struct in6_addr     peek p = do@@ -279,8 +383,8 @@         b <- peek32 p 1         c <- peek32 p 2         d <- peek32 p 3-        return $ Inet6Addr a b c d-    poke p (Inet6Addr a b c d) = do+        return $ IPv6 a b c d+    poke p (IPv6 a b c d) = do         poke32 p 0 a         poke32 p 1 b         poke32 p 2 c@@ -311,7 +415,7 @@     pokeByte 2 (a `sr`  8)     pokeByte 3 (a `sr`  0) -instance Unaligned Inet6Addr where+instance Unaligned IPv6 where     unalignedSize _ = (#size struct in6_addr)      indexBA p off = @@ -319,16 +423,16 @@             b = indexBA p  (off + s6_addr_offset + 4)             c = indexBA p  (off + s6_addr_offset + 8)             d = indexBA p  (off + s6_addr_offset + 12)-        in Inet6Addr (getBE a) (getBE b) (getBE c) (getBE d)+        in IPv6 (getBE a) (getBE b) (getBE c) (getBE d)      peekMBA p off = do         a <- peekMBA p (off + s6_addr_offset + 0)         b <- peekMBA p  (off + s6_addr_offset + 4)         c <- peekMBA p  (off + s6_addr_offset + 8)         d <- peekMBA p  (off + s6_addr_offset + 12)-        return $ Inet6Addr (getBE a) (getBE b) (getBE c) (getBE d)+        return $ IPv6 (getBE a) (getBE b) (getBE c) (getBE d) -    pokeMBA p off (Inet6Addr a b c d) = do+    pokeMBA p off (IPv6 a b c d) = do         pokeMBA p (off + s6_addr_offset) (BE a)         pokeMBA p (off + 4 + s6_addr_offset) (BE b)         pokeMBA p (off + 8 + s6_addr_offset) (BE c)@@ -343,20 +447,20 @@         (#const AF_INET) -> do             addr <- (#peek struct sockaddr_in, sin_addr) p             port <- (#peek struct sockaddr_in, sin_port) p-            return (SocketAddrInet port addr)+            return (SocketAddrIPv4 addr port)         (#const AF_INET6) -> do             port <- (#peek struct sockaddr_in6, sin6_port) p             flow <- (#peek struct sockaddr_in6, sin6_flowinfo) p             addr <- (#peek struct sockaddr_in6, sin6_addr) p             scope <- (#peek struct sockaddr_in6, sin6_scope_id) p-            return (SocketAddrInet6 port flow addr scope)+            return (SocketAddrIPv6 addr port flow scope)         _ -> do let errno = UV_EAI_ADDRFAMILY                 name <- uvErrName errno                 desc <- uvStdError errno                 throwUVError errno (IOEInfo name desc callStack)  pokeSocketAddr :: Ptr SocketAddr -> SocketAddr -> IO ()-pokeSocketAddr p (SocketAddrInet port addr) =  do+pokeSocketAddr p (SocketAddrIPv4 addr port) =  do #if defined(darwin_HOST_OS)     clearPtr p (#size struct sockaddr_in) #endif@@ -366,7 +470,7 @@     (#poke struct sockaddr_in, sin_family) p ((#const AF_INET) :: CSaFamily)     (#poke struct sockaddr_in, sin_port) p port     (#poke struct sockaddr_in, sin_addr) p addr-pokeSocketAddr p (SocketAddrInet6 port flow addr scope) =  do+pokeSocketAddr p (SocketAddrIPv6 addr port flow scope) =  do #if defined(darwin_HOST_OS)     clearPtr p (#size struct sockaddr_in6) #endif@@ -383,11 +487,11 @@ -- | Pass 'SocketAddr' to FFI as pointer. -- withSocketAddr :: SocketAddr -> (Ptr SocketAddr -> IO a) -> IO a-withSocketAddr sa@(SocketAddrInet _ _) f = do+withSocketAddr sa@(SocketAddrIPv4 _ _) f = do     allocaBytesAligned         (#size struct sockaddr_in)         (#alignment struct sockaddr_in) $ \ p -> pokeSocketAddr p sa >> f p-withSocketAddr sa@(SocketAddrInet6 _ _ _ _) f = do+withSocketAddr sa@(SocketAddrIPv6 _ _ _ _) f = do     allocaBytesAligned          (#size struct sockaddr_in6)          (#alignment struct sockaddr_in6) $ \ p -> pokeSocketAddr p sa >> f p@@ -397,18 +501,18 @@ -- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY. -- withSocketAddrUnsafe :: SocketAddr -> (MBA## SocketAddr -> IO a) -> IO a-withSocketAddrUnsafe sa@(SocketAddrInet _ _) f = do+withSocketAddrUnsafe sa@(SocketAddrIPv4 _ _) f = do     (MutableByteArray p) <- newByteArray (#size struct sockaddr_in)      pokeSocketAddrMBA p sa      f p-withSocketAddrUnsafe sa@(SocketAddrInet6 _ _ _ _) f = do+withSocketAddrUnsafe sa@(SocketAddrIPv6 _ _ _ _) f = do     (MutableByteArray p) <- newByteArray (#size struct sockaddr_in6)      pokeSocketAddrMBA p sa      f p  sizeOfSocketAddr :: SocketAddr -> CSize-sizeOfSocketAddr (SocketAddrInet _ _) = #size struct sockaddr_in-sizeOfSocketAddr (SocketAddrInet6 _ _ _ _) = #size struct sockaddr_in6+sizeOfSocketAddr (SocketAddrIPv4 _ _) = #size struct sockaddr_in+sizeOfSocketAddr (SocketAddrIPv6 _ _ _ _) = #size struct sockaddr_in6  -- | Allocate space for 'sockaddr_storage' and pass to FFI. withSocketAddrStorage :: (Ptr SocketAddr -> IO ()) -> IO SocketAddr@@ -437,20 +541,20 @@         (#const AF_INET) -> do             addr <- peekMBA p (#offset struct sockaddr_in, sin_addr)              port <- peekMBA p (#offset struct sockaddr_in, sin_port) -            return (SocketAddrInet port addr)+            return (SocketAddrIPv4 addr port)         (#const AF_INET6) -> do             port <- peekMBA p (#offset struct sockaddr_in6, sin6_port)              flow <- peekMBA p (#offset struct sockaddr_in6, sin6_flowinfo)              addr <- peekMBA p (#offset struct sockaddr_in6, sin6_addr)              scope <- peekMBA p (#offset struct sockaddr_in6, sin6_scope_id) -            return (SocketAddrInet6 port flow addr scope)+            return (SocketAddrIPv6 addr port flow scope)         _ -> do let errno = UV_EAI_ADDRFAMILY                 name <- uvErrName errno                 desc <- uvStdError errno                 throwUVError errno (IOEInfo name desc callStack)  pokeSocketAddrMBA :: MBA## SocketAddr -> SocketAddr -> IO ()-pokeSocketAddrMBA p (SocketAddrInet port addr) =  do+pokeSocketAddrMBA p (SocketAddrIPv4 addr port) =  do #if defined(darwin_HOST_OS)     clearMBA p (#size struct sockaddr_in) #endif@@ -460,7 +564,7 @@     pokeMBA p (#offset struct sockaddr_in, sin_family) ((#const AF_INET) :: CSaFamily)     pokeMBA p (#offset struct sockaddr_in, sin_port) port     pokeMBA p (#offset struct sockaddr_in, sin_addr) addr-pokeSocketAddrMBA p (SocketAddrInet6 port flow addr scope) =  do+pokeSocketAddrMBA p (SocketAddrIPv6 addr port flow scope) =  do #if defined(darwin_HOST_OS)     clearMBA p (#size struct sockaddr_in6) #endif@@ -477,8 +581,8 @@ -- Port Numbers  -- | Port number.---   Use the @Num@ instance (i.e. use a literal) to create a---   @PortNumber@ value.+-- +-- Use the @Num@ instance (i.e. use a literal) to create a --   @PortNumber@ value. -- -- >>> 1 :: PortNumber -- 1@@ -492,9 +596,9 @@ -- True -- >>> 50000 + (10000 :: PortNumber) -- 60000-newtype PortNumber = PortNumber Word16 deriving (Eq, Ord, Enum, Generic)-                                        deriving newtype (Show, Read, Num, Bounded, Real, Integral)-                                        deriving anyclass ShowT+newtype PortNumber = PortNumber Word16 +    deriving (Eq, Ord, Enum, Generic)+    deriving newtype (Show, ShowT, Read, Num, Bounded, Real, Integral, EncodeJSON, ToValue, FromValue)  -- | @:0@ portAny :: PortNumber

@@ -37,6 +37,9 @@ import           Control.Monad.IO.Class import           Data.Primitive.PrimArray import           Foreign.Ptr+import           GHC.Generics+import           Z.Data.Text.ShowT   (ShowT(..))+import           Z.Data.JSON         (EncodeJSON, ToValue, FromValue) import           Z.IO.Exception import           Z.IO.Network.SocketAddr import           Z.IO.Resource@@ -55,12 +58,13 @@     , tcpRemoteAddr :: SocketAddr       -- ^ remote target address     , tcpClientNoDelay :: Bool          -- ^ if we want to use @TCP_NODELAY@     , tcpClientKeepAlive :: CUInt       -- ^ set keepalive delay for client socket, see 'setTCPKeepAlive'-    }+    } deriving (Eq, Ord, Show, Generic)+      deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)  -- | Default config, connect to @localhost:8888@. -- defaultTCPClientConfig :: TCPClientConfig-defaultTCPClientConfig = TCPClientConfig Nothing (SocketAddrInet 8888 inetLoopback) True 30+defaultTCPClientConfig = TCPClientConfig Nothing (SocketAddrIPv4 ipv4Loopback 8888) True 30  -- | init a TCP client 'Resource', which open a new connect when used. --@@ -91,7 +95,8 @@     , tcpListenBacklog    :: Int           -- ^ listening socket's backlog size, should be large enough(>128)     , tcpServerWorkerNoDelay :: Bool       -- ^ if we want to use @TCP_NODELAY@     , tcpServerWorkerKeepAlive :: CUInt    -- ^ set keepalive delay for worker socket, see 'setTCPKeepAlive'-    }+    } deriving (Eq, Ord, Show, Generic)+      deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)  -- | A default hello world server on localhost:8888 --@@ -100,7 +105,7 @@ -- defaultTCPServerConfig :: TCPServerConfig defaultTCPServerConfig = TCPServerConfig-    (SocketAddrInet 8888 inetAny)+    (SocketAddrIPv4 ipv4Any 8888)     128     True     30

@@ -12,8 +12,8 @@ * Socket FD is created lazily if no local address is provided, that means various functions   that need FD will throw bad FD exception if you 'initUDP' with no local address e.g. 'setTTL'. -* If you want to create socket FD but don't care about which port or interface you're using,-  use 'SocketAddrInet' 'portAny' 'inetAny' when 'initUDP'.+* If you want to create a socket FD but don't care about which port or interface you're using,+  use 'SocketAddrIPv4' 'portAny' 'ipv4Any' when 'initUDP'.  * Prefer 'recvUDPLoop' because it can reuse receive buffer. @@ -59,7 +59,7 @@  import Control.Concurrent import Control.Monad-import Data.Primitive.PrimArray as A+import Data.Primitive.PrimArray         as A import Data.IORef import Data.Word import Data.Int@@ -67,10 +67,14 @@ import Foreign.Storable (peek, poke) import Foreign.Ptr (plusPtr) import Foreign.C-import Z.Data.Array           as A-import Z.Data.Vector.Base     as V-import Z.Data.Vector.Extra    as V-import Z.Data.CBytes          as CBytes+import GHC.Generics+import Z.Data.Array                     as A+import Z.Data.Vector.Base               as V+import Z.Data.Vector.Extra              as V+import Z.Data.CBytes                    as CBytes+import qualified Z.Data.Text.ShowT      as T+import Z.Data.Text.ShowT                (ShowT(..))+import Z.Data.JSON                      (EncodeJSON, ToValue, FromValue) import Z.IO.Network.SocketAddr import Z.Foreign import Z.IO.UV.FFI@@ -92,11 +96,13 @@     , udpClosed  :: {-# UNPACK #-} !(IORef Bool)     } -instance Show UDP where-    show (UDP hdl slot uvm _ _) =-        "UDP{udpHandle=" ++ show hdl ++-                ",udpSlot=" ++ show slot ++-                ",udpManager=" ++ show uvm ++ "}"+instance Show UDP where show = T.toString+instance ShowT UDP where+    toUTF8BuilderP _ (UDP hdl slot uvm _ _) = do+        "UDP{udpHandle="    >> T.toUTF8Builder hdl+        ",udpSlot="         >> T.toUTF8Builder slot+        ",udpManager="      >> T.toUTF8Builder uvm+        T.char7 '}'  -- | UDP options. --@@ -107,7 +113,8 @@     { udpSendMsgSize :: {-# UNPACK #-} !Int         -- ^ maximum size of sending buffer     , udpLocalAddr :: Maybe (SocketAddr, UDPFlag)   -- ^ do we want bind a local address before receiving & sending?                                                     --   set to Nothing to let OS pick a random one.-    } deriving (Show, Eq, Ord)+    } deriving (Eq, Ord, Show, Generic)+      deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)  -- | @UDPConfig 512 Nothing@ defaultUDPConfig :: UDPConfig@@ -305,7 +312,8 @@                                                 --   inside each uv_run, we do batch receiving,                                                 --   increase this number can improve receiving performance,                                                 --   at the cost of memory and potential GHC thread starving.-    }+    } deriving (Eq, Ord, Show, Read, Generic)+      deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue)  -- | @UDPRecvConfig 512 6@ defaultUDPRecvConfig :: UDPRecvConfig

@@ -65,7 +65,7 @@ import System.IO.Unsafe import Z.Data.Builder as B import Z.Data.Vector as V-import Z.Data.Text.ShowT (ShowT, toUTF8Builder)+import qualified Z.Data.Text.ShowT as T import Z.IO.UV.FFI import Z.IO.UV.Manager import Z.IO.UV.Errno@@ -86,6 +86,20 @@     = StdTTY {-# UNPACK #-}!(Ptr UVHandle) {-# UNPACK #-}!UVSlot UVManager -- similar to UVStream     | StdFile {-# UNPACK #-}!FD                                          -- similar to UVFile +instance Show StdStream where show = T.toString++instance T.ShowT StdStream where+    toUTF8BuilderP p (StdTTY ptr slot uvm) = T.parenWhen (p > 10) $ do+        "StdTTY "+        T.toUTF8Builder ptr+        T.char7 ' '+        T.toUTF8Builder slot+        T.char7 ' '+        T.toUTF8BuilderP 11 uvm+    toUTF8BuilderP p (StdFile fd) = T.parenWhen (p > 10) $ do+        "StdFile "+        T.toUTF8Builder fd+ isStdStreamTTY :: StdStream -> Bool isStdStreamTTY (StdTTY _ _ _) = True isStdStreamTTY _              = False@@ -217,8 +231,8 @@ --------------------------------------------------------------------------------  -- | Print a 'ShowT' and flush to stdout.-printStd :: (HasCallStack, ShowT a) => a -> IO ()-printStd s = putStd (toUTF8Builder s)+printStd :: (HasCallStack, T.ShowT a) => a -> IO ()+printStd s = putStd (T.toUTF8Builder s)  -- | Print a 'Builder' and flush to stdout. putStd :: HasCallStack => Builder a -> IO ()@@ -227,8 +241,8 @@     flushBuffer o  -- | Print a 'ShowT' and flush to stdout, with a linefeed.-printLineStd :: (HasCallStack, ShowT a) => a -> IO ()-printLineStd s = putLineStd (toUTF8Builder s)+printLineStd :: (HasCallStack, T.ShowT a) => a -> IO ()+printLineStd s = putLineStd (T.toUTF8Builder s)  -- | Print a 'Builder' and flush to stdout, with a linefeed. putLineStd :: HasCallStack => Builder a -> IO ()

@@ -462,6 +462,22 @@ pattern O_WRONLY :: FileFlag pattern O_WRONLY = #const UV_FS_O_WRONLY ++type Whence = CInt++-- | Beginning of the file.+pattern SEEK_SET :: Whence+pattern SEEK_SET = #const SEEK_SET+-- | Current position of the file pointer.+pattern SEEK_CUR :: Whence+pattern SEEK_CUR = #const SEEK_CUR+-- | End of file.+pattern SEEK_END :: Whence+pattern SEEK_END = #const SEEK_END++foreign import ccall unsafe hs_seek :: FD -> Int64 -> Whence -> IO Int64++ #if defined(_WIN32) type UVDirEntType = CInt #else

@@ -7,7 +7,7 @@ Stability   : experimental Portability : non-portable -This module provide IO manager which bridge libuv's async interface with ghc's light weight thread.+This is an internal module provides IO manager which bridge libuv's async interface with ghc's lightweight thread.  The main procedures for doing event IO is: @@ -15,7 +15,9 @@   * Prepare you IO buffer with 'pokeBufferTable'(read or write).   * Call C side IO functions with predefined callbacks.   * Block your thread with the 'MVar' from 'getBlockMVar'.-  * Read the result by 'takeMVar' on that 'MVar', it will be the value pushed on C side.+  * In predefined callbacks, push slot number to uv_loop's queue.+  * IO polling finishes, IO manager thread will unblock blocking IO threads by filling the 'MVar' with+    current value from buffer size table.   * Slot is freed on C side, either via callbacks, or when handle is closed.  Usually slots are cache in the IO device so that you don't have to allocate new one before each IO operation.@@ -24,7 +26,7 @@ -}  module Z.IO.UV.Manager-  ( UVManager+  ( UVManager(..)   , getUVManager   , getBlockMVar   , peekBufferSizeTable@@ -54,6 +56,7 @@ import           System.IO.Unsafe import           Z.Data.Array import           Z.Data.PrimRef.PrimIORef+import qualified Z.Data.Text.ShowT as T import           Z.IO.Exception import           Z.IO.Resource import           Z.IO.UV.FFI@@ -61,27 +64,26 @@ --------------------------------------------------------------------------------  data UVManager = UVManager-    { uvmBlockTable :: {-# UNPACK #-} !(IORef (UnliftedArray (MVar Int))) -- a array to store threads blocked on async IO.--    , uvmLoop       :: {-# UNPACK #-} !(Ptr UVLoop)        -- the uv loop refrerence--    , uvmLoopData   :: {-# UNPACK #-} !(Ptr UVLoopData)    -- cached pointer to uv_loop_t's data field--    , uvmRunning    :: {-# UNPACK #-} !(MVar Bool)     -- only uv manager thread will modify this value.-                                                        -- 'True' druing uv_run and 'False' otherwise.-                                                        ---                                                        -- unlike epoll/ONESHOT, uv loop are NOT thread safe,-                                                        -- we have to wake up the loop before mutating uv_loop's-                                                        -- state.-    , uvmCap        ::  {-# UNPACK #-} !Int                -- the capability uv manager run on.+    { uvmBlockTable :: {-# UNPACK #-} !(IORef (UnliftedArray (MVar Int)))+    -- ^ A array to store threads blocked on async IO.+    , uvmLoop       :: {-# UNPACK #-} !(Ptr UVLoop)+    -- ^ The uv loop refrerence+    , uvmLoopData   :: {-# UNPACK #-} !(Ptr UVLoopData)+    -- ^ Cached pointer to uv_loop_t's data field+    , uvmRunning    :: {-# UNPACK #-} !(MVar Bool)+    -- ^ Only uv manager thread will modify this value,+    -- 'True' druing uv_run and 'False' otherwise.+    -- Unlike epoll/ONESHOT, uv loop are NOT thread safe,+    -- one have to wake up the loop before mutating uv_loop's state.+    , uvmCap        ::  {-# UNPACK #-} !Int+    -- ^ The capability number which uv manager runs on.     } -instance Show UVManager where-    show uvm = "UVManager on capability " ++ show (uvmCap uvm)+instance Show UVManager where show = T.toString -instance Eq UVManager where-    uvm == uvm' =-        uvmCap uvm == uvmCap uvm'+instance T.ShowT UVManager where+    toUTF8BuilderP p uvm = T.parenWhen (p > 10) $+        "UVManager on capability " >> T.int (uvmCap uvm)  uvManagerArray :: IORef (Array UVManager) {-# NOINLINE uvManagerArray #-}

@@ -20,16 +20,17 @@   , helloWorld, echo   ) where -import          Control.Concurrent-import          Control.Monad-import          Z.IO.UV.Errno-import          Z.IO.UV.FFI-import          Z.IO.UV.Manager-import          Z.IO.Buffered-import          Z.IO.Exception-import          Z.IO.Resource-import          Data.IORef-import          GHC.Ptr+import           Control.Concurrent+import           Control.Monad+import qualified Z.Data.Text.ShowT as T+import           Z.IO.UV.Errno+import           Z.IO.UV.FFI+import           Z.IO.UV.Manager+import           Z.IO.Buffered+import           Z.IO.Exception+import           Z.IO.Resource+import           Data.IORef+import           GHC.Ptr  -------------------------------------------------------------------------------- -- UVStream@@ -46,11 +47,14 @@                                                     -- so no need to use atomic read&write     } -instance Show UVStream where-    show (UVStream hdl slot uvm _) =-        "UVStream{uvsHandle=" ++ show hdl ++-                ",uvsSlot=" ++ show slot ++-                ",uvsManager=" ++ show uvm ++ "}"+instance Show UVStream where show = T.toString++instance T.ShowT UVStream where+    toUTF8BuilderP _ (UVStream hdl slot uvm _) = do+        "UVStream{uvsHandle="  >> T.toUTF8Builder hdl+        ",uvsSlot="            >> T.toUTF8Builder slot+        ",uvsManager="         >> T.toUTF8Builder uvm+        T.char7 '}'  -- | Safely lock an uv manager and perform uv_handle initialization. --

@@ -821,3 +821,16 @@         return (HsInt)r;     } else return slot; }++int64_t hs_seek(int file, int64_t off, int origin){+#if defined(_WIN32)+    int64_t r = (int64_t)_lseeki64(file, off, origin);+#else+    int64_t r = (int64_t)lseek(file, off, origin);+#endif+    if (r < 0) {+        return uv_translate_sys_error(errno);+    } else { +        return r;+    }+}

@@ -37,6 +37,8 @@  #if !defined(_WIN32) +#include <unistd.h> + #if defined(__sun) # include <sys/port.h> # include <port.h>@@ -592,6 +594,8 @@  //////////////////////////////////////////////////////////////////////////////// // fs, none thread pool version+int64_t hs_seek(int file, int64_t off, int origin);+ int32_t hs_uv_fs_open(const char* path, int flags, int mode); HsInt hs_uv_fs_close(int32_t file); HsInt hs_uv_fs_read(int32_t file, char* buffer, HsInt buffer_size, int64_t offset);

@@ -41,7 +41,7 @@         forkIO $ producter         forkIO $ producter -        threadDelay 5000000+        threadDelay 10000000          s <- readIORef sumRef         s @?= (sum content * 2)@@ -68,7 +68,7 @@         forkIO $ producter         forkIO $ producter -        threadDelay 5000000+        threadDelay 10000000          s <- readIORef sumRef         s @?= (sum content * 2)@@ -96,7 +96,7 @@         forkIO $ producter         forkIO $ producter -        threadDelay 5000000+        threadDelay 10000000          s <- readIORef sumRef         s @?= (sum content * 2 * 3)

@@ -39,7 +39,7 @@             threadDelay 50000         threadDelay 10000000  -- wait 10s here         c' <- readPrimIORef c-        assertBool "throttled add" (6  <= c' && c' <= 8)    -- on osx time drift too much+        assertBool "throttled add" (6  <= c' && c' <= 8)    -- on osx CI time drift too much      it "throttleTrailing" $ do         c <- newCounter 0

@@ -22,7 +22,7 @@     it "roundtrip test" $ do         let testMsg = V.cycleN 256 "abc"             longMsg = V.cycleN 2048 "abcdefg"-            addr = SocketAddrInet 12345 inetLoopback+            addr = SocketAddrIPv4 ipv4Loopback 12345          serverThread <- forkIO $ startTCPServer defaultTCPServerConfig{ tcpListenAddr = addr } echo @@ -34,11 +34,11 @@                 o <- newBufferedOutput tcp                  writeBuffer o testMsg >> flushBuffer o-                testMsg' <- readExactly' (V.length testMsg) i+                testMsg' <- readExactly (V.length testMsg) i                 testMsg' @=? testMsg                  writeBuffer o longMsg >> flushBuffer o-                longMsg' <- readExactly' (V.length longMsg) i+                longMsg' <- readExactly (V.length longMsg) i                 longMsg' @=? longMsg          threadDelay 5000000  -- 5s

@@ -22,7 +22,7 @@     it "roundtrip test" $ do         let testMsg = V.replicate 256 48             longMsg = V.replicate 2048 48-            addr = SocketAddrInet 12345 inetLoopback+            addr = SocketAddrIPv4 ipv4Loopback 12345         withResource (initUDP defaultUDPConfig{udpSendMsgSize = 2048}) $ \ c ->             withResource (initUDP defaultUDPConfig{udpLocalAddr = Just (addr,UDP_DEFAULT)}) $ \ s -> do                 forkIO $ sendUDP c addr testMsg@@ -38,8 +38,8 @@      it "UDP sending addr test" $ do         let testMsg = V.replicate 256 48-            addr = SocketAddrInet 12346 inetLoopback-            addr' = SocketAddrInet 12347 inetLoopback+            addr = SocketAddrIPv4 ipv4Loopback 12346+            addr' = SocketAddrIPv4 ipv4Loopback 12347         withResource (initUDP defaultUDPConfig{udpLocalAddr = Just (addr,UDP_DEFAULT)}) $ \ c ->             withResource (initUDP defaultUDPConfig{udpLocalAddr = Just (addr',UDP_DEFAULT)}) $ \ s -> do                 forkIO $ sendUDP c addr' testMsg@@ -48,14 +48,14 @@      it "overlong message exception" $ do         let testMsg = V.replicate 4096 48-            addr = SocketAddrInet 12348 inetLoopback+            addr = SocketAddrIPv4 ipv4Loopback 12348         withResource (initUDP defaultUDPConfig) $ \ c ->             withResource (initUDP defaultUDPConfig) $ \ s -> do                 sendUDP c addr testMsg `shouldThrow` anyException      it "batch receiving(multiple messages)" $ do         let testMsg = V.replicate 256 48-            addr = SocketAddrInet 12346 inetLoopback+            addr = SocketAddrIPv4 ipv4Loopback 12346         msgList <- newIORef []         forkIO $ withResource (initUDP defaultUDPConfig{udpLocalAddr = Just (addr,UDP_DEFAULT)}) $ \ s -> do             recvUDPLoop defaultUDPRecvConfig s $ \ msgs ->

@@ -23,20 +23,21 @@         workerCounter <- newCounter 0         let res = initResource (atomicAddCounter_ resCounter 1)                                (\ _ -> atomicSubCounter_ resCounter 1)-            resPool = initPool res 100 1+            resPool = initPool res 100 5         R.withResource resPool $ \ pool -> do             let res = initInPool pool             forM_ [1..1000] $ \ k -> forkIO. R.withResource res $ \ i -> do                 atomicAddCounter_ workerCounter 1                 r <- readPrimIORef resCounter-                threadDelay (k * 1000)+                threadDelay 1000000                 assertEqual "pool should limit max usage" True (r <= 100) -            threadDelay 5000000 -- first 100 worker quickly get resources-                                -- then hold for 1s, rest 100 worker have to wait, and so on-                                -- so here we wait for 5s to make sure every worker got a resource-                                -- we used to use replicateConcurrently_ from async, but it's-                                -- not really neccessary+            threadDelay 13000000+            -- first 100 worker quickly get resources+            -- then hold for 1s, rest 100 worker have to wait, and so on+            -- so here we wait for 5s to make sure every worker got a resource+            -- we used to use replicateConcurrently_ from async, but it's+            -- not really neccessary              w <- readPrimIORef workerCounter             assertEqual "worker should be able to get resource" 1000 w@@ -52,7 +53,7 @@             r <- readPrimIORef resCounter             assertEqual "pool should reap unused resources" 0 r -            threadDelay 1200000  -- another 1.2s+            threadDelay 5000000  -- another 5s              s <- poolStat pool             assertEqual "pool should stop scanning returned resources" PoolEmpty s@@ -64,11 +65,11 @@             forM_ [1..1000] $ \ k -> forkIO. R.withResource res $ \ i -> do                 atomicAddCounter_ workerCounter 1                 r <- readPrimIORef resCounter-                threadDelay (k * 1000)+                threadDelay 1000000                 assertEqual "pool should limit max usage" True (r <= 100)  -            threadDelay 5000000+            threadDelay 12000000              w <- readPrimIORef workerCounter             assertEqual "worker should be able to get resource" 1000 w@@ -79,13 +80,11 @@             s <- poolStat pool             assertEqual "pool should be scanning returned resources" PoolScanning s -            threadDelay 5000000  -- after 5s, 1000 thread should release all resources+            threadDelay 10000000              r <- readPrimIORef resCounter             assertEqual "pool should reap unused resources" 0 r -            threadDelay 1200000  -- another 1.2s-             s <- poolStat pool             assertEqual "pool should stop scanning returned resources" PoolEmpty s @@ -93,17 +92,17 @@         resCounter <- newCounter 0         let res = initResource (atomicAddCounter' resCounter 1)                                (\ _ -> atomicSubCounter_ resCounter 1)-            resPool = initPool res 100 1+            resPool = initPool res 100 5         R.withResource resPool $ \ pool -> do             let res = initInPool pool              forM_ [1..1000] $ \ k -> forkIO. R.withResource res $ \ i -> do                 r <- readPrimIORef resCounter-                threadDelay (k * 1000)+                threadDelay 1000000                 when (even i) (throwIO WorkerException)                 assertEqual "pool should limit max usage" True (r <= 100) -            threadDelay 5000000+            threadDelay 12000000              r <- readPrimIORef resCounter             assertEqual "pool should keep returned resources alive" 100 r@@ -111,12 +110,10 @@             s <- poolStat pool             assertEqual "pool should be scanning returned resources" PoolScanning s -            threadDelay 5000000  -- after 5s, 1000 thread should release all resources+            threadDelay 10000000              r <- readPrimIORef resCounter             assertEqual "pool should reap unused resources" 0 r--            threadDelay 2000000  -- after 2s, scanning thread should stoped              s <- poolStat pool             assertEqual "pool should stop scanning returned resources" PoolEmpty s