Z-IO 0.8.1.1 → 1.0.0.0

raw patch · 40 files changed

+1483/−914 lines, 40 filesdep +foldldep ~Z-DataPVP ok

version bump matches the API change (PVP)

Dependencies added: foldl

Dependency ranges changed: Z-Data

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• Z-IO.cabal +7/−5
• Z/IO.hs +4/−3
• Z/IO/BIO.hs +33/−671
• Z/IO/BIO/Base.hs +751/−0
• Z/IO/BIO/Concurrent.hs +17/−13
• Z/IO/BIO/Zlib.hsc +16/−1
• Z/IO/Buffered.hs +61/−44
• Z/IO/Environment.hs +23/−1
• Z/IO/Exception.hs +6/−0
• Z/IO/FileSystem/Base.hs +40/−1
• Z/IO/FileSystem/FilePath.hsc +27/−2
• Z/IO/FileSystem/Threaded.hs +41/−1
• Z/IO/FileSystem/Watch.hs +9/−8
• Z/IO/Logger.hs +30/−15
• Z/IO/LowResTimer.hs +8/−3
• Z/IO/Network/DNS.hsc +12/−3
• Z/IO/Network/IPC.hs +5/−0
• Z/IO/Network/SocketAddr.hsc +71/−11
• Z/IO/Network/TCP.hs +9/−0
• Z/IO/Network/UDP.hs +28/−7
• Z/IO/Process.hsc +12/−1
• Z/IO/Resource.hs +10/−5
• Z/IO/StdStream.hs +11/−5
• Z/IO/StdStream/Ansi.hs +81/−24
• Z/IO/Time.hs +10/−2
• Z/IO/UV/Errno.hsc +2/−0
• Z/IO/UV/FFI.hsc +14/−0
• Z/IO/UV/FFI_Env.hsc +8/−0
• Z/IO/UV/Manager.hs +13/−2
• Z/IO/UV/UVStream.hs +7/−0
• Z/IO/UV/Win.hs +1/−1
• include/fs_shared.hs +31/−8
• test/Z/IO/BIO/BaseSpec.hs +45/−0
• test/Z/IO/BIO/ConcurrentSpec.hs +16/−17
• test/Z/IO/BIO/ZlibSpec.hs +1/−0
• test/Z/IO/BIOSpec.hs +0/−45
• test/Z/IO/LowResTimerSpec.hs +4/−4
• test/Z/IO/Network/UDPSpec.hs +2/−2
• test/Z/IO/ResourceSpec.hs +9/−9

@@ -1,5 +1,13 @@ # Revision history for Z-IO +## 1.0.0.0  -- 2020-07-08++* Clean function names in `Z.IO.BIO` module, now no `BIO` or `Node` suffix anymore.+* `Z.IO.BIO` is not re-exported from `Z.IO` anymore, user are recommended to import it with qualified name, e.g. `import qualified Z.IO.BIO as BIO`.+* Add `foldl'` and `foldIO'` to `Z.IO.BIO` to use with `Fold` and `FoldM` from `foldl` package.+* Add `INLINABLE` pragmas to many functions.+* Add `printStdLnP` to `Z.IO.StdStream`, a `Parser` debug tool.+ ## 0.8.1.0  -- 2020-06-12  * Remove `-march=native` flag to improve binary portability.

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               Z-IO-version:            0.8.1.1+version:            1.0.0.0 synopsis:           Simple and high performance IO toolkit for Haskell description:   Simple and high performance IO toolkit for Haskell, including@@ -85,6 +85,7 @@   exposed-modules:     Z.IO     Z.IO.BIO+    Z.IO.BIO.Base     Z.IO.BIO.Concurrent     Z.IO.BIO.Zlib     Z.IO.Buffered@@ -119,12 +120,13 @@     , base                  >=4.12  && <5.0     , containers            ^>=0.6     , exceptions            ^>=0.10+    , foldl                 >= 1.3  && <2.0     , primitive             >=0.7.1 && <0.7.2     , stm                   ^>=2.5     , time                  >=1.9   && <2.0     , unix-time             >=0.4.7 && <0.5     , unordered-containers  ^>=0.2-    , Z-Data                >=0.8.1 && <0.9+    , Z-Data                >=1.0   && <1.1    default-language:   Haskell2010   default-extensions:@@ -301,7 +303,7 @@         third_party/libuv/include third_party/libuv/src/unix         third_party/libuv/src -      cc-options:   -Wall +      cc-options:   -Wall -D_GNU_SOURCE -D_POSIX_C_SOURCE=200112      else       if os(osx)@@ -346,7 +348,7 @@           third_party/libuv/include third_party/libuv/src/unix           third_party/libuv/src -        cc-options:   -Wall +        cc-options:   -Wall -D_DARWIN_UNLIMITED_SELECT=1 -D_DARWIN_USE_64_BIT_INODE=1        else         if flag(no-pkg-config)@@ -376,7 +378,7 @@   other-modules:     Z.IO.BIO.ConcurrentSpec     Z.IO.BIO.ZlibSpec-    Z.IO.BIOSpec+    Z.IO.BIO.BaseSpec     Z.IO.FileSystem.ThreadedSpec     Z.IO.FileSystemSpec     Z.IO.LowResTimerSpec

@@ -13,19 +13,20 @@ -}  module Z.IO-  ( module Z.IO.BIO-  , module Z.IO.Buffered+  ( module Z.IO.Buffered   , module Z.IO.Environment   , module Z.IO.Exception   , module Z.IO.Logger   , module Z.IO.Resource   , module Z.IO.StdStream+  , forkBa   ) where -import Z.IO.BIO import Z.IO.Buffered import Z.IO.Environment import Z.IO.Exception import Z.IO.Logger import Z.IO.Resource import Z.IO.StdStream+import Z.IO.UV.Manager (forkBa)+

@@ -1,5 +1,5 @@ {-|-Module      : Z.IO.BIO+Module      : Z.IO.BIO.Base Description : Composable IO Loops Copyright   : (c) Dong Han, 2017-2020 License     : BSD@@ -36,7 +36,7 @@      withResource (initSourceFromFile origin) $ \ src ->         withResource (initSinkToFile target) $ \ sink ->-            runBIO_ $ src . base64Enc . zlibCompressor . sink+            run_ $ src . base64Enc . zlibCompressor . sink  > base64AndCompressFile "test" "test.gz" -- run 'zcat "test.gz" | base64 -d' will give you original file@@ -47,6 +47,7 @@ import           Z.IO.BIO (BIO, Source, Sink) import qualified Z.IO.BIO as BIO @+ -} module Z.IO.BIO (   -- * The BIO type@@ -56,13 +57,15 @@   , joinSink, fuseSink   -- * Run BIO chain   , discard-  , stepBIO, stepBIO_-  , runBIO, runBIO_+  , step, step_+  , run, run_   , runBlock, runBlock_, unsafeRunBlock   , runBlocks, runBlocks_, unsafeRunBlocks   -- * Make new BIO-  , pureBIO, ioBIO-  , filter, filterM+  , fromPure, fromIO+  , filter, filterIO+  -- * Use with fold+  , fold', foldIO'   -- ** Source   , initSourceFromFile   , initSourceFromFile'@@ -82,672 +85,31 @@   -- ** Bytes specific   , newReChunk   , newUTF8Decoder-  , newParserNode, newMagicSplitter, newLineSplitter+  , newParser, newMagicSplitter, newLineSplitter   , newBase64Encoder, newBase64Decoder-  , hexEncoder, newHexDecoder+  , hexEncode+  , newHexDecoder   -- ** Generic BIO-  , counterNode-  , seqNumNode-  , newGroupingNode-  , ungroupingNode-  , consumedNode+  , counter+  , seqNum+  , newGrouping+  , ungrouping+  , consumed+  -- * Concurrent helpers+  , zip, newTQueuePair, newTBQueuePair, newBroadcastTChanPair+  -- * Zlib BIO+  , newCompress, compressReset+  , CompressConfig(..)+  , defaultCompressConfig+  , newDecompress, decompressReset+  , DecompressConfig(..)+  , defaultDecompressConfig+  , MemLevel+  , defaultMemLevel+  , ZStream   ) where -import           Prelude                hiding (filter)-import           Control.Concurrent.MVar-import           Control.Monad          hiding  (filterM)-import           Control.Monad.IO.Class-import           Data.Bits              ((.|.))-import           Data.IORef-import qualified Data.List              as List-import           Data.Void-import           Data.Word-import           System.IO.Unsafe       (unsafePerformIO)-import qualified Z.Data.Array           as A-import qualified Z.Data.Builder         as B-import           Z.Data.CBytes          (CBytes)-import qualified Z.Data.JSON            as JSON-import qualified Z.Data.Parser          as P-import           Z.Data.PrimRef-import qualified Z.Data.Text            as T-import qualified Z.Data.Text.UTF8Codec  as T-import qualified Z.Data.Vector          as V-import qualified Z.Data.Vector.Base     as V-import           Z.Data.Vector.Base64-import           Z.Data.Vector.Hex-import           Z.IO.Buffered-import           Z.IO.Exception-import qualified Z.IO.FileSystem.Base   as FS-import           Z.IO.Resource---- | A 'BIO'(blocked IO) node.------ A 'BIO' node is a push based stream transformer. It can be used to describe different kinds of IO--- devices:------  * @BIO inp out@ describe an IO state machine(e.g. z_stream in zlib),---    which takes some input in block, then outputs.---  * @type Source out = BIO Void out@ described an IO source, which never takes input,---    but gives output until EOF by looping.---  * @type Sink inp = BIO inp Void@ described an IO sink, which takes input and perform some IO effects,---    such as writing to terminal or files.------ You can connect these 'BIO' nodes with '>|>', which connect left node's output to right node's input,--- and return a new 'BIO' node with left node's input type and right node's output type.------ You can run a 'BIO' node in different ways:------   * 'stepBIO'\/'stepBIO_' to supply a single chunk of input and step the BIO node.---   * 'runBIO'\/'runBIO_' will supply EOF directly, which will effectively pull all values from source,---     and push to sink until source reaches EOF.---   * 'runBlock'\/'runBlock_' will supply a single block of input as whole input and run the BIO node.---   * 'runBlocks'\/'runBlocks_' will supply a list of blocks as whole input and run the BIO node.------ Note 'BIO' usually contains some IO states, you can consider it as an opaque 'IORef':------   * 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.------ 'BIO' is simply a convenient way to construct single-thread streaming computation, to use 'BIO'--- in multiple threads, check "Z.IO.BIO.Concurrent" module.----type BIO inp out = (Maybe out -> IO ())     -- ^ Pass 'EOF' to indicate current node reaches EOF-                -> Maybe inp                -- ^ 'EOF' indicates upstream reaches EOF-                -> IO ()---- | Patterns for more meaningful pattern matching.-pattern EOF :: Maybe a-pattern EOF = Nothing---- | Type alias for 'BIO' node which never takes input.------ Note when implement a 'Source', you should assume 'EOF' argument is supplied only once, and you--- should loop to call downstream continuation with all available chunks, then write a final 'EOF'--- to indicate EOF.-type Source x = BIO Void x---- | Type alias for 'BIO' node which only takes input and perform effects.------ Note when implement a 'Sink', you should assume 'EOF' argument is supplied only once(when upstream--- reaches EOF), you do not need to call downstream continuation before EOF, and--- do a flush(also write a final 'EOF') when upstream reach EOF.-type Sink x = BIO x Void---- | Connect two 'BIO' source, after first reach EOF, draw elements from second.-appendSource :: HasCallStack => Source a -> Source a -> Source a-{-# INLINE appendSource #-}-b1 `appendSource` b2 = \ k _ ->-    b1 (\ y ->-        case y of Just _ -> k y-                  _      -> b2 k EOF) EOF---- | Fuse two 'BIO' sinks, i.e. everything written to the fused sink will be written to left and right sink.------ Flush result 'BIO' will effectively flush both sink.-joinSink :: HasCallStack => Sink out -> Sink out -> Sink out-{-# INLINE joinSink #-}-b1 `joinSink` b2 = \ k mx ->-    case mx of-        Just _ -> do-            b1 discard mx-            b2 discard mx-        _ -> do-            b1 discard EOF-            b2 discard EOF-            k EOF---- | Fuse a list of 'BIO' sinks, everything written to the fused sink will be written to every sink in the list.------ Flush result 'BIO' will effectively flush every sink in the list.-fuseSink :: HasCallStack => [Sink out] -> Sink out-{-# INLINABLE fuseSink #-}-fuseSink ss = \ k mx ->-    case mx of-        Just _ -> mapM_ (\ s -> s discard mx) ss-        _ -> do-            mapM_ (\ s -> s discard mx) ss-            k EOF---- | Connect list of 'BIO' sources, after one reach EOF, draw element from next.-concatSource :: HasCallStack => [Source a] -> Source a-{-# INLINABLE concatSource #-}-concatSource = List.foldl' appendSource emptySource---- | A 'Source' directly write EOF to downstream.-emptySource :: Source a-{-# INLINABLE emptySource #-}-emptySource = \ k _ -> k EOF---- | Connect list of 'BIO' sources, after one reach EOF, draw element from next.-concatSource' :: HasCallStack => Source (Source a) -> Source a-{-# INLINABLE concatSource' #-}-concatSource' ssrc = \ k _ -> ssrc (\ msrc ->-    case msrc of-        Just src -> src (\ mx ->-            case mx of Just _ -> k mx-                       _ -> return ()) EOF-        _ -> k EOF) EOF------------------------------------------------------------------------------------ Run BIO---- | Discards a value.-discard :: a -> IO ()-{-# INLINABLE discard #-}-discard _ = return ()---- | Supply a single chunk of input to a 'BIO' and collect result.-stepBIO :: HasCallStack => BIO inp out -> inp -> IO [out]-{-# INLINABLE stepBIO #-}-stepBIO bio inp = do-    accRef <- newIORef []-    bio (mapM_  $ \ x -> modifyIORef' accRef (x:)) (Just inp)-    reverse <$> readIORef accRef---- | Supply a single chunk of input to a 'BIO' without collecting result.-stepBIO_ :: HasCallStack => BIO inp out -> inp -> IO ()-{-# INLINABLE stepBIO_ #-}-stepBIO_ bio = bio discard . Just---- | Run a 'BIO' loop without providing input.------ When used on 'Source', it starts the streaming loop.--- When used on 'Sink', it performs a flush.-runBIO_ :: HasCallStack => BIO inp out -> IO ()-{-# INLINABLE runBIO_ #-}-runBIO_ bio = bio discard EOF---- | Run a 'BIO' loop without providing input, and collect result.------ When used on 'Source', it will collect all input chunks.-runBIO :: HasCallStack => BIO inp out -> IO [out]-{-# INLINABLE runBIO #-}-runBIO bio = do-    accRef <- newIORef []-    bio (mapM_  $ \ x -> modifyIORef' accRef (x:)) EOF-    reverse <$> readIORef accRef---- | Run a 'BIO' loop with a single chunk of input and EOF, and collect result.----runBlock :: HasCallStack => BIO inp out -> inp -> IO [out]-{-# INLINABLE runBlock #-}-runBlock bio inp = do-    accRef <- newIORef []-    bio (mapM_  $ \ x -> modifyIORef' accRef (x:)) (Just inp)-    bio (mapM_  $ \ x -> modifyIORef' accRef (x:)) EOF-    reverse <$> readIORef accRef---- | Run a 'BIO' loop with a single chunk of input and EOF, without collecting result.----runBlock_ :: HasCallStack => BIO inp out -> inp -> IO ()-{-# INLINABLE runBlock_ #-}-runBlock_ bio inp = do-    bio discard (Just inp)-    bio discard EOF---- | Wrap 'runBlock' into a pure interface.------ You can wrap a stateful BIO computation(including the creation of 'BIO' node),--- when you can guarantee a computation is pure, e.g. compressing, decoding, etc.-unsafeRunBlock :: HasCallStack => IO (BIO inp out) -> inp -> [out]-{-# INLINABLE unsafeRunBlock #-}-unsafeRunBlock new inp = unsafePerformIO (new >>= \ bio -> runBlock bio inp)---- | Supply blocks of input and EOF to a 'BIO', and collect results.------ Note many 'BIO' node will be closed or not be able to take new input after drained.-runBlocks :: HasCallStack => BIO inp out -> [inp] -> IO [out]-{-# INLINABLE runBlocks #-}-runBlocks bio inps = do-    accRef <- newIORef []-    forM_ inps $ bio (mapM_  $ \ x -> modifyIORef' accRef (x:)) . Just-    bio (mapM_  $ \ x -> modifyIORef' accRef (x:)) EOF-    reverse <$> readIORef accRef---- | Supply blocks of input and EOF to a 'BIO', without collecting results.------ Note many 'BIO' node will be closed or not be able to take new input after drained.-runBlocks_ :: HasCallStack => BIO inp out -> [inp] -> IO ()-{-# INLINABLE runBlocks_ #-}-runBlocks_ bio inps = do-    forM_ inps $ bio discard . Just-    bio discard EOF---- | Wrap 'runBlocks' into a pure interface.------ Similar to 'unsafeRunBlock', but with a list of input blocks.-unsafeRunBlocks :: HasCallStack => IO (BIO inp out) -> [inp] -> [out]-{-# INLINABLE unsafeRunBlocks #-}-unsafeRunBlocks new inps = unsafePerformIO (new >>= \ bio -> runBlocks bio inps)------------------------------------------------------------------------------------ Source---- | Source a list(or any 'Foldable') from memory.----sourceFromList :: Foldable f => f a -> Source a-sourceFromList xs0 = \ k _ -> do-    mapM_ (k . Just) xs0-    k EOF---- | Turn a 'BufferedInput' into 'BIO' source, map EOF to EOF.----sourceFromBuffered :: HasCallStack => BufferedInput -> Source V.Bytes-{-# INLINABLE sourceFromBuffered #-}-sourceFromBuffered i = \ k _ ->-    let loop = readBuffer i >>= \ x ->-            if V.null x then k EOF else k (Just x) >> loop-    in loop---- | Turn a `IO` action into 'Source'-sourceFromIO :: HasCallStack => IO (Maybe a) -> Source a-{-# INLINABLE sourceFromIO #-}-sourceFromIO io = \ k _ ->-    let loop = io >>= \ x ->-            case x of-                Just _ -> k x >> loop-                _      -> k EOF-    in loop---- | Turn a UTF8 encoded 'BufferedInput' into 'BIO' source, map EOF to EOF.----sourceTextFromBuffered :: HasCallStack => BufferedInput -> Source T.Text-{-# INLINABLE sourceTextFromBuffered #-}-sourceTextFromBuffered i = \ k _ ->-    let loop = readBufferText i >>= \ x ->-            if T.null x then k EOF else k (Just x) >> loop-    in loop---- | Turn a 'JSON' encoded 'BufferedInput' into 'BIO' source, ignoring any--- whitespaces bewteen JSON objects. If EOF reached, then return 'EOF'.--- Throw 'OtherError' with name "EJSON" if JSON value is not parsed or converted.----sourceJSONFromBuffered :: forall a. (JSON.JSON a, HasCallStack) => BufferedInput -> Source a-{-# INLINABLE sourceJSONFromBuffered #-}-sourceJSONFromBuffered = sourceParseChunkFromBuffered JSON.decodeChunk---- | Turn buffered input device into a packet source, throw 'OtherError' with name @EPARSE@ if parsing fail.-sourceParserFromBuffered :: HasCallStack => P.Parser a -> BufferedInput -> Source a-{-# INLINABLE sourceParserFromBuffered #-}-sourceParserFromBuffered p = sourceParseChunkFromBuffered (P.parseChunk p)---- | Turn buffered input device into a packet source, throw 'OtherError' with name @EPARSE@ if parsing fail.-sourceParseChunkFromBuffered :: (HasCallStack, T.Print e)-                              => (V.Bytes -> P.Result e a) -> BufferedInput -> Source a-{-# INLINABLE sourceParseChunkFromBuffered #-}-sourceParseChunkFromBuffered pc bi = \ k _ ->-    let loopA = do-            bs <- readBuffer bi-            if V.null bs-            then k EOF-            else loopB bs-        loopB bs = do-            (rest, r) <- P.parseChunks pc (readBuffer bi) bs-            case r of Right v -> k (Just v)-                      Left e  -> throwOtherError "EPARSE" (T.toText e)-            if V.null rest-            then loopA-            else loopB rest-    in loopA---- | Turn a file into a 'V.Bytes' source.-initSourceFromFile :: HasCallStack => CBytes -> Resource (Source V.Bytes)-{-# INLINABLE initSourceFromFile #-}-initSourceFromFile p = do-    f <- FS.initFile p FS.O_RDONLY FS.DEFAULT_FILE_MODE-    liftIO (sourceFromBuffered <$> newBufferedInput f)---- | Turn a file into a 'V.Bytes' source with given chunk size.-initSourceFromFile' :: HasCallStack => CBytes -> Int -> Resource (Source V.Bytes)-{-# INLINABLE initSourceFromFile' #-}-initSourceFromFile' p bufSiz = do-    f <- FS.initFile p FS.O_RDONLY FS.DEFAULT_FILE_MODE-    liftIO (sourceFromBuffered <$> newBufferedInput' bufSiz f)------------------------------------------------------------------------------------- Sink---- | Turn a 'BufferedOutput' into a 'V.Bytes' sink.-sinkToBuffered :: HasCallStack => BufferedOutput -> Sink V.Bytes-{-# INLINABLE sinkToBuffered #-}-sinkToBuffered bo = \ k mbs ->-    case mbs of-        Just bs -> writeBuffer bo bs-        _       -> flushBuffer bo >> k EOF---- | Turn a 'BufferedOutput' into a 'B.Builder' sink.----sinkBuilderToBuffered :: HasCallStack => BufferedOutput -> Sink (B.Builder a)-{-# INLINABLE sinkBuilderToBuffered #-}-sinkBuilderToBuffered bo = \ k mbs ->-    case mbs of-        Just bs -> writeBuilder bo bs-        _       -> flushBuffer bo >> k EOF---- | Turn a file into a 'V.Bytes' sink.------ Note the file will be opened in @'FS.O_APPEND' .|. 'FS.O_CREAT' .|. 'FS.O_WRONLY'@ mode,--- bytes will be written after the end of the original file if there'are old bytes.-initSinkToFile :: HasCallStack => CBytes -> Resource (Sink V.Bytes)-{-# INLINABLE initSinkToFile #-}-initSinkToFile p = do-    f <- FS.initFile p (FS.O_APPEND .|. FS.O_CREAT .|. FS.O_WRONLY) FS.DEFAULT_FILE_MODE-    liftIO (sinkToBuffered <$> newBufferedOutput f)---- | Turn an `IO` action into 'BIO' sink.----sinkToIO :: HasCallStack => (a -> IO ()) -> Sink a-{-# INLINABLE sinkToIO #-}-sinkToIO f = \ k ma ->-    case ma of-        Just a -> f a-        _ -> k EOF---- | Turn an `IO` action(and a flush action), into 'BIO' sink.----sinkToIO' :: HasCallStack => (a -> IO ()) -> IO () -> Sink a-{-# INLINABLE sinkToIO' #-}-sinkToIO' f flush = \ k ma ->-    case ma of-        Just a -> f a-        _ -> flush >> k EOF---- | Sink to a list in memory.------ The 'MVar' will be empty during sinking, and will be filled after sink receives an EOF.-sinkToList :: IO (MVar [a], Sink a)-sinkToList = do-    xsRef <- newIORef []-    rRef <- newEmptyMVar-    return (rRef, sinkToIO' (\ x -> modifyIORef xsRef (x:))-                            (do modifyIORef xsRef reverse-                                xs <- readIORef xsRef-                                putMVar rRef xs))------------------------------------------------------------------------------------- Nodes---- | BIO node from a pure function.------ BIO node made with this funtion are stateless, thus can be reused across chains.-pureBIO :: (a -> b) -> BIO a b-{-# INLINE pureBIO #-}-pureBIO f = \ k x -> k (f <$> x)---- | BIO node from an IO function.------ BIO node made with this funtion may not be stateless, it depends on if the IO function use--- IO state.-ioBIO :: HasCallStack => (a -> IO b) -> BIO a b-{-# INLINE ioBIO #-}-ioBIO f = \ k x ->-    case x of Just x' -> f x' >>= k . Just-              _ -> k EOF---- | BIO node from a pure filter.------ BIO node made with this funtion are stateless, thus can be reused across chains.-filter ::  (a -> Bool) -> BIO a a-filter f k = go-  where-    go (Just a) = when (f a) $ k (Just a)-    go Nothing = k Nothing---- | BIO node from an impure filter.------ BIO node made with this funtion may not be stateless, it depends on if the IO function use-filterM ::  (a -> IO Bool) -> BIO a a-filterM f k = go-  where-    go (Just a) = do-        mbool <- f a-        when mbool $ k (Just a)-    go Nothing = k Nothing---- | Make a chunk size divider.------ A divider size divide each chunk's size to the nearest multiplier to granularity,--- last trailing chunk is directly returned.-newReChunk :: Int                -- ^ chunk granularity-           -> IO (BIO V.Bytes V.Bytes)-{-# INLINABLE newReChunk #-}-newReChunk n = do-    trailingRef <- newIORef V.empty-    return $ \ k mbs ->-        case mbs of-            Just bs -> do-                trailing <- readIORef trailingRef-                let chunk =  trailing `V.append` bs-                    l = V.length chunk-                if l >= n-                then do-                    let l' = l - (l `rem` n)-                        (chunk', rest) = V.splitAt l' chunk-                    writeIORef trailingRef rest-                    k (Just chunk')-                else writeIORef trailingRef chunk-            _ -> do-                trailing <- readIORef trailingRef-                unless (V.null trailing) $ do-                    writeIORef trailingRef V.empty-                    k (Just trailing)-                k EOF---- | Read buffer and parse with 'Parser'.------ This function will turn a 'Parser' into a 'BIO', throw 'OtherError' with name @EPARSE@ if parsing fail.----newParserNode :: HasCallStack => P.Parser a -> IO (BIO V.Bytes a)-{-# INLINABLE newParserNode #-}-newParserNode p = do-    -- type LastParseState = Maybe (V.Bytes -> P.Result)-    resultRef <- newIORef EOF-    return $ \ k mbs -> do-        let loop f chunk = case f chunk of-                P.Success a trailing -> do-                    k (Just a)-                    unless (V.null trailing) (loop f trailing)-                P.Partial f' ->-                    writeIORef resultRef (Just f')-                P.Failure e _ ->-                    throwOtherError "EPARSE" (T.toText e)-        lastResult <- readIORef resultRef-        case mbs of-            Just bs -> do-                let f = case lastResult of-                        Just x    -> x-                        _         -> P.parseChunk p-                loop f bs-            _ ->-                case lastResult of-                    Just f -> loop f V.empty-                    _ -> k EOF---- | Make a new UTF8 decoder, which decode bytes streams into text streams.------ If there're invalid UTF8 bytes, an 'OtherError' with name 'EINVALIDUTF8' will be thrown.`------ Note this node is supposed to be used with preprocess node such as decompressor, parser, etc.--- where bytes boundary cannot be controlled, UTF8 decoder will concat trailing bytes from last block to next one.--- Use this node directly with 'sourceFromBuffered' will not be as efficient as directly use--- 'sourceTextFromBuffered', because 'BufferedInput' provides push back capability,--- trailing bytes can be pushed back to reading buffer then returned with next block input together.----newUTF8Decoder :: HasCallStack => IO (BIO V.Bytes T.Text)-{-# INLINABLE newUTF8Decoder #-}-newUTF8Decoder = do-    trailingRef <- newIORef V.empty-    return $ \ k mbs -> do-        case mbs of-            Just bs -> do-                trailing <- readIORef trailingRef-                let chunk =  trailing `V.append` bs-                    (V.PrimVector arr s l) = chunk-                if l > 0 && T.decodeCharLen arr s <= l-                then do-                    let (i, _) = V.findR (\ w -> w >= 0b11000000 || w <= 0b01111111) chunk-                    if (i == -1)-                    then throwOtherError "EINVALIDUTF8" "invalid UTF8 bytes"-                    else do-                        if T.decodeCharLen arr (s + i) > l - i-                        then do-                            writeIORef trailingRef (V.fromArr arr (s+i) (l-i))-                            k (Just (T.validate (V.fromArr arr s i)))-                        else do-                            writeIORef trailingRef V.empty-                            k (Just (T.validate chunk))-                else writeIORef trailingRef chunk--            _ -> do-                trailing <- readIORef trailingRef-                if V.null trailing-                then k EOF-                else throwOtherError "EINVALIDUTF8" "invalid UTF8 bytes"---- | Make a new stream splitter based on magic byte.----newMagicSplitter :: Word8 -> IO (BIO V.Bytes V.Bytes)-{-# INLINABLE newMagicSplitter #-}-newMagicSplitter magic = do-    trailingRef <- newIORef V.empty-    return $ \ k mx ->-        case mx of-            Just bs -> do-                trailing <- readIORef trailingRef-                let loop chunk = case V.elemIndex magic chunk of-                        Just i -> do-                            -- TODO: looping-                            let (line, rest) = V.splitAt (i+1) chunk-                            k (Just line)-                            loop rest-                        _ -> writeIORef trailingRef chunk-                loop (trailing `V.append` bs)-            _ -> do-                chunk <- readIORef trailingRef-                unless (V.null chunk) $ do-                    writeIORef trailingRef V.empty-                    k (Just chunk)-                k EOF---- | Make a new stream splitter based on linefeed(@\r\n@ or @\n@).------ The result bytes doesn't contain linefeed.-newLineSplitter :: IO (BIO V.Bytes V.Bytes)-{-# INLINABLE newLineSplitter #-}-newLineSplitter = do-    s <- newMagicSplitter 10-    return (s . pureBIO dropLineEnd)-  where-    dropLineEnd bs@(V.PrimVector arr s l) =-        case bs `V.indexMaybe` (l-2) of-            Just r | r == 13   -> V.PrimVector arr s (l-2)-                   | otherwise -> V.PrimVector arr s (l-1)-            _ | V.head bs == 10 -> V.PrimVector arr s (l-1)-              | otherwise -> V.PrimVector arr s l---- | Make a new base64 encoder node.-newBase64Encoder :: IO (BIO V.Bytes V.Bytes)-{-# INLINABLE newBase64Encoder #-}-newBase64Encoder = do-    re <- newReChunk 3-    return (re . pureBIO base64Encode)---- | Make a new base64 decoder node.-newBase64Decoder :: HasCallStack => IO (BIO V.Bytes V.Bytes)-{-# INLINABLE newBase64Decoder #-}-newBase64Decoder = do-    re <- newReChunk 4-    return (re . pureBIO base64Decode')---- | Make a hex encoder node.------ Hex encoder is stateless, it can be reused across chains.-hexEncoder :: Bool   -- ^ uppercase?-           -> BIO V.Bytes V.Bytes-{-# INLINABLE hexEncoder #-}-hexEncoder upper = pureBIO (hexEncode upper)---- | Make a new hex decoder node.-newHexDecoder :: IO (BIO V.Bytes V.Bytes)-{-# INLINABLE newHexDecoder #-}-newHexDecoder = do-    re <- newReChunk 2-    return (re . pureBIO hexDecode')---- | Make a new BIO node which counts items flow throught it.------ 'Counter' is increased atomically, it's safe to read \/ reset the counter from other threads.-counterNode :: Counter -> BIO a a-{-# INLINABLE counterNode #-}-counterNode c = ioBIO inc-  where-    inc x = do-        atomicAddCounter_ c 1-        return x---- | Make a new BIO node which counts items, and label item with a sequence number.------ 'Counter' is increased atomically, it's safe to read \/ reset the counter from other threads.-seqNumNode :: Counter -> BIO a (Int, a)-{-# INLINABLE seqNumNode #-}-seqNumNode c = ioBIO inc-  where-    inc x = do-        i <- atomicAddCounter c 1-        return (i, x)---- | Make a BIO node grouping items into fixed size arrays.------ Trailing items are directly returned.-newGroupingNode :: Int -> IO (BIO a (V.Vector a))-{-# INLINABLE newGroupingNode #-}-newGroupingNode n-    | n < 1 =  newGroupingNode 1-    | otherwise = do-        c <- newCounter 0-        arrRef <- newIORef =<< A.newArr n-        return $ \ k mx ->-            case mx of-                Just x -> do-                    i <- readPrimIORef c-                    if i == n - 1-                    then do-                        marr <- readIORef arrRef-                        A.writeArr marr i x-                        writePrimIORef c 0-                        writeIORef arrRef =<< A.newArr n-                        arr <- A.unsafeFreezeArr marr-                        k . Just $! V.fromArr arr 0 n-                    else do-                        marr <- readIORef arrRef-                        A.writeArr marr i x-                        writePrimIORef c (i+1)-                _ -> do-                    i <- readPrimIORef c-                    if i /= 0-                    then do-                        writePrimIORef c 0-                        marr <- readIORef arrRef-                        A.shrinkMutableArr marr i-                        arr <- A.unsafeFreezeArr marr-                        k . Just $! V.fromArr arr 0 i-                    else k EOF---- | A BIO node flatten items.----ungroupingNode :: BIO (V.Vector a) a-{-# INLINABLE ungroupingNode #-}-ungroupingNode = \ k mx ->-    case mx of-        Just x -> V.traverseVec_ (k . Just) x-        _      -> k EOF---- | A BIO node which write 'True' to 'IORef' when 'EOF' is reached.-consumedNode :: IORef Bool -> BIO a a-{-# INLINABLE consumedNode #-}-consumedNode ref = \ k mx -> case mx of-    Just _ -> k mx-    _ -> do writeIORef ref True-            k EOF--+import Z.IO.BIO.Base+import Z.IO.BIO.Concurrent+import Z.IO.BIO.Zlib+import           Prelude                hiding (filter, zip)

@@ -0,0 +1,751 @@+{-|+Module      : Z.IO.BIO.Base+Description : Composable IO Loops+Copyright   : (c) Dong Han, 2017-2020+License     : BSD+Maintainer  : winterland1989@gmail.com+Stability   : experimental+Portability : non-portable++This module provides 'BIO' (block IO) type to facilitate writing streaming programs. A 'BIO' node usually:++  * Process input in unit of block(or item).+  * Running in constant spaces, which means the memory usage won't accumulate.+  * Keep some state in IO, which is sealed in 'BIO' closure.++-}+module Z.IO.BIO.Base (+  -- * The BIO type+    BIO, pattern EOF, Source, Sink+  -- ** Basic combinators+  , appendSource, concatSource, concatSource'+  , joinSink, fuseSink+  -- * Run BIO chain+  , discard+  , step, step_+  , run, run_+  , runBlock, runBlock_, unsafeRunBlock+  , runBlocks, runBlocks_, unsafeRunBlocks+  -- * Make new BIO+  , fromPure, fromIO+  , filter, filterIO+  -- * Use with fold+  , fold', foldIO'+  -- ** Source+  , initSourceFromFile+  , initSourceFromFile'+  , sourceFromIO+  , sourceFromList+  , sourceFromBuffered+  , sourceTextFromBuffered+  , sourceJSONFromBuffered+  , sourceParserFromBuffered+  , sourceParseChunkFromBuffered+  -- ** Sink+  , sinkToIO+  , sinkToList+  , initSinkToFile+  , sinkToBuffered+  , sinkBuilderToBuffered+  -- ** Bytes specific+  , newReChunk+  , newUTF8Decoder+  , newParser, newMagicSplitter, newLineSplitter+  , newBase64Encoder, newBase64Decoder+  , hexEncode+  , newHexDecoder+  -- ** Generic BIO+  , counter+  , seqNum+  , newGrouping+  , ungrouping+  , consumed+  ) where++import           Prelude                hiding (filter)+import           Control.Concurrent.MVar+import           Control.Concurrent.STM+import qualified Control.Foldl          as L+import           Control.Monad+import           Control.Monad.IO.Class+import           Data.Bits              ((.|.))+import           Data.IORef+import qualified Data.List              as List+import           Data.Void+import           Data.Word+import           System.IO.Unsafe       (unsafePerformIO)+import qualified Z.Data.Array           as A+import qualified Z.Data.Builder         as B+import           Z.Data.CBytes          (CBytes)+import qualified Z.Data.JSON            as JSON+import qualified Z.Data.Parser          as P+import           Z.Data.PrimRef+import qualified Z.Data.Text            as T+import qualified Z.Data.Text.UTF8Codec  as T+import qualified Z.Data.Vector          as V+import qualified Z.Data.Vector.Base     as V+import           Z.Data.Vector.Base64+import qualified Z.Data.Vector.Hex      as Hex+import           Z.IO.Buffered+import           Z.IO.Exception+import qualified Z.IO.FileSystem.Base   as FS+import           Z.IO.Resource++-- | A 'BIO'(blocked IO) node.+--+-- A 'BIO' node is a push based stream transformer. It can be used to describe different kinds of IO+-- devices:+--+--  * @BIO inp out@ describe an IO state machine(e.g. z_stream in zlib),+--    which takes some input in block, then outputs.+--  * @type Source out = BIO Void out@ described an IO source, which never takes input,+--    but gives output until EOF by looping.+--  * @type Sink inp = BIO inp Void@ described an IO sink, which takes input and perform some IO effects,+--    such as writing to terminal or files.+--+-- You can connect these 'BIO' nodes with '>|>', which connect left node's output to right node's input,+-- and return a new 'BIO' node with left node's input type and right node's output type.+--+-- You can run a 'BIO' node in different ways:+--+--   * 'step'\/'step_' to supply a single chunk of input and step the BIO node.+--   * 'run'\/'run_' will supply EOF directly, which will effectively pull all values from source,+--     and push to sink until source reaches EOF.+--   * 'runBlock'\/'runBlock_' will supply a single block of input as whole input and run the BIO node.+--   * 'runBlocks'\/'runBlocks_' will supply a list of blocks as whole input and run the BIO node.+--+-- Note 'BIO' usually contains some IO states, you can consider it as an opaque 'IORef':+--+--   * 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.+--+-- 'BIO' is simply a convenient way to construct single-thread streaming computation, to use 'BIO'+-- in multiple threads, check "Z.IO.BIO.Concurrent" module.+--+type BIO inp out = (Maybe out -> IO ())     -- ^ Pass 'EOF' to indicate current node reaches EOF+                -> Maybe inp                -- ^ 'EOF' indicates upstream reaches EOF+                -> IO ()++-- | Patterns for more meaningful pattern matching.+pattern EOF :: Maybe a+pattern EOF = Nothing++-- | Type alias for 'BIO' node which never takes input.+--+-- Note when implement a 'Source', you should assume 'EOF' argument is supplied only once, and you+-- should loop to call downstream continuation with all available chunks, then write a final 'EOF'+-- to indicate EOF.+type Source x = BIO Void x++-- | Type alias for 'BIO' node which only takes input and perform effects.+--+-- Note when implement a 'Sink', you should assume 'EOF' argument is supplied only once(when upstream+-- reaches EOF), you do not need to call downstream continuation before EOF, and+-- do a flush(also write a final 'EOF') when upstream reach EOF.+type Sink x = BIO x ()++-- | Connect two 'BIO' source, after first reach EOF, draw elements from second.+appendSource :: HasCallStack => Source a -> Source a -> Source a+{-# INLINABLE appendSource #-}+b1 `appendSource` b2 = \ k _ ->+    b1 (\ y ->+        case y of Just _ -> k y+                  _      -> b2 k EOF) EOF++-- | Fuse two 'BIO' sinks, i.e. everything written to the fused sink will be written to left and right sink.+--+-- Flush result 'BIO' will effectively flush both sink.+joinSink :: HasCallStack => Sink out -> Sink out -> Sink out+{-# INLINABLE joinSink #-}+b1 `joinSink` b2 = \ k mx ->+    case mx of+        Just _ -> do+            b1 discard mx+            b2 discard mx+        _ -> do+            b1 discard EOF+            b2 discard EOF+            k EOF++-- | Fuse a list of 'BIO' sinks, everything written to the fused sink will be written to every sink in the list.+--+-- Flush result 'BIO' will effectively flush every sink in the list.+fuseSink :: HasCallStack => [Sink out] -> Sink out+{-# INLINABLE fuseSink #-}+fuseSink ss = \ k mx ->+    case mx of+        Just _ -> mapM_ (\ s -> s discard mx) ss+        _ -> do+            mapM_ (\ s -> s discard mx) ss+            k EOF++-- | Connect list of 'BIO' sources, after one reach EOF, draw element from next.+concatSource :: HasCallStack => [Source a] -> Source a+{-# INLINABLE concatSource #-}+concatSource = List.foldl' appendSource emptySource++-- | A 'Source' directly write EOF to downstream.+emptySource :: Source a+{-# INLINABLE emptySource #-}+emptySource = \ k _ -> k EOF++-- | Connect list of 'BIO' sources, after one reach EOF, draw element from next.+concatSource' :: HasCallStack => Source (Source a) -> Source a+{-# INLINABLE concatSource' #-}+concatSource' ssrc = \ k _ -> ssrc (\ msrc ->+    case msrc of+        Just src -> src (\ mx ->+            case mx of Just _ -> k mx+                       _ -> return ()) EOF+        _ -> k EOF) EOF++-------------------------------------------------------------------------------+-- Run BIO++-- | Discards a value.+discard :: a -> IO ()+{-# INLINABLE discard #-}+discard _ = return ()++-- | Supply a single chunk of input to a 'BIO' and collect result.+step :: HasCallStack => BIO inp out -> inp -> IO [out]+{-# INLINABLE step #-}+step bio inp = do+    accRef <- newIORef []+    bio (mapM_  $ \ x -> modifyIORef' accRef (x:)) (Just inp)+    reverse <$> readIORef accRef++-- | Supply a single chunk of input to a 'BIO' without collecting result.+step_ :: HasCallStack => BIO inp out -> inp -> IO ()+{-# INLINABLE step_ #-}+step_ bio = bio discard . Just++-- | Run a 'BIO' loop without providing input.+--+-- When used on 'Source', it starts the streaming loop.+-- When used on 'Sink', it performs a flush.+run_ :: HasCallStack => BIO inp out -> IO ()+{-# INLINABLE run_ #-}+run_ bio = bio discard EOF++-- | Run a 'BIO' loop without providing input, and collect result.+--+-- When used on 'Source', it will collect all input chunks.+run :: HasCallStack => BIO inp out -> IO [out]+{-# INLINABLE run #-}+run bio = do+    accRef <- newIORef []+    bio (mapM_  $ \ x -> modifyIORef' accRef (x:)) EOF+    reverse <$> readIORef accRef++-- | Run a strict fold over a source with 'L.Fold'.+fold' :: L.Fold a b -> Source a -> IO b+{-# INLINABLE fold' #-}+fold' (L.Fold s i e) bio = do+    iref <- newIORef i+    bio (mapM_  (\ x -> modifyIORef' iref (\ i' -> s i' x))) Nothing+    e <$> readIORef iref++-- | Run a strict fold over a source with 'L.FoldM'.+foldIO' :: L.FoldM IO a b -> Source a -> IO b+{-# INLINABLE foldIO' #-}+foldIO' (L.FoldM s i e) bio = do+    iref <- newIORef =<< i+    bio (mapM_  (\ x -> do+        i' <- readIORef iref+        !x' <- s i' x+        writeIORef iref x')) Nothing+    e =<< readIORef iref++-- | Run a 'BIO' loop with a single chunk of input and EOF, and collect result.+--+runBlock :: HasCallStack => BIO inp out -> inp -> IO [out]+{-# INLINABLE runBlock #-}+runBlock bio inp = do+    accRef <- newIORef []+    bio (mapM_  $ \ x -> modifyIORef' accRef (x:)) (Just inp)+    bio (mapM_  $ \ x -> modifyIORef' accRef (x:)) EOF+    reverse <$> readIORef accRef++-- | Run a 'BIO' loop with a single chunk of input and EOF, without collecting result.+--+runBlock_ :: HasCallStack => BIO inp out -> inp -> IO ()+{-# INLINABLE runBlock_ #-}+runBlock_ bio inp = do+    bio discard (Just inp)+    bio discard EOF++-- | Wrap 'runBlock' into a pure interface.+--+-- You can wrap a stateful BIO computation(including the creation of 'BIO' node),+-- when you can guarantee a computation is pure, e.g. compressing, decoding, etc.+unsafeRunBlock :: HasCallStack => IO (BIO inp out) -> inp -> [out]+{-# INLINABLE unsafeRunBlock #-}+unsafeRunBlock new inp = unsafePerformIO (new >>= \ bio -> runBlock bio inp)++-- | Supply blocks of input and EOF to a 'BIO', and collect results.+--+-- Note many 'BIO' node will be closed or not be able to take new input after drained.+runBlocks :: HasCallStack => BIO inp out -> [inp] -> IO [out]+{-# INLINABLE runBlocks #-}+runBlocks bio inps = do+    accRef <- newIORef []+    forM_ inps $ bio (mapM_  $ \ x -> modifyIORef' accRef (x:)) . Just+    bio (mapM_  $ \ x -> modifyIORef' accRef (x:)) EOF+    reverse <$> readIORef accRef++-- | Supply blocks of input and EOF to a 'BIO', without collecting results.+--+-- Note many 'BIO' node will be closed or not be able to take new input after drained.+runBlocks_ :: HasCallStack => BIO inp out -> [inp] -> IO ()+{-# INLINABLE runBlocks_ #-}+runBlocks_ bio inps = do+    forM_ inps $ bio discard . Just+    bio discard EOF++-- | Wrap 'runBlocks' into a pure interface.+--+-- Similar to 'unsafeRunBlock', but with a list of input blocks.+unsafeRunBlocks :: HasCallStack => IO (BIO inp out) -> [inp] -> [out]+{-# INLINABLE unsafeRunBlocks #-}+unsafeRunBlocks new inps = unsafePerformIO (new >>= \ bio -> runBlocks bio inps)++-------------------------------------------------------------------------------+-- Source++-- | Source a list(or any 'Foldable') from memory.+--+sourceFromList :: Foldable f => f a -> Source a+{-# INLINABLE sourceFromList #-}+sourceFromList xs0 = \ k _ -> do+    mapM_ (k . Just) xs0+    k EOF++-- | Turn a 'BufferedInput' into 'BIO' source, map EOF to EOF.+--+sourceFromBuffered :: HasCallStack => BufferedInput -> Source V.Bytes+{-# INLINABLE sourceFromBuffered #-}+sourceFromBuffered i = \ k _ -> loop k+  where+    loop k = do+        x <- readBuffer i+        if V.null x then k EOF else k (Just x) >> loop k++-- | Turn a `IO` action into 'Source'+sourceFromIO :: HasCallStack => IO (Maybe a) -> Source a+{-# INLINABLE sourceFromIO #-}+sourceFromIO io = \ k _ -> loop k+  where+    loop k = do+        x <- io+        case x of+            Just _ -> k x >> loop k+            _      -> k EOF++-- | Turn a UTF8 encoded 'BufferedInput' into 'BIO' source, map EOF to EOF.+--+sourceTextFromBuffered :: HasCallStack => BufferedInput -> Source T.Text+{-# INLINABLE sourceTextFromBuffered #-}+sourceTextFromBuffered i = \ k _ -> loop k+  where+    loop k = do+        x <- readBufferText i+        if T.null x then k EOF else k (Just x) >> loop k++-- | Turn a 'JSON' encoded 'BufferedInput' into 'BIO' source, ignoring any+-- whitespaces bewteen JSON objects. If EOF reached, then return 'EOF'.+-- Throw 'OtherError' with name "EJSON" if JSON value is not parsed or converted.+--+sourceJSONFromBuffered :: forall a. (JSON.JSON a, HasCallStack) => BufferedInput -> Source a+{-# INLINABLE sourceJSONFromBuffered #-}+sourceJSONFromBuffered = sourceParseChunkFromBuffered JSON.decodeChunk++-- | Turn buffered input device into a packet source, throw 'OtherError' with name @EPARSE@ if parsing fail.+sourceParserFromBuffered :: HasCallStack => P.Parser a -> BufferedInput -> Source a+{-# INLINABLE sourceParserFromBuffered #-}+sourceParserFromBuffered p = sourceParseChunkFromBuffered (P.parseChunk p)++-- | Turn buffered input device into a packet source, throw 'OtherError' with name @EPARSE@ if parsing fail.+sourceParseChunkFromBuffered :: (HasCallStack, T.Print e)+                              => (V.Bytes -> P.Result e a) -> BufferedInput -> Source a+{-# INLINABLE sourceParseChunkFromBuffered #-}+sourceParseChunkFromBuffered pc bi = \ k _ ->+    let loopA = do+            bs <- readBuffer bi+            if V.null bs+            then k EOF+            else loopB bs+        loopB bs = do+            (rest, r) <- P.parseChunks pc (readBuffer bi) bs+            case r of Right v -> k (Just v)+                      Left e  -> throwOtherError "EPARSE" (T.toText e)+            if V.null rest+            then loopA+            else loopB rest+    in loopA++-- | Turn a file into a 'V.Bytes' source.+initSourceFromFile :: HasCallStack => CBytes -> Resource (Source V.Bytes)+{-# INLINABLE initSourceFromFile #-}+initSourceFromFile p = do+    f <- FS.initFile p FS.O_RDONLY FS.DEFAULT_FILE_MODE+    liftIO (sourceFromBuffered <$> newBufferedInput f)++-- | Turn a file into a 'V.Bytes' source with given chunk size.+initSourceFromFile' :: HasCallStack => CBytes -> Int -> Resource (Source V.Bytes)+{-# INLINABLE initSourceFromFile' #-}+initSourceFromFile' p bufSiz = do+    f <- FS.initFile p FS.O_RDONLY FS.DEFAULT_FILE_MODE+    liftIO (sourceFromBuffered <$> newBufferedInput' bufSiz f)++--------------------------------------------------------------------------------+-- Sink++-- | Turn a 'BufferedOutput' into a 'V.Bytes' sink.+sinkToBuffered :: HasCallStack => BufferedOutput -> Sink V.Bytes+{-# INLINABLE sinkToBuffered #-}+sinkToBuffered bo = \ k mbs ->+    case mbs of+        Just bs -> writeBuffer bo bs >> k (Just ())+        _       -> flushBuffer bo >> k EOF++-- | Turn a 'BufferedOutput' into a 'B.Builder' sink.+--+sinkBuilderToBuffered :: HasCallStack => BufferedOutput -> Sink (B.Builder a)+{-# INLINABLE sinkBuilderToBuffered #-}+sinkBuilderToBuffered bo = \ k mbs ->+    case mbs of+        Just bs -> writeBuilder bo bs >> k (Just ())+        _       -> flushBuffer bo >> k EOF++-- | Turn a file into a 'V.Bytes' sink.+--+-- Note the file will be opened in @'FS.O_APPEND' .|. 'FS.O_CREAT' .|. 'FS.O_WRONLY'@ mode,+-- bytes will be written after the end of the original file if there'are old bytes.+initSinkToFile :: HasCallStack => CBytes -> Resource (Sink V.Bytes)+{-# INLINABLE initSinkToFile #-}+initSinkToFile p = do+    f <- FS.initFile p (FS.O_APPEND .|. FS.O_CREAT .|. FS.O_WRONLY) FS.DEFAULT_FILE_MODE+    liftIO (sinkToBuffered <$> newBufferedOutput f)++-- | Turn an `IO` action into 'BIO' sink.+--+sinkToIO :: HasCallStack => (a -> IO ()) -> Sink a+{-# INLINABLE sinkToIO #-}+sinkToIO f = \ k ma ->+    case ma of+        Just a -> f a >> k (Just ())+        _ -> k EOF++-- | Turn an `IO` action(and a flush action), into 'BIO' sink.+--+sinkToIO' :: HasCallStack => (a -> IO ()) -> IO () -> Sink a+{-# INLINABLE sinkToIO' #-}+sinkToIO' f flush = \ k ma ->+    case ma of+        Just a -> f a >> k (Just ())+        _ -> flush >> k EOF++-- | Sink to a list in memory.+--+-- The 'MVar' will be empty during sinking, and will be filled after sink receives an EOF.+sinkToList :: IO (MVar [a], Sink a)+sinkToList = do+    xsRef <- newIORef []+    rRef <- newEmptyMVar+    return (rRef, sinkToIO' (\ x -> modifyIORef xsRef (x:))+                            (do modifyIORef xsRef reverse+                                xs <- readIORef xsRef+                                putMVar rRef xs))++--------------------------------------------------------------------------------+-- s++-- | BIO node from a pure function.+--+-- BIO node made with this funtion are stateless, thus can be reused across chains.+fromPure :: (a -> b) -> BIO a b+{-# INLINABLE fromPure #-}+fromPure f = \ k x -> k (f <$> x)++-- | BIO node from an IO function.+--+-- BIO node made with this funtion may not be stateless, it depends on if the IO function use+-- IO state.+fromIO :: HasCallStack => (a -> IO b) -> BIO a b+{-# INLINABLE fromIO #-}+fromIO f = \ k x ->+    case x of Just x' -> f x' >>= k . Just+              _ -> k EOF++-- | BIO node from a pure filter.+--+-- BIO node made with this funtion are stateless, thus can be reused across chains.+filter ::  (a -> Bool) -> BIO a a+{-# INLINABLE filter #-}+filter f k = go+  where+    go (Just a) = when (f a) $ k (Just a)+    go Nothing = k Nothing++-- | BIO node from an impure filter.+--+-- BIO node made with this funtion may not be stateless, it depends on if the IO function use+filterIO ::  (a -> IO Bool) -> BIO a a+{-# INLINABLE filterIO #-}+filterIO f k = go+  where+    go (Just a) = do+        mbool <- f a+        when mbool $ k (Just a)+    go Nothing = k Nothing++-- | Make a chunk size divider.+--+-- A divider size divide each chunk's size to the nearest multiplier to granularity,+-- last trailing chunk is directly returned.+newReChunk :: Int                -- ^ chunk granularity+           -> IO (BIO V.Bytes V.Bytes)+{-# INLINABLE newReChunk #-}+newReChunk n = do+    trailingRef <- newIORef V.empty+    return $ \ k mbs ->+        case mbs of+            Just bs -> do+                trailing <- readIORef trailingRef+                let chunk =  trailing `V.append` bs+                    l = V.length chunk+                if l >= n+                then do+                    let l' = l - (l `rem` n)+                        (chunk', rest) = V.splitAt l' chunk+                    writeIORef trailingRef rest+                    k (Just chunk')+                else writeIORef trailingRef chunk+            _ -> do+                trailing <- readIORef trailingRef+                unless (V.null trailing) $ do+                    writeIORef trailingRef V.empty+                    k (Just trailing)+                k EOF++-- | Read buffer and parse with 'Parser'.+--+-- This function will turn a 'Parser' into a 'BIO', throw 'OtherError' with name @EPARSE@ if parsing fail.+--+newParser :: HasCallStack => P.Parser a -> IO (BIO V.Bytes a)+{-# INLINABLE newParser #-}+newParser p = do+    -- type LastParseState = Maybe (V.Bytes -> P.Result)+    resultRef <- newIORef EOF+    return $ \ k mbs -> do+        let loop f chunk = case f chunk of+                P.Success a trailing -> do+                    k (Just a)+                    unless (V.null trailing) (loop f trailing)+                P.Partial f' ->+                    writeIORef resultRef (Just f')+                P.Failure e _ ->+                    throwOtherError "EPARSE" (T.toText e)+        lastResult <- readIORef resultRef+        case mbs of+            Just bs -> do+                let f = case lastResult of+                        Just x    -> x+                        _         -> P.parseChunk p+                loop f bs+            _ ->+                case lastResult of+                    Just f -> loop f V.empty+                    _ -> k EOF++-- | Make a new UTF8 decoder, which decode bytes streams into text streams.+--+-- If there're invalid UTF8 bytes, an 'OtherError' with name 'EINVALIDUTF8' will be thrown.`+--+-- Note this node is supposed to be used with preprocess node such as decompressor, parser, etc.+-- where bytes boundary cannot be controlled, UTF8 decoder will concat trailing bytes from last block to next one.+-- Use this node directly with 'sourceFromBuffered' will not be as efficient as directly use+-- 'sourceTextFromBuffered', because 'BufferedInput' provides push back capability,+-- trailing bytes can be pushed back to reading buffer then returned with next block input together.+--+newUTF8Decoder :: HasCallStack => IO (BIO V.Bytes T.Text)+{-# INLINABLE newUTF8Decoder #-}+newUTF8Decoder = do+    trailingRef <- newIORef V.empty+    return $ \ k mbs -> do+        case mbs of+            Just bs -> do+                trailing <- readIORef trailingRef+                let chunk =  trailing `V.append` bs+                    (V.PrimVector arr s l) = chunk+                if l > 0 && T.decodeCharLen arr s <= l+                then do+                    let (i, _) = V.findR (\ w -> w >= 0b11000000 || w <= 0b01111111) chunk+                    if (i == -1)+                    then throwOtherError "EINVALIDUTF8" "invalid UTF8 bytes"+                    else do+                        if T.decodeCharLen arr (s + i) > l - i+                        then do+                            writeIORef trailingRef (V.fromArr arr (s+i) (l-i))+                            k (Just (T.validate (V.fromArr arr s i)))+                        else do+                            writeIORef trailingRef V.empty+                            k (Just (T.validate chunk))+                else writeIORef trailingRef chunk++            _ -> do+                trailing <- readIORef trailingRef+                if V.null trailing+                then k EOF+                else throwOtherError "EINVALIDUTF8" "invalid UTF8 bytes"++-- | Make a new stream splitter based on magic byte.+--+newMagicSplitter :: Word8 -> IO (BIO V.Bytes V.Bytes)+{-# INLINABLE newMagicSplitter #-}+newMagicSplitter magic = do+    trailingRef <- newIORef V.empty+    return $ \ k mx ->+        case mx of+            Just bs -> do+                trailing <- readIORef trailingRef+                let loop chunk = case V.elemIndex magic chunk of+                        Just i -> do+                            -- TODO: looping+                            let (line, rest) = V.splitAt (i+1) chunk+                            k (Just line)+                            loop rest+                        _ -> writeIORef trailingRef chunk+                loop (trailing `V.append` bs)+            _ -> do+                chunk <- readIORef trailingRef+                unless (V.null chunk) $ do+                    writeIORef trailingRef V.empty+                    k (Just chunk)+                k EOF++-- | Make a new stream splitter based on linefeed(@\r\n@ or @\n@).+--+-- The result bytes doesn't contain linefeed.+newLineSplitter :: IO (BIO V.Bytes V.Bytes)+{-# INLINABLE newLineSplitter #-}+newLineSplitter = do+    s <- newMagicSplitter 10+    return (s . fromPure dropLineEnd)+  where+    dropLineEnd bs@(V.PrimVector arr s l) =+        case bs `V.indexMaybe` (l-2) of+            Just r | r == 13   -> V.PrimVector arr s (l-2)+                   | otherwise -> V.PrimVector arr s (l-1)+            _ | V.head bs == 10 -> V.PrimVector arr s (l-1)+              | otherwise -> V.PrimVector arr s l++-- | Make a new base64 encoder node.+newBase64Encoder :: IO (BIO V.Bytes V.Bytes)+{-# INLINABLE newBase64Encoder #-}+newBase64Encoder = do+    re <- newReChunk 3+    return (re . fromPure base64Encode)++-- | Make a new base64 decoder node.+newBase64Decoder :: HasCallStack => IO (BIO V.Bytes V.Bytes)+{-# INLINABLE newBase64Decoder #-}+newBase64Decoder = do+    re <- newReChunk 4+    return (re . fromPure base64Decode')++-- | Make a hex encoder node.+--+-- Hex encoder is stateless, it can be reused across chains.+hexEncode :: Bool   -- ^ uppercase?+          -> BIO V.Bytes V.Bytes+{-# INLINABLE hexEncode #-}+hexEncode upper = fromPure (Hex.hexEncode upper)++-- | Make a new hex decoder node.+newHexDecoder :: IO (BIO V.Bytes V.Bytes)+{-# INLINABLE newHexDecoder #-}+newHexDecoder = do+    re <- newReChunk 2+    return (re . fromPure Hex.hexDecode')++-- | Make a new BIO node which counts items flow throught it.+--+-- 'Counter' is increased atomically, it's safe to read \/ reset the counter from other threads.+counter :: Counter -> BIO a a+{-# INLINABLE counter #-}+counter c = fromIO inc+  where+    inc x = do+        atomicAddCounter_ c 1+        return x++-- | Make a new BIO node which counts items, and label item with a sequence number.+--+-- 'Counter' is increased atomically, it's safe to read \/ reset the counter from other threads.+seqNum :: Counter -> BIO a (Int, a)+{-# INLINABLE seqNum #-}+seqNum c = fromIO inc+  where+    inc x = do+        i <- atomicAddCounter c 1+        return (i, x)++-- | Make a BIO node grouping items into fixed size arrays.+--+-- Trailing items are directly returned.+newGrouping :: V.Vec v a => Int -> IO (BIO a (v a))+{-# INLINABLE newGrouping #-}+newGrouping n+    | n < 1 =  newGrouping 1+    | otherwise = do+        c <- newCounter 0+        arrRef <- newIORef =<< A.newArr n+        return $ \ k mx ->+            case mx of+                Just x -> do+                    i <- readPrimRef c+                    if i == n - 1+                    then do+                        marr <- readIORef arrRef+                        A.writeArr marr i x+                        writePrimRef c 0+                        writeIORef arrRef =<< A.newArr n+                        arr <- A.unsafeFreezeArr marr+                        k . Just $! V.fromArr arr 0 n+                    else do+                        marr <- readIORef arrRef+                        A.writeArr marr i x+                        writePrimRef c (i+1)+                _ -> do+                    i <- readPrimRef c+                    if i /= 0+                    then do+                        writePrimRef c 0+                        marr <- readIORef arrRef+                        A.shrinkMutableArr marr i+                        arr <- A.unsafeFreezeArr marr+                        k . Just $! V.fromArr arr 0 i+                    else k EOF++-- | A BIO node flatten items.+--+ungrouping :: BIO (V.Vector a) a+{-# INLINABLE ungrouping #-}+ungrouping = \ k mx ->+    case mx of+        Just x -> V.traverse_ (k . Just) x+        _      -> k EOF++-- | A BIO node which write 'True' to 'IORef' when 'EOF' is reached.+consumed :: TVar Bool -> BIO a a+{-# INLINABLE consumed #-}+consumed ref = \ k mx -> case mx of+    Just _ -> k mx+    _ -> do atomically (writeTVar ref True)+            k EOF++++

@@ -13,9 +13,9 @@ This module provides some concurrent 'BIO' node, to ease the implementation of producer-consumer model. All sources and sinks return by this module are safe to be used in multiple threads. -  * Use 'newTQueueNode' for common cases.-  * Use 'newTBQueueNode' if you have a fast producer and you don't want input get piled up in memory.-  * Use 'newBroadcastTChanNode' if you want messages get broadcasted, i.e. every message written by+  * Use 'newTQueuePair' for common cases.+  * Use 'newTBQueuePair' if you have a fast producer and you don't want input get piled up in memory.+  * Use 'newBroadcastTChanPair' if you want messages get broadcasted, i.e. every message written by     producers will be received by every consumers.  It's important to correctly set the numebr of producers, internally it keeps a counter on how many producers@@ -23,7 +23,7 @@ exceptions and pull the sink(which indicate EOF) on producer side.  @-(sink, src) <- newTQueueNode 2  -- it's important to correctly set the numebr of producers+(sink, src) <- newTQueuePair 2  -- it's important to correctly set the numebr of producers  -------------------------------------------------------------------------------- -- producers@@ -63,7 +63,7 @@ import qualified Data.Sequence as Seq import Data.Sequence (Seq((:<|),(:|>))) import GHC.Natural-import Z.IO.BIO+import Z.IO.BIO.Base import Z.Data.PrimRef import Z.IO.Exception @@ -74,8 +74,9 @@ --   * Two node should output same numebr of results. --   * If the number differs, one node maybe ---zipBIO :: BIO a b -> BIO a c -> BIO a (b,c)-zipBIO b1 b2 = \ k mx -> do+zip :: BIO a b -> BIO a c -> BIO a (b,c)+{-# INLINABLE zip #-}+zip b1 b2 = \ k mx -> do     bEOF <- newTVarIO False     cEOF <- newTVarIO False     bBuf <- newTVarIO Seq.empty@@ -104,9 +105,10 @@             _ -> if beof then return (k EOF) else retry  -- | Make an unbounded queue and a pair of sink and souce connected to it.-newTQueueNode :: Int -- ^ number of producers+newTQueuePair :: Int -- ^ number of producers               -> IO (Sink a, Source a)-newTQueueNode n = do+{-# INLINABLE newTQueuePair #-}+newTQueuePair n = do     q <- newTQueueIO     ec <- newCounter 0     return@@ -127,10 +129,11 @@             in loop)  -- | Make an bounded queue and a pair of sink and souce connected to it.-newTBQueueNode :: Int       -- ^ number of producers+newTBQueuePair :: Int       -- ^ number of producers                -> Natural   -- ^ queue buffer bound                -> IO (Sink a, Source a)-newTBQueueNode n bound = do+{-# INLINABLE newTBQueuePair #-}+newTBQueuePair n bound = do     q <- newTBQueueIO bound     ec <- newCounter 0     return@@ -151,9 +154,10 @@             in loop)  -- | Make a broadcast chan and a sink connected to it, and a function return sources to receive broadcast message.-newBroadcastTChanNode :: Int                        -- ^ number of producers+newBroadcastTChanPair :: Int                        -- ^ number of producers                       -> IO (Sink a, IO (Source a)) -- ^ (Sink, IO Source)-newBroadcastTChanNode n = do+{-# INLINABLE newBroadcastTChanPair #-}+newBroadcastTChanPair n = do     b <- newBroadcastTChanIO     ec <- newCounter 0     let dupSrc = do

@@ -65,7 +65,7 @@ import           Z.Data.Vector.Base as V import           Z.Foreign import           Z.Foreign.CPtr-import           Z.IO.BIO+import           Z.IO.BIO.Base import           Z.IO.Exception  #include "zlib.h"@@ -120,6 +120,7 @@         deriving anyclass (Print, JSON)  defaultCompressConfig :: CompressConfig+{-# INLINABLE defaultCompressConfig #-} defaultCompressConfig =     CompressConfig Z_DEFAULT_COMPRESSION  defaultWindowBits         defaultMemLevel V.empty Z_DEFAULT_STRATEGY V.defaultChunkSize@@ -134,6 +135,7 @@ newCompress :: HasCallStack             => CompressConfig             -> IO (ZStream, BIO V.Bytes V.Bytes)+{-# INLINABLE newCompress #-} newCompress (CompressConfig level windowBits memLevel dict strategy bufSiz) = do     zs <- newCPtr'         (do ps <- throwOOMIfNull create_z_stream@@ -189,15 +191,18 @@  -- | Reset compressor's state so that related 'BIO' can be reused. compressReset :: ZStream -> IO ()+{-# INLINABLE compressReset #-} compressReset (ZStream fp) = do     throwZlibIfMinus_ (withCPtr fp deflateReset)  -- | Compress some bytes. compress :: HasCallStack => CompressConfig -> V.Bytes -> V.Bytes+{-# INLINABLE compress #-} compress conf = V.concat . unsafeRunBlock (snd <$> newCompress conf)  -- | Compress some bytes in blocks. compressBlocks :: HasCallStack => CompressConfig -> [V.Bytes] -> [V.Bytes]+{-# INLINABLE compressBlocks #-} compressBlocks conf = unsafeRunBlocks (snd <$> newCompress conf)  data DecompressConfig = DecompressConfig@@ -208,12 +213,14 @@         deriving anyclass (Print, JSON)  defaultDecompressConfig :: DecompressConfig+{-# INLINABLE defaultDecompressConfig #-} defaultDecompressConfig = DecompressConfig defaultWindowBits V.empty V.defaultChunkSize  -- | Make a new decompress node. -- -- The returned 'BIO' node can be reused only if you call 'decompressReset' on the 'ZStream'. newDecompress :: DecompressConfig -> IO (ZStream, BIO V.Bytes V.Bytes)+{-# INLINABLE newDecompress #-} newDecompress (DecompressConfig windowBits dict bufSiz) = do     zs <- newCPtr'         (do ps <- throwOOMIfNull create_z_stream@@ -283,20 +290,24 @@  -- | Reset decompressor's state so that related 'BIO' can be reused. decompressReset :: ZStream -> IO ()+{-# INLINABLE decompressReset #-} decompressReset (ZStream fp) = do     throwZlibIfMinus_ (withCPtr fp inflateReset)  -- | Decompress some bytes. decompress :: HasCallStack => DecompressConfig -> V.Bytes -> V.Bytes+{-# INLINABLE decompress #-} decompress conf = V.concat . unsafeRunBlock (snd <$> newDecompress conf)  -- | Decompress some bytes in blocks. decompressBlocks :: HasCallStack => DecompressConfig -> [V.Bytes] -> [V.Bytes]+{-# INLINABLE decompressBlocks #-} decompressBlocks conf = unsafeRunBlocks (snd <$> newDecompress conf)  --------------------------------------------------------------------------------  toZErrorMsg :: CInt -> CBytes+{-# INLINABLE toZErrorMsg #-} toZErrorMsg (#const Z_OK           ) =  "Z_OK" toZErrorMsg (#const Z_STREAM_END   ) =  "Z_STREAM_END" toZErrorMsg (#const Z_NEED_DICT    ) =  "Z_NEED_DICT"@@ -315,6 +326,7 @@     fromException = ioExceptionFromException  throwZlibIfMinus :: HasCallStack => IO CInt -> IO CInt+{-# INLINABLE throwZlibIfMinus #-} throwZlibIfMinus f = do     r <- f     if r < 0 && r /= (#const Z_BUF_ERROR)@@ -322,6 +334,7 @@     else return r  throwZlibIfMinus_ :: HasCallStack => IO CInt -> IO ()+{-# INLINABLE throwZlibIfMinus_ #-} throwZlibIfMinus_ = void . throwZlibIfMinus  foreign import ccall unsafe@@ -358,6 +371,7 @@     inflateReset :: Ptr ZStream -> IO CInt  set_avail_in :: CPtr ZStream -> V.Bytes -> Int -> IO ()+{-# INLINABLE set_avail_in #-} set_avail_in zs buf buflen = do     withPrimVectorSafe buf $ \ pbuf _ ->         withCPtr zs $ \ ps -> do@@ -365,6 +379,7 @@             (#poke struct z_stream_s, avail_in) ps (fromIntegral buflen :: CUInt)  set_avail_out :: CPtr ZStream -> MutablePrimArray RealWorld Word8 -> Int -> IO ()+{-# INLINABLE set_avail_out #-} set_avail_out zs buf bufSiz = do     withMutablePrimArrayContents buf $ \ pbuf ->         withCPtr zs $ \ ps -> do

@@ -33,7 +33,7 @@   , newBufferedOutput   , newBufferedOutput'   , writeBuffer, writeBuffer'-  , writeBuilder+  , writeBuilder, writeBuilder'   , flushBuffer   , clearOutputBuffer     -- * Buffered Input and Output@@ -51,14 +51,13 @@ import           Data.Word import           Data.Bits                 (unsafeShiftR) import           Foreign.Ptr-import           Z.Data.Array import qualified Z.Data.Builder.Base       as B import qualified Z.Data.Parser             as P import qualified Z.Data.Vector             as V import qualified Z.Data.Text               as T import qualified Z.Data.Text.UTF8Codec     as T import qualified Z.Data.Vector.Base        as V-import           Z.Data.PrimRef.PrimIORef+import           Z.Data.PrimRef import           Z.Foreign import           Z.IO.Exception @@ -125,14 +124,16 @@ newBufferedOutput = newBufferedOutput' V.defaultChunkSize  -- | Open a new buffered output with given buffer size, e.g. 'V.defaultChunkSize'.+--+-- Size smaller than 'V.smallChunkSize' will be taken as 'V.smallChunkSize'. newBufferedOutput' :: Output o                    => Int    -- ^ Output buffer size                    -> o                    -> IO BufferedOutput {-# INLINABLE newBufferedInput' #-} newBufferedOutput' bufSiz o = do-    index <- newPrimIORef 0-    buf <- newPinnedPrimArray (max bufSiz 0)+    index <- newPrimRef 0+    buf <- newPinnedPrimArray (max bufSiz V.smallChunkSize)     return (BufferedOutput (writeOutput o) index buf)  -- | Open a new buffered input with given buffer size, e.g. 'V.defaultChunkSize'.@@ -143,18 +144,18 @@ {-# INLINABLE newBufferedOutput' #-} newBufferedInput' bufSiz i = do     pb <- newIORef V.empty-    buf <- newPinnedPrimArray (max bufSiz 0)+    buf <- newPinnedPrimArray (max bufSiz V.smallChunkSize)     inputBuffer <- newIORef buf     return (BufferedInput (readInput i) pb inputBuffer)  -- | Open a new buffered input and output with 'V.defaultChunkSize' as buffer size. newBufferedIO :: IODev dev => dev -> IO (BufferedInput, BufferedOutput)-{-# INLINE newBufferedIO #-}+{-# INLINABLE newBufferedIO #-} newBufferedIO dev = newBufferedIO' dev V.defaultChunkSize V.defaultChunkSize  -- | Open a new buffered input and output with given buffer size, e.g. 'V.defaultChunkSize'. newBufferedIO' :: IODev dev => dev -> Int -> Int -> IO (BufferedInput, BufferedOutput)-{-# INLINE newBufferedIO' #-}+{-# INLINABLE newBufferedIO' #-} newBufferedIO' dev inSize outSize = do     i <- newBufferedInput' inSize dev     o <- newBufferedOutput' outSize dev@@ -184,9 +185,8 @@             ba <- unsafeFreezePrimArray mba             return $! V.fromArr ba 0 l         else do                                -- freeze buf into result-            when (bufSiz /= 0) $ do-                buf' <- newPinnedPrimArray bufSiz-                writeIORef inputBuffer buf'+            buf' <- newPinnedPrimArray bufSiz+            writeIORef inputBuffer buf'             shrinkMutablePrimArray rbuf l             ba <- unsafeFreezePrimArray rbuf             return $! V.fromArr ba 0 l@@ -196,8 +196,8 @@  -- | Request UTF8 'T.Text' chunk from 'BufferedInput'. ----- The buffer size must be larger than 4 bytes to guarantee decoding progress. If there're--- trailing bytes before EOF, an 'OtherError' with name 'EINCOMPLETE' will be thrown, if there're+-- The buffer size must be larger than 4 bytes to guarantee decoding progress(which is guaranteed by 'newBufferedInput').+-- If there're trailing bytes before EOF, an 'OtherError' with name 'EINCOMPLETE' will be thrown, if there're -- invalid UTF8 bytes, an 'OtherError' with name 'EINVALIDUTF8' will be thrown.` readBufferText :: HasCallStack => BufferedInput -> IO T.Text {-# INLINABLE readBufferText #-}@@ -235,9 +235,8 @@             ba <- unsafeFreezePrimArray mba             splitLastChar (V.PrimVector ba 0 l)         else do                                -- freeze buf into result-            when (bufSiz /= 0) $ do-                buf' <- newPinnedPrimArray bufSiz-                writeIORef inputBuffer buf'+            buf' <- newPinnedPrimArray bufSiz+            writeIORef inputBuffer buf'             shrinkMutablePrimArray rbuf l             ba <- unsafeFreezePrimArray rbuf             splitLastChar (V.PrimVector ba 0 l)@@ -257,6 +256,7 @@  -- | Clear already buffered input. clearInputBuffer :: BufferedInput -> IO ()+{-# INLINABLE clearInputBuffer #-} clearInputBuffer BufferedInput{..} = writeIORef bufPushBack V.empty  -- | Read exactly N bytes.@@ -264,23 +264,31 @@ -- If EOF reached before N bytes read, an 'OtherError' with name 'EINCOMPLETE' will be thrown. readExactly :: HasCallStack => Int -> BufferedInput -> IO V.Bytes {-# INLINABLE readExactly #-}-readExactly n0 h0 = V.concat `fmap` (go h0 n0)+readExactly n0 h = do+    chunk <- readBuffer h+    let l = V.length chunk+    if n0 < l+    then do+        let (!chunk', !rest) = V.splitAt n0 chunk+        unReadBuffer rest h+        return chunk'+    else if n0 == l+        then return chunk+        else V.concatR <$> (go (n0 - l) [chunk])   where-    go h n = do+    go !n acc = do         chunk <- readBuffer h         let l = V.length chunk         if l > n         then do-            let (chunk', rest) = V.splitAt n chunk+            let (!chunk', !rest) = V.splitAt n chunk             unReadBuffer rest h-            return [chunk']+            return (chunk':acc)         else if l == n-            then return [chunk]+            then return (chunk:acc)             else if l == 0                 then throwOtherError "EINCOMPLETE" "input is incomplete"-                else do-                    chunks <- go h (n - l)-                    return (chunk : chunks)+                else go (n - l) (chunk:acc)  -- | Read all chunks from a 'BufferedInput' until EOF. --@@ -293,7 +301,7 @@     loop acc = do         chunk <- readBuffer h         if V.null chunk-        then return $! reverse (chunk:acc)+        then return $! reverse acc         else loop (chunk:acc)  -- | Read all chunks from a 'BufferedInput', and concat chunks together.@@ -302,7 +310,13 @@ -- Useful for reading small file into memory. readAll' :: HasCallStack => BufferedInput -> IO V.Bytes {-# INLINABLE readAll' #-}-readAll' i = V.concat <$> readAll i+readAll' h = loop []+  where+    loop acc = do+        chunk <- readBuffer h+        if V.null chunk+        then return $! V.concatR acc+        else loop (chunk:acc)  -- | Push bytes back into buffer(if not empty). --@@ -403,18 +417,18 @@ writeBuffer :: HasCallStack => BufferedOutput -> V.Bytes -> IO () {-# INLINABLE writeBuffer #-} writeBuffer o@BufferedOutput{..} v@(V.PrimVector ba s l) = do-    i <- readPrimIORef bufIndex+    i <- readPrimRef bufIndex     bufSiz <- getSizeofMutablePrimArray outputBuffer     if i /= 0     then if i + l <= bufSiz         then do             -- current buffer can hold it             copyPrimArray outputBuffer i ba s l   -- copy to buffer-            writePrimIORef bufIndex (i+l)              -- update index+            writePrimRef bufIndex (i+l)              -- update index         else do             -- flush the buffer first             withMutablePrimArrayContents outputBuffer $ \ ptr -> bufOutput ptr i-            writePrimIORef bufIndex 0+            writePrimRef bufIndex 0             -- try write to buffer again             writeBuffer o v     else@@ -422,18 +436,13 @@         then withPrimVectorSafe v bufOutput         else do             copyPrimArray outputBuffer i ba s l   -- copy to buffer-            writePrimIORef bufIndex l             -- update index+            writePrimRef bufIndex l             -- update index  -- | Write 'V.Bytes' into buffered handle then flush the buffer into output device (if buffer is not empty). ----- * If buffer is empty and bytes are larger than half of buffer, directly write bytes,---   otherwise copy bytes to buffer.------ * If buffer is not empty, then copy bytes to buffer if it can hold, otherwise---   write buffer first, then try again.---+-- Equivalent to add a 'flushBuffer' after write. writeBuffer' :: HasCallStack => BufferedOutput -> V.Bytes -> IO ()-{-# INLINE writeBuffer' #-}+{-# INLINABLE writeBuffer' #-} writeBuffer' bo o = writeBuffer bo o >> flushBuffer bo  -- | Directly write 'B.Builder' into buffered handle.@@ -443,21 +452,21 @@ writeBuilder :: HasCallStack => BufferedOutput -> B.Builder a -> IO () {-# INLINABLE writeBuilder #-} writeBuilder BufferedOutput{..} (B.Builder b) = do-    i <- readPrimIORef bufIndex+    i <- readPrimRef bufIndex     originBufSiz <- getSizeofMutablePrimArray outputBuffer     loop originBufSiz =<< b (\ _ -> return . B.Done) (B.Buffer outputBuffer i)   where     loop originBufSiz r = case r of         B.Done buffer@(B.Buffer buf' i') -> do             if sameMutablePrimArray buf' outputBuffer-            then writePrimIORef bufIndex i'+            then writePrimRef bufIndex i'             else if i' >= originBufSiz                 then do                     action =<< freezeBuffer buffer-                    writePrimIORef bufIndex 0+                    writePrimRef bufIndex 0                 else do                     copyMutablePrimArray outputBuffer 0 buf' 0 i'-                    writePrimIORef bufIndex i'+                    writePrimRef bufIndex i'         B.BufferFull buffer@(B.Buffer _ i') wantSiz k -> do             when (i' /= 0) (action =<< freezeBuffer buffer)             if wantSiz <= originBufSiz@@ -483,16 +492,24 @@         !arr <- unsafeFreezePrimArray buf         return (V.PrimVector arr 0 offset) +-- | Directly write 'B.Builder' into buffered handle then flush the buffer into output device (if buffer is not empty).+--+-- Equivalent to add a 'flushBuffer' after write.+writeBuilder' :: HasCallStack => BufferedOutput -> B.Builder () -> IO ()+{-# INLINABLE writeBuilder' #-}+writeBuilder' bo o = writeBuilder bo o >> flushBuffer bo+ -- | Flush the buffer into output device(if buffer is not empty). -- flushBuffer :: HasCallStack => BufferedOutput -> IO () {-# INLINABLE flushBuffer #-} flushBuffer BufferedOutput{..} = do-    i <- readPrimIORef bufIndex+    i <- readPrimRef bufIndex     when (i /= 0) $ do         withMutablePrimArrayContents outputBuffer $ \ ptr -> bufOutput ptr i-        writePrimIORef bufIndex 0+        writePrimRef bufIndex 0  -- | Clear already buffered output. clearOutputBuffer :: BufferedOutput -> IO ()-clearOutputBuffer BufferedOutput{..} = writePrimIORef bufIndex 0+{-# INLINABLE clearOutputBuffer #-}+clearOutputBuffer BufferedOutput{..} = writePrimRef bufIndex 0

@@ -36,7 +36,7 @@  import Control.Monad import Data.Word-import Z.Data.Vector.Base as V+import qualified Z.Data.Vector.Base as V import Z.Data.CBytes import Z.Foreign import Z.IO.Exception@@ -51,6 +51,7 @@ -- This is different from base's 'System.Environment.getArgs' since result -- includes the program path(more like C's *argv). getArgs :: IO [CBytes]+{-# INLINABLE getArgs #-} getArgs = do     (argc :: CInt, (p_argv :: Ptr CString, _)) <- allocPrimUnsafe $ \ p_argc -> do         allocPrimUnsafe $ \ p_p_argv -> do@@ -62,6 +63,7 @@ -- -- Warning: This function is not thread safe. getAllEnv :: HasCallStack => IO [(CBytes, CBytes)]+{-# INLINABLE getAllEnv #-} getAllEnv = bracket     (do (p_env :: Ptr CString, (envc :: CInt, _)) <- allocPrimUnsafe $ \ p_p_env -> do             allocPrimUnsafe $ \ p_envc ->@@ -78,6 +80,7 @@ -- -- Warning: This function is not thread safe. getEnv :: HasCallStack => CBytes -> IO (Maybe CBytes)+{-# INLINABLE getEnv #-} getEnv k = go 512   where     go siz = do@@ -96,6 +99,7 @@ -- -- Warning: This function is not thread safe. getEnv' :: HasCallStack => CBytes -> IO CBytes+{-# INLINABLE getEnv' #-} getEnv' k = getEnv k >>= \ mv -> case mv of     Just v -> return v     _ -> throwUVError UV_ENOENT (IOEInfo "ENOENT" "no such environment variable" callStack)@@ -104,6 +108,7 @@ -- -- Warning: This function is not thread safe. setEnv :: HasCallStack => CBytes -> CBytes -> IO ()+{-# INLINABLE setEnv #-} setEnv k v = withCBytesUnsafe k $ \ p_k ->     withCBytesUnsafe v $ \ p_v ->         throwUVIfMinus_ (uv_os_setenv p_k p_v)@@ -112,10 +117,12 @@ -- -- Warning: This function is not thread safe. unsetEnv :: HasCallStack => CBytes -> IO ()+{-# INLINABLE unsetEnv #-} unsetEnv k = void . withCBytesUnsafe k $ \ p -> throwUVIfMinus_ (uv_os_unsetenv p)  -- | Gets the resident set size (RSS) for the current process. getResidentSetMemory :: HasCallStack => IO CSize+{-# INLINABLE getResidentSetMemory #-} getResidentSetMemory = do     (size, r) <- allocPrimUnsafe uv_resident_set_memory     throwUVIfMinus_ (return r)@@ -123,6 +130,7 @@  -- | Gets the current system uptime. getUpTime :: HasCallStack => IO Double+{-# INLINABLE getUpTime #-} getUpTime = do     (size, r) <- allocPrimUnsafe uv_uptime     throwUVIfMinus_ (return r)@@ -134,6 +142,7 @@ -- It is not related to the time of day and therefore not subject to clock drift. -- The primary use is for measuring performance between intervals. getHighResolutionTime :: IO Word64+{-# INLINABLE getHighResolutionTime #-} getHighResolutionTime = uv_hrtime  -- | Gets the resource usage measures for the current process.@@ -141,6 +150,7 @@ --  On Windows not all fields are set, the unsupported fields are filled with zeroes. --  See 'ResUsage' for more details. getResUsage :: HasCallStack => IO ResUsage+{-# INLINABLE getResUsage #-} getResUsage = do     (MutableByteArray mba#) <- newByteArray sizeOfResUsage     throwUVIfMinus_ (uv_getrusage mba#)@@ -148,15 +158,18 @@  -- | Returns the current process ID. getPID :: IO PID+{-# INLINABLE getPID #-} getPID = uv_os_getpid  -- | Returns the parent process ID. getPPID :: IO PID+{-# INLINABLE getPPID #-} getPPID = uv_os_getppid  -- | Returns the hostname as a null-terminated string. -- getHostname :: HasCallStack => IO CBytes+{-# INLINABLE getHostname #-} getHostname = do     (n, _) <- allocCBytesUnsafe (fromIntegral UV_MAXHOSTNAMESIZE) $ \ p_n ->         withPrimUnsafe UV_MAXHOSTNAMESIZE $ \ p_siz ->@@ -168,6 +181,7 @@ -- The function may block indefinitely when not enough entropy is available, don't use it to get -- long random sequences. getRandom :: Int -> IO V.Bytes+{-# INLINABLE getRandom #-} getRandom siz = do     (v, _) <- allocPrimVectorUnsafe siz $ \ mba# ->         throwUVIfMinus_ (hs_uv_random mba# (fromIntegral siz) 0)@@ -177,6 +191,7 @@ -- -- The function run 'getRandom' in libuv's threadpool, suitable for get long random byte sequences. getRandomT :: Int -> IO V.Bytes+{-# INLINABLE getRandomT #-} getRandomT siz = do     (v, _) <- allocPrimVectorSafe siz $ \ p -> do         uvm <- getUVManager@@ -186,6 +201,7 @@ -- | Gets the current working directory. -- getCWD :: HasCallStack => IO CBytes+{-# INLINABLE getCWD #-} getCWD = go 512   where     go siz = do@@ -201,6 +217,7 @@ -- | Changes the current working directory. -- chDir :: HasCallStack => CBytes -> IO ()+{-# INLINABLE chDir #-} chDir p = throwUVIfMinus_ (withCBytesUnsafe p $ \ pp -> uv_chdir pp)  -- | Gets the current user’s home directory.@@ -212,6 +229,7 @@ -- -- Warning 'getHomeDir' is not thread safe. getHomeDir :: HasCallStack => IO CBytes+{-# INLINABLE getHomeDir #-} getHomeDir = go 512   where     go siz = do@@ -232,6 +250,7 @@ -- -- Warning 'getHomeDir' is not thread safe. getTempDir :: HasCallStack => IO CBytes+{-# INLINABLE getTempDir #-} getTempDir = go 512   where     go siz = do@@ -246,10 +265,12 @@  -- | Gets the amount of free memory available in the system, as reported by the kernel (in bytes). getFreeMem :: IO Word64+{-# INLINABLE getFreeMem #-} getFreeMem = uv_get_free_memory  -- | Gets the total amount of physical memory in the system (in bytes). getTotalMem :: IO Word64+{-# INLINABLE getTotalMem #-} getTotalMem = uv_get_total_memory  -- | Gets the amount of memory available to the process (in bytes) based on limits imposed by the OS.@@ -258,6 +279,7 @@ -- Note that it is not unusual for this value to be less than or greater than 'getTotalMem'. -- Note This function currently only returns a non-zero value on Linux, based on cgroups if it is present. getConstrainedMem :: IO Word64+{-# INLINABLE getConstrainedMem #-} getConstrainedMem = uv_get_constrained_memory  --------------------------------------------------------------------------------

@@ -103,9 +103,11 @@ instance Exception SomeIOException  ioExceptionToException :: Exception e => e -> SomeException+{-# INLINABLE ioExceptionToException #-} ioExceptionToException = toException . SomeIOException  ioExceptionFromException :: Exception e => SomeException -> Maybe e+{-# INLINABLE ioExceptionFromException #-} ioExceptionFromException x = do     SomeIOException a <- fromException x     cast a@@ -211,6 +213,7 @@ -- | Check if the given exception is synchronous -- isSyncException :: Exception e => e -> Bool+{-# INLINABLE isSyncException #-} isSyncException e =     case fromException (toException e) of         Just (SomeAsyncException _) -> False@@ -219,12 +222,14 @@ -- | Same as upstream 'C.catch', but will not catch asynchronous exceptions -- catchSync :: Exception e => IO a -> (e -> IO a) -> IO a+{-# INLINABLE catchSync #-} catchSync f g = f `catch` \ e ->     if isSyncException e then g e else throwIO e  -- | Ingore all synchronous exceptions. -- ignoreSync :: IO a -> IO ()+{-# INLINABLE ignoreSync #-} ignoreSync f = catchSync (void f) (\ (_ :: SomeException) -> return ())  --------------------------------------------------------------------------------@@ -240,6 +245,7 @@ instance Show IOEInfo where show = T.toString  instance T.Print IOEInfo where+    {-# INLINE toUTF8BuilderP #-}     toUTF8BuilderP _ (IOEInfo errno desc cstack) = do          "{name:"          T.text errno

@@ -120,7 +120,7 @@ import qualified Z.Data.Builder           as B import           Z.Data.CBytes            as CBytes import qualified Z.Data.JSON              as JSON-import           Z.Data.PrimRef.PrimIORef+import           Z.Data.PrimRef import qualified Z.Data.Text              as T import qualified Z.Data.Text.Print        as T import qualified Z.Data.Vector            as V@@ -153,12 +153,14 @@  -- | Return File fd. getFileFD :: File -> IO FD+{-# INLINABLE getFileFD #-} getFileFD (File fd closedRef) = do     closed <- readIORef closedRef     if closed then throwECLOSED else return fd  -- | If fd is -1 (closed), throw 'ResourceVanished' ECLOSED. checkFileClosed :: HasCallStack => File -> (FD -> IO a) -> IO a+{-# INLINABLE checkFileClosed #-} checkFileClosed (File fd closedRef) f = do     closed <- readIORef closedRef     if closed then throwECLOSED else f fd@@ -167,11 +169,13 @@ -- -- Equivalent to <https://linux.die.net/man/3/lseek64 lseek64(3)>. seek :: HasCallStack => File -> Int64 -> Whence -> IO Int64+{-# INLINABLE seek #-} 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+    {-# INLINABLE readInput #-}     readInput f buf bufSiz = readFileP f buf bufSiz (-1)  -- | Read file with given offset@@ -183,10 +187,12 @@            -> Int       -- ^ buffer size            -> Int64     -- ^ file offset, pass -1 to use default(system) offset            -> IO Int    -- ^ read length+{-# INLINABLE readFileP #-} readFileP uvf buf bufSiz off =     checkFileClosed uvf $ \ fd -> throwUVIfMinus $ hs_uv_fs_read fd buf bufSiz off  instance Output File where+    {-# INLINABLE writeOutput #-}     writeOutput f buf bufSiz = writeFileP f buf bufSiz (-1)  -- | Write buffer to file@@ -207,6 +213,7 @@             -> Int       -- ^ buffer size             -> Int64     -- ^ file offset, pass -1 to use default(system) offset             -> IO ()+{-# INLINABLE writeFileP #-} writeFileP uvf buf0 bufSiz0 off0 =     checkFileClosed uvf $ \fd ->  if off0 == -1 then go fd buf0 bufSiz0                                                 else go' fd buf0 bufSiz0 off0@@ -236,6 +243,7 @@          -> FileMode        -- ^ Sets the file mode (permission and sticky bits),                             -- but only if the file was created, see 'DEFAULT_FILE_MODE'.          -> Resource File+{-# INLINABLE initFile #-} initFile path flags mode =     initResource         (do !fd <- withCBytesUnsafe path $ \ p ->@@ -256,6 +264,7 @@ -- Note mode is currently not implemented on Windows. On unix you should set execute bit -- if you want the directory is accessable, e.g. 0o777. mkdir :: HasCallStack => CBytes -> FileMode -> IO ()+{-# INLINABLE mkdir #-} mkdir path mode = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->      hs_uv_fs_mkdir p mode @@ -269,6 +278,7 @@ -- can be created), e.g. 'DEFAULT_DIR_MODE'. -- mkdirp :: HasCallStack => CBytes -> FileMode -> IO ()+{-# INLINABLE mkdirp #-} mkdirp path mode = do     r <- withCBytesUnsafe path $ \ p -> hs_uv_fs_mkdir p mode     case fromIntegral r of@@ -294,6 +304,7 @@  -- | Equivalent to <http://linux.die.net/man/2/unlink unlink(2)>. unlink :: HasCallStack => CBytes -> IO ()+{-# INLINABLE unlink #-} unlink path = throwUVIfMinus_ (withCBytesUnsafe path hs_uv_fs_unlink)  @@ -309,6 +320,7 @@ -- so no need to add XXXXXX ending. -- mkdtemp :: HasCallStack => CBytes -> IO CBytes+{-# INLINABLE mkdtemp #-} mkdtemp path = do     let size = CBytes.length path     withCBytesUnsafe path $ \ p -> do@@ -329,6 +341,7 @@         -> CBytes       -- ^ A file path prefix template, no "XXXXXX" needed.         -> Bool         -- ^ Keep file after used?         -> Resource (CBytes, File)+{-# INLINABLE mkstemp #-} mkstemp dir template keep = do     initResource         (do template' <- dir `P.join` template@@ -349,12 +362,14 @@ -- -- Note this function may inherent OS limitations such as argument must be an empty folder. rmdir :: HasCallStack => CBytes -> IO ()+{-# INLINABLE rmdir #-} rmdir path = throwUVIfMinus_ (withCBytesUnsafe path hs_uv_fs_rmdir)  -- | Removes a file or directory at path together with its contents and -- subdirectories. Symbolic links are removed without affecting their targets. -- If the path does not exist, nothing happens. rmrf :: HasCallStack => CBytes -> IO ()+{-# INLINABLE rmrf #-} rmrf path =     withCBytesUnsafe path $ \path' ->     allocaBytes uvStatSize $ \s -> do@@ -385,6 +400,7 @@ -- systems (btrfs, ext2, ext3 and ext4 at the time of this writing), check the -- <http://linux.die.net/man/2/getdents getdents(2)> man page. scandir :: HasCallStack => CBytes -> IO [(CBytes, DirEntType)]+{-# INLINABLE scandir #-} scandir path = do     bracket         (withCBytesUnsafe path $ \ p ->@@ -403,6 +419,7 @@  -- | Equivalent to <http://linux.die.net/man/2/stat stat(2)> stat :: HasCallStack => CBytes -> IO FStat+{-# INLINABLE stat #-} stat path = withCBytesUnsafe path $ \ p ->      allocaBytes uvStatSize $ \ s -> do         throwUVIfMinus_ (hs_uv_fs_stat p s)@@ -410,6 +427,7 @@  -- | Equivalent to <http://linux.die.net/man/2/lstat lstat(2)> lstat :: HasCallStack => CBytes -> IO FStat+{-# INLINABLE lstat #-} lstat path = withCBytesUnsafe path $ \ p ->      allocaBytes uvStatSize $ \ s -> do         throwUVIfMinus_ (hs_uv_fs_lstat p s)@@ -419,6 +437,7 @@ -- -- Return 'Nothing' instead of throwing 'NoSuchThing' if the file doesn't exist. stat' :: HasCallStack => CBytes -> IO (Maybe FStat)+{-# INLINABLE stat' #-} stat' path = withCBytesUnsafe path $ \ p ->      allocaBytes uvStatSize $ \ s -> do         r <- fromIntegral <$> hs_uv_fs_stat p s@@ -430,6 +449,7 @@ -- -- Return 'Nothing' instead of throwing 'NoSuchThing' if the link doesn't exist. lstat' :: HasCallStack => CBytes -> IO (Maybe FStat)+{-# INLINABLE lstat' #-} lstat' path = withCBytesUnsafe path $ \ p ->      allocaBytes uvStatSize $ \ s -> do         r <- fromIntegral <$> hs_uv_fs_lstat p s@@ -439,6 +459,7 @@  -- | Equivalent to <http://linux.die.net/man/2/fstat fstat(2)> fstat :: HasCallStack => File -> IO FStat+{-# INLINABLE fstat #-} fstat uvf = checkFileClosed uvf $ \ fd ->     allocaBytes uvStatSize $ \ s -> do         throwUVIfMinus_ (hs_uv_fs_fstat fd s)@@ -450,25 +471,30 @@ -- -- Note On Windows if this function fails with UV_EBUSY, UV_EPERM or UV_EACCES, it will retry to rename the file up to four times with 250ms wait between attempts before giving up. If both path and new_path are existing directories this function will work only if target directory is empty. rename :: HasCallStack => CBytes -> CBytes -> IO ()+{-# INLINABLE rename #-} rename path path' = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->     withCBytesUnsafe path' (hs_uv_fs_rename p)  -- | Equivalent to <http://linux.die.net/man/2/fsync fsync(2)>. fsync :: HasCallStack => File -> IO ()+{-# INLINABLE fsync #-} fsync uvf = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fsync fd  -- | Equivalent to <http://linux.die.net/man/2/fdatasync fdatasync(2)>. fdatasync :: HasCallStack => File -> IO ()+{-# INLINABLE fdatasync #-} fdatasync uvf = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fdatasync fd  -- | Equivalent to <http://linux.die.net/man/2/ftruncate ftruncate(2)>. ftruncate :: HasCallStack => File -> Int64 -> IO ()+{-# INLINABLE ftruncate #-} ftruncate uvf off = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_ftruncate fd off  -- | Copies a file from path to new_path. -- -- Warning: If the destination path is created, but an error occurs while copying the data, then the destination path is removed. There is a brief window of time between closing and removing the file where another process could access the file. copyfile :: HasCallStack => CBytes -> CBytes -> CopyFileFlag -> IO ()+{-# INLINABLE copyfile #-} copyfile path path' flag = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->     withCBytesUnsafe path' $ \ p' -> hs_uv_fs_copyfile p p' flag @@ -476,6 +502,7 @@ -- -- Windows uses GetFileAttributesW(). access :: HasCallStack => CBytes -> AccessMode -> IO AccessResult+{-# INLINABLE access #-} access path mode = do      r <- withCBytesUnsafe path $ \ p -> fromIntegral <$> hs_uv_fs_access p mode      if | r == 0           -> return AccessOK@@ -488,10 +515,12 @@  -- | Equivalent to <http://linux.die.net/man/2/chmod chmod(2)>. chmod :: HasCallStack => CBytes -> FileMode -> IO ()+{-# INLINABLE chmod #-} chmod path mode = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_chmod p mode  -- | Equivalent to <http://linux.die.net/man/2/fchmod fchmod(2)>. fchmod :: HasCallStack => File -> FileMode -> IO ()+{-# INLINABLE fchmod #-} fchmod uvf mode = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fchmod fd mode  -- | Equivalent to <http://linux.die.net/man/2/utime utime(2)>.@@ -502,12 +531,14 @@       -> Double     -- ^ atime, i.e. access time       -> Double     -- ^ mtime, i.e. modify time       -> IO ()+{-# INLINABLE utime #-} utime path atime mtime = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_utime p atime mtime  -- | Equivalent to <https://man7.org/linux/man-pages/man3/futimes.3.html futime(3)>. -- -- Same precision notes with 'utime'. futime :: HasCallStack => File -> Double -> Double -> IO ()+{-# INLINABLE futime #-} futime uvf atime mtime = checkFileClosed uvf $ \ fd ->     throwUVIfMinus_ (hs_uv_fs_futime fd atime mtime) @@ -519,10 +550,12 @@        -> Double     -- ^ atime, i.e. access time        -> Double     -- ^ mtime, i.e. modify time        -> IO ()+{-# INLINABLE lutime #-} lutime path atime mtime = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_lutime p atime mtime  -- | Equivalent to <http://linux.die.net/man/2/link link(2)>. link :: HasCallStack => CBytes -> CBytes -> IO ()+{-# INLINABLE link #-} link path path' = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->     withCBytesUnsafe path' $ hs_uv_fs_link p @@ -535,11 +568,13 @@ -- -- On other platforms these flags are ignored. symlink :: HasCallStack => CBytes -> CBytes -> SymlinkFlag -> IO ()+{-# INLINABLE symlink #-} symlink path path' flag = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->     withCBytesUnsafe path' $ \ p' -> hs_uv_fs_symlink p p' flag  -- | Equivalent to <http://linux.die.net/man/2/readlink readlink(2)>. readlink :: HasCallStack => CBytes -> IO CBytes+{-# INLINABLE readlink #-} readlink path = do     bracket         (withCBytesUnsafe path $ \ p ->@@ -567,6 +602,7 @@ -- -- Note This function is not implemented on Windows XP and Windows Server 2003. On these systems, UV_ENOSYS is returned. realpath :: HasCallStack => CBytes -> IO CBytes+{-# INLINABLE realpath #-} realpath path = do     bracket         (withCBytesUnsafe path $ \ p ->@@ -577,12 +613,15 @@  -- | Equivalent to <http://linux.die.net/man/2/chown chown(2)>. chown :: HasCallStack => CBytes -> UID -> GID -> IO ()+{-# INLINABLE chown #-} chown path uid gid = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_chown p uid gid  -- | Equivalent to <http://linux.die.net/man/2/fchown fchown(2)>. fchown :: HasCallStack => File -> UID -> GID -> IO ()+{-# INLINABLE fchown #-} fchown uvf uid gid = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fchown fd uid gid  -- | Equivalent to <http://linux.die.net/man/2/lchown lchown(2)>. lchown :: HasCallStack => CBytes -> UID -> GID -> IO ()+{-# INLINABLE lchown #-} lchown path uid gid = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_lchown p uid gid

@@ -75,10 +75,12 @@     deriving anyclass (T.Print, JSON)  enumToPathStyle_ :: CInt -> PathStyle+{-# INLINABLE enumToPathStyle_ #-} enumToPathStyle_ (#const CWK_STYLE_WINDOWS) = WindowsStyle enumToPathStyle_ _ = UnixStyle  pathStyleToEnum_ :: PathStyle -> CInt+{-# INLINABLE pathStyleToEnum_ #-} pathStyleToEnum_ WindowsStyle = (#const CWK_STYLE_WINDOWS) pathStyleToEnum_ _ = (#const CWK_STYLE_UNIX) @@ -96,10 +98,12 @@ -- * If nothing was found to determine the style -> UNIX -- pathStyle :: CBytes -> IO PathStyle+{-# INLINABLE pathStyle #-} pathStyle p = enumToPathStyle_ <$> withCBytesUnsafe p cwk_path_guess_style  -- | Gets the path style currently using. getPathStyle :: IO PathStyle+{-# INLINABLE getPathStyle #-} getPathStyle = enumToPathStyle_ <$> cwk_path_get_style  -- | Configures which path style is used afterwards.@@ -108,10 +112,12 @@ -- call to this function is only required if a non-native behaviour is required. -- The style defaults to 'WindowsStyle' on windows builds and to 'UnixStyle' otherwise. setPathStyle :: PathStyle -> IO ()+{-# INLINABLE setPathStyle #-} setPathStyle = cwk_path_set_style . pathStyleToEnum_  -- | Get the default character that separates directories. pathSeparator :: IO Word8+{-# INLINABLE pathSeparator #-} pathSeparator = do     s <- getPathStyle     case s of UnixStyle -> return (#const SLASH)@@ -119,6 +125,7 @@  -- | Get characters that separates directories. pathSeparators :: IO [Word8]+{-# INLINABLE pathSeparators #-} pathSeparators = do     s <- getPathStyle     case s of UnixStyle -> return [(#const SLASH)]@@ -126,6 +133,7 @@  -- | Test if a character is a path separator. isPathSeparator :: Word8 -> IO Bool+{-# INLINABLE isPathSeparator #-} isPathSeparator w = do     s <- getPathStyle     case s of UnixStyle -> return (w == #const SLASH)@@ -137,6 +145,7 @@ -- * Unix:    searchPathSeparator is ASCII @:@ -- searchPathSeparator :: IO Word8+{-# INLINABLE searchPathSeparator #-} searchPathSeparator = do     s <- getPathStyle     case s of UnixStyle -> return (#const COLON)@@ -144,6 +153,7 @@  -- | Test if a character is a file separator. isSearchPathSeparator :: Word8 -> IO Bool+{-# INLINABLE isSearchPathSeparator #-} isSearchPathSeparator w = do     w' <- searchPathSeparator     return (w == w')@@ -152,10 +162,12 @@ -- -- ExtSeparator is ASCII @.@ extensionSeparator :: Word8+{-# INLINABLE extensionSeparator #-} extensionSeparator = #const DOT  -- | Test if a character is a file extension separator. isExtensionSeparator :: Word8 -> Bool+{-# INLINABLE isExtensionSeparator #-} isExtensionSeparator = (== #const DOT)  -- | Get the basename of a file path.@@ -205,6 +217,7 @@ changeBaseName :: CBytes                -> CBytes   -- ^ new base name                -> IO CBytes+{-# INLINABLE changeBaseName #-} changeBaseName p b = do     let l = CB.length p + CB.length b + (#const BUF_EXT_SIZ)     (p', _) <- withCBytesUnsafe p $ \ pp ->@@ -268,6 +281,7 @@ changeRoot :: CBytes            -> CBytes   -- ^ new base name            -> IO CBytes+{-# INLINABLE changeRoot #-} changeRoot p r = do     let l = CB.length p + CB.length r + (#const BUF_EXT_SIZ)     (p', _) <- withCBytesUnsafe p $ \ pp ->@@ -329,6 +343,7 @@ -- +---------+--------------------------+-----------+ -- isAbsolute :: CBytes -> IO Bool+{-# INLINABLE isAbsolute #-} isAbsolute p = (/=0) <$> withCBytesUnsafe p cwk_path_is_absolute  -- | Determine whether the path is relative or not.@@ -365,6 +380,7 @@ -- +---------+--------------------------+-----------+ -- isRelative :: CBytes -> IO Bool+{-# INLINABLE isRelative #-} isRelative p = (/=0) <$> withCBytesUnsafe p cwk_path_is_relative  -- | Joins two paths together.@@ -392,6 +408,7 @@ -- +---------+-----------------------+---------------------------+--------------------------------------+ -- join :: CBytes -> CBytes -> IO CBytes+{-# INLINABLE join #-} join p p2 = do     let l = CB.length p + CB.length p2 + (#const BUF_EXT_SIZ)     (p', _) <- withCBytesUnsafe p $ \ pp ->@@ -406,6 +423,7 @@ -- It will remove double separators, and unlike 'absolute', -- it permits the use of multiple relative paths to combine. concat :: [CBytes] -> IO CBytes+{-# INLINABLE concat #-} concat ps = do     (p', _) <- withCBytesListUnsafe ps $ \ pp l -> do         let l' = sum (List.map (\ p -> CB.length p + (#const BUF_EXT_SIZ)) ps)@@ -440,6 +458,7 @@ -- +--------------------------------------------------+-------------------+ -- normalize :: CBytes -> IO CBytes+{-# INLINABLE normalize #-} normalize p = do     let l = CB.length p + (#const BUF_EXT_SIZ)     (p', _) <- withCBytesUnsafe p $ \ pp ->@@ -478,6 +497,7 @@ intersection :: CBytes      -- ^ The base path which will be compared with the other path.              -> CBytes      -- ^ The other path which will compared with the base path.              -> IO CBytes+{-# INLINABLE intersection #-} intersection p1 p2 = do     len <- withCBytesUnsafe p1 $ \ pp1 ->         withCBytesUnsafe p2 $ \ pp2 ->@@ -511,6 +531,7 @@ absolute :: CBytes  -- ^ The absolute base path on which the relative path will be applied.          -> CBytes  -- ^ The relative path which will be applied on the base path.          -> IO CBytes+{-# INLINABLE absolute #-} absolute p p2 = do     let l = CB.length p + CB.length p2 + (#const BUF_EXT_SIZ)     (p', _) <- withCBytesUnsafe p $ \ pp ->@@ -557,6 +578,7 @@          => CBytes  -- ^ The base path from which the relative path will start.          -> CBytes  -- ^ The target path where the relative path will point to.          -> IO CBytes+{-# INLINABLE relative #-} relative p p2 = do     let l = (CB.length p `unsafeShiftL` 1) + CB.length p2 + (#const BUF_EXT_SIZ)     (p', r) <- withCBytesUnsafe p $ \ pp ->@@ -615,7 +637,7 @@ -- dropExtension :: CBytes -- ^ file path               -> IO CBytes-{-# INLINE dropExtension #-}+{-# INLINABLE dropExtension #-} dropExtension p = fst <$> splitExtension p  -- | Get the extension of a file from a file path, returns @\"\"@ for no@@ -637,12 +659,13 @@ -- takeExtension :: CBytes -- ^ file path               -> IO CBytes-{-# INLINE takeExtension #-}+{-# INLINABLE takeExtension #-} takeExtension p = snd <$> splitExtension p  -- | Test if a file from a file path has an extension. hasExtension :: CBytes -- ^ file path              -> IO Bool+{-# INLINABLE hasExtension #-} hasExtension p = do     withCBytesUnsafe p $ \ p' ->         cwk_path_has_extension p'@@ -667,6 +690,7 @@ changeExtension :: CBytes  -- ^ The path which will be used to make the change.                 -> CBytes  -- ^ The extension which will be placed within the new path.                 -> IO CBytes+{-# INLINABLE changeExtension #-} changeExtension p p2 = do     let l = CB.length p + CB.length p2 + (#const BUF_EXT_SIZ)     (p', _) <- withCBytesUnsafe p $ \ pp ->@@ -679,6 +703,7 @@  -- | Get a list of paths in the @$PATH@ variable. getSearchPath :: IO [CBytes]+{-# INLINABLE getSearchPath #-} getSearchPath = do     s <- getEnv' "PATH"     sp <- searchPathSeparator

@@ -132,7 +132,7 @@ import qualified Z.Data.Builder           as B import           Z.Data.CBytes            as CBytes import qualified Z.Data.JSON              as JSON-import           Z.Data.PrimRef.PrimIORef+import           Z.Data.PrimRef import qualified Z.Data.Text              as T import qualified Z.Data.Text.Print        as T import qualified Z.Data.Vector            as V@@ -165,16 +165,19 @@ instance Show File where show = T.toString  instance T.Print File where+    {-# INLINABLE toUTF8BuilderP #-}     toUTF8BuilderP _ (File fd _) = "File " >> T.int fd  -- | Return File fd. getFileFD :: File -> IO FD+{-# INLINABLE getFileFD #-} getFileFD (File fd closedRef) = do     closed <- readIORef closedRef     if closed then throwECLOSED else return fd  -- | If fd is -1 (closed), throw 'ResourceVanished' ECLOSED. checkFileClosed :: HasCallStack => File -> (FD -> IO a) -> IO a+{-# INLINABLE checkFileClosed #-} checkFileClosed (File fd closedRef) f = do     closed <- readIORef closedRef     if closed then throwECLOSED else f fd@@ -183,9 +186,11 @@ -- -- Equivalent to <https://linux.die.net/man/3/lseek64 lseek64(3)>. seek :: HasCallStack => File -> Int64 -> Whence -> IO Int64+{-# INLINABLE seek #-} seek uvf off w = checkFileClosed uvf $ \ fd -> throwUVIfMinus $ hs_seek fd off w  instance Input File where+    {-# INLINABLE readInput #-}     readInput f buf bufSiz = readFileP f buf bufSiz (-1)  -- | Read file with given offset@@ -197,12 +202,14 @@           -> Int       -- ^ buffer size           -> Int64     -- ^ file offset, pass -1 to use default(system) offset           -> IO Int    -- ^ read length+{-# INLINABLE readFileP #-} readFileP uvf buf bufSiz off =     checkFileClosed uvf  $ \ fd -> do         uvm <- getUVManager         withUVRequest uvm (hs_uv_fs_read_threaded fd buf bufSiz off)  instance Output File where+    {-# INLINABLE writeOutput #-}     writeOutput f buf bufSiz = writeFileP f buf bufSiz (-1)  -- | Write buffer to file@@ -223,6 +230,7 @@            -> Int       -- ^ buffer size            -> Int64     -- ^ file offset, pass -1 to use default(system) offset            -> IO ()+{-# INLINABLE writeFileP #-} writeFileP uvf buf0 bufSiz0 off0 =     checkFileClosed uvf $ \ fd -> do              (if off0 == -1 then go fd buf0 bufSiz0@@ -259,6 +267,7 @@           -> FileMode        -- ^ Sets the file mode (permission and sticky bits),                                -- but only if the file was created, see 'DEFAULT_FILE_MODE'.           -> Resource File+{-# INLINABLE initFile #-} initFile path flags mode =     initResource         (do uvm <- getUVManager@@ -278,6 +287,7 @@ -- Note mode is currently not implemented on Windows. On unix you should set execute bit -- if you want the directory is accessable, e.g. 0o777. mkdir :: HasCallStack => CBytes -> FileMode -> IO ()+{-# INLINABLE mkdir #-} mkdir path mode = do     uvm <- getUVManager     withCBytesUnsafe path $ \ p ->@@ -293,6 +303,7 @@ -- can be created), e.g. 'DEFAULT_DIR_MODE'. -- mkdirp :: HasCallStack => CBytes -> FileMode -> IO ()+{-# INLINABLE mkdirp #-} mkdirp path mode = do     uvm <- getUVManager     r <- withCBytesUnsafe path $ \ p ->@@ -320,6 +331,7 @@  -- | Equivalent to <http://linux.die.net/man/2/unlink unlink(2)>. unlink :: HasCallStack => CBytes -> IO ()+{-# INLINABLE unlink #-} unlink path = do     uvm <- getUVManager     withCBytesUnsafe path $ \ p ->@@ -337,6 +349,7 @@ -- so no need to add XXXXXX ending. -- mkdtemp :: HasCallStack => CBytes -> IO CBytes+{-# INLINABLE mkdtemp #-} mkdtemp path = do     let size = CBytes.length path     withCBytesUnsafe path $ \ p -> do@@ -358,6 +371,7 @@         -> CBytes       -- ^ A file path prefix template, no "XXXXXX" needed.         -> Bool         -- ^ Keep file after used?         -> Resource (CBytes, File)+{-# INLINABLE mkstemp #-} mkstemp dir template keep = do     initResource         (do template' <- dir `P.join` template@@ -377,6 +391,7 @@ -- -- Note this function may inherent OS limitations such as argument must be an empty folder. rmdir :: HasCallStack => CBytes -> IO ()+{-# INLINABLE rmdir #-} rmdir path = do     uvm <- getUVManager     withCBytesUnsafe path (\ p -> void . withUVRequest uvm $ hs_uv_fs_rmdir_threaded p)@@ -385,6 +400,7 @@ -- subdirectories. Symbolic links are removed without affecting their targets. -- If the path does not exist, nothing happens. rmrf :: HasCallStack => CBytes -> IO ()+{-# INLINABLE rmrf #-} rmrf path =     withCBytesUnsafe path $ \path' ->     allocaBytes uvStatSize $ \s -> do@@ -416,6 +432,7 @@ -- -- Note On Linux, getting the type of an entry is only supported by some file systems (btrfs, ext2, ext3 and ext4 at the time of this writing), check the <http://linux.die.net/man/2/getdents getdents(2)> man page. scandir :: HasCallStack => CBytes -> IO [(CBytes, DirEntType)]+{-# INLINABLE scandir #-} scandir path = do     uvm <- getUVManager     bracket@@ -436,6 +453,7 @@  -- | Equivalent to <http://linux.die.net/man/2/stat stat(2)> stat :: HasCallStack => CBytes -> IO FStat+{-# INLINABLE stat #-} stat path = do     withCBytesUnsafe path $ \ p ->          allocaBytes uvStatSize $ \ s -> do@@ -445,6 +463,7 @@  -- | Equivalent to <http://linux.die.net/man/2/lstat lstat(2)> lstat :: HasCallStack => CBytes -> IO FStat+{-# INLINABLE lstat #-} lstat path =     withCBytesUnsafe path $ \ p ->          allocaBytes uvStatSize $ \ s -> do@@ -456,6 +475,7 @@ -- -- Return 'Nothing' instead of throwing 'NoSuchThing' if the file doesn't exist. stat' :: HasCallStack => CBytes -> IO (Maybe FStat)+{-# INLINABLE stat' #-} stat' path = do     withCBytesUnsafe path $ \ p ->          allocaBytes uvStatSize $ \ s -> do@@ -469,6 +489,7 @@ -- -- Return 'Nothing' instead of throwing 'NoSuchThing' if the link doesn't exist. lstat' :: HasCallStack => CBytes -> IO (Maybe FStat)+{-# INLINABLE lstat' #-} lstat' path =     withCBytesUnsafe path $ \ p ->          allocaBytes uvStatSize $ \ s -> do@@ -480,6 +501,7 @@  -- | Equivalent to <http://linux.die.net/man/2/fstat fstat(2)> fstat :: HasCallStack => File -> IO FStat+{-# INLINABLE fstat #-} fstat uvf = checkFileClosed uvf $ \ fd ->      (allocaBytes uvStatSize $ \ s -> do         uvm <- getUVManager@@ -492,6 +514,7 @@ -- -- Note On Windows if this function fails with UV_EBUSY, UV_EPERM or UV_EACCES, it will retry to rename the file up to four times with 250ms wait between attempts before giving up. If both path and new_path are existing directories this function will work only if target directory is empty. rename :: HasCallStack => CBytes -> CBytes -> IO ()+{-# INLINABLE rename #-} rename path path' = do     uvm <- getUVManager     withCBytesUnsafe path $ \ p ->@@ -500,18 +523,21 @@  -- | Equivalent to <http://linux.die.net/man/2/fsync fsync(2)>. fsync :: HasCallStack => File -> IO ()+{-# INLINABLE fsync #-} fsync uvf = checkFileClosed uvf $ \ fd -> do     uvm <- getUVManager     withUVRequest_ uvm (hs_uv_fs_fsync_threaded fd)  -- | Equivalent to <http://linux.die.net/man/2/fdatasync fdatasync(2)>. fdatasync :: HasCallStack => File -> IO ()+{-# INLINABLE fdatasync #-} fdatasync uvf = checkFileClosed uvf $ \ fd -> do     uvm <- getUVManager     withUVRequest_ uvm (hs_uv_fs_fdatasync_threaded fd)  -- | Equivalent to <http://linux.die.net/man/2/ftruncate ftruncate(2)>. ftruncate :: HasCallStack => File -> Int64 -> IO ()+{-# INLINABLE ftruncate #-} ftruncate uvf off = checkFileClosed uvf $ \ fd -> do     uvm <- getUVManager     withUVRequest_ uvm (hs_uv_fs_ftruncate_threaded fd off)@@ -520,6 +546,7 @@ -- -- Warning: If the destination path is created, but an error occurs while copying the data, then the destination path is removed. There is a brief window of time between closing and removing the file where another process could access the file. copyfile :: HasCallStack => CBytes -> CBytes -> CopyFileFlag -> IO ()+{-# INLINABLE copyfile #-} copyfile path path' flag = do     uvm <- getUVManager     withCBytesUnsafe path $ \ p ->@@ -529,6 +556,7 @@ -- | Equivalent to <http://linux.die.net/man/2/access access(2)> on Unix. -- Windows uses GetFileAttributesW(). access :: HasCallStack => CBytes -> AccessMode -> IO AccessResult+{-# INLINABLE access #-} access path mode = do     uvm <- getUVManager     withCBytesUnsafe path $ \ p ->@@ -545,6 +573,7 @@  -- | Equivalent to <http://linux.die.net/man/2/chmod chmod(2)>. chmod :: HasCallStack => CBytes -> FileMode -> IO ()+{-# INLINABLE chmod #-} chmod path mode = do     uvm <- getUVManager     withCBytesUnsafe path $ \ p ->@@ -552,6 +581,7 @@  -- | Equivalent to <http://linux.die.net/man/2/fchmod fchmod(2)>. fchmod :: HasCallStack => File -> FileMode -> IO ()+{-# INLINABLE fchmod #-} fchmod uvf mode = checkFileClosed uvf $ \ fd -> do     uvm <- getUVManager     withUVRequest_ uvm (hs_uv_fs_fchmod_threaded fd mode)@@ -565,6 +595,7 @@       -> Double     -- ^ atime, i.e. access time       -> Double     -- ^ mtime, i.e. modify time       -> IO ()+{-# INLINABLE utime #-} utime path atime mtime = do     uvm <- getUVManager     withCBytesUnsafe path $ \ p ->@@ -574,6 +605,7 @@ -- -- Same precision notes with 'utime'. futime :: HasCallStack => File -> Double -> Double -> IO ()+{-# INLINABLE futime #-} futime uvf atime mtime = checkFileClosed uvf $ \ fd -> do     uvm <- getUVManager     withUVRequest_ uvm (hs_uv_fs_futime_threaded fd atime mtime)@@ -586,6 +618,7 @@        -> Double     -- ^ atime, i.e. access time        -> Double     -- ^ mtime, i.e. modify time        -> IO ()+{-# INLINABLE lutime #-} lutime path atime mtime = do     uvm <- getUVManager     withCBytesUnsafe path $ \ p ->@@ -593,6 +626,7 @@  -- | Equivalent to <http://linux.die.net/man/2/link link(2)>. link :: HasCallStack => CBytes -> CBytes -> IO ()+{-# INLINABLE link #-} link path path' = do     uvm <- getUVManager     withCBytesUnsafe path $ \ p ->@@ -608,6 +642,7 @@ -- -- On other platforms these flags are ignored. symlink :: HasCallStack => CBytes -> CBytes -> SymlinkFlag -> IO ()+{-# INLINABLE symlink #-} symlink path path' flag = do     uvm <- getUVManager     withCBytesUnsafe path $ \ p ->@@ -616,6 +651,7 @@  -- | Equivalent to <http://linux.die.net/man/2/readlink readlink(2)>. readlink :: HasCallStack => CBytes -> IO CBytes+{-# INLINABLE readlink #-} readlink path = do     uvm <- getUVManager     bracket@@ -645,6 +681,7 @@ -- -- Note This function is not implemented on Windows XP and Windows Server 2003. On these systems, UV_ENOSYS is returned. realpath :: HasCallStack => CBytes -> IO CBytes+{-# INLINABLE realpath #-} realpath path = do     uvm <- getUVManager     bracket@@ -658,6 +695,7 @@  -- | Equivalent to <http://linux.die.net/man/2/chown chown(2)>. chown :: HasCallStack => CBytes -> UID -> GID -> IO ()+{-# INLINABLE chown #-} chown path uid gid = do     uvm <- getUVManager     withCBytesUnsafe path $ \ p ->@@ -665,12 +703,14 @@  -- | Equivalent to <http://linux.die.net/man/2/fchown fchown(2)>. fchown :: HasCallStack => FD -> UID -> GID -> IO ()+{-# INLINABLE fchown #-} fchown fd uid gid = do     uvm <- getUVManager     withUVRequest_ uvm (hs_uv_fs_fchown_threaded fd uid gid)  -- | Equivalent to <http://linux.die.net/man/2/lchown lchown(2)>. lchown :: HasCallStack => CBytes -> UID -> GID -> IO ()+{-# INLINABLE lchown #-} lchown path uid gid = do     uvm <- getUVManager     withCBytesUnsafe path $ \ p ->

@@ -16,7 +16,7 @@     -- dup a file event source     src <- srcf     -- print event to stdout-    runBIO_ $ src . sinkToIO printStd+    BIO.run_ $ src . sinkToIO printStd @ -} @@ -37,7 +37,6 @@ import           Data.Primitive.PrimArray import           Data.Word import           GHC.Generics-import           Z.Data.Array import           Z.Data.Array.Unaligned import           Z.Data.CBytes            (CBytes) import qualified Z.Data.CBytes            as CBytes@@ -45,8 +44,7 @@ import           Z.Data.Text.Print        (Print) import           Z.Data.Vector            (defaultChunkSize) import           Z.Foreign-import           Z.IO.BIO-import           Z.IO.BIO.Concurrent+import           Z.IO.BIO                 as BIO import           Z.IO.Exception import           Z.IO.FileSystem.Base import qualified Z.IO.FileSystem.FilePath as P@@ -65,15 +63,17 @@           -> Bool         -- ^ recursively watch?           -> (FileEvent -> IO ())  -- ^ Callback function to handle 'FileEvent'           -> IO ()+{-# INLINABLE watchDirs #-} watchDirs dirs rec callback = do     withResource (initWatchDirs dirs rec) $ \ srcf -> do         src <- srcf-        runBIO_ $ src . sinkToIO callback+        run_ $ src . sinkToIO callback  -- | Start watching a list of given directories, stream version. initWatchDirs :: [CBytes]       -- ^ watching list               -> Bool           -- ^ recursively watch?               -> Resource (IO (Source FileEvent))+{-# INLINABLE initWatchDirs #-} initWatchDirs dirs False = do     liftIO . forM_ dirs $ \ dir -> do         b <- isDir dir@@ -91,11 +91,12 @@  -- Internal function to start watching watch_ :: CUInt -> [CBytes] -> Resource (IO (Source FileEvent))+{-# INLINABLE watch_ #-} watch_ flag dirs = fst <$> initResource (do     -- HashMap to store all watchers     mRef <- newMVar HM.empty     -- there's only one place to pull the sink, that is cleanUpWatcher-    (sink, srcf) <- newBroadcastTChanNode 1+    (sink, srcf) <- newBroadcastTChanPair 1     -- lock UVManager first     (forM_ dirs $ \ dir -> do         dir' <- P.normalize dir@@ -207,7 +208,7 @@                 case me of                     Just e -> (Nothing, Just e)                     _      -> (Nothing, Nothing)-            forM_ me' (stepBIO_ sink)+            forM_ me' (BIO.step_ sink)          me' <- atomicModifyIORef' eRef $ \ me ->             case me of@@ -215,4 +216,4 @@                     then (me, Nothing)                     else (Just event, Just e)                 _ -> (Just event, Nothing)-        forM_ me' (stepBIO_ sink)+        forM_ me' (BIO.step_ sink)

@@ -94,7 +94,7 @@ import qualified Z.Data.Builder          as B import qualified Z.Data.CBytes           as CB import qualified Z.Data.JSON.Builder     as JB-import           Z.Data.Vector.Base      as V+import qualified Z.Data.Vector.Base      as V import           Z.IO.Buffered import           Z.IO.Exception import qualified Z.IO.FileSystem         as ZF@@ -144,6 +144,7 @@ -- * show everything by default -- * 'defaultFmt' defaultLoggerConfig :: LoggerConfig+{-# INLINABLE defaultLoggerConfig #-} defaultLoggerConfig = LoggerConfig 1 240 NOTSET defaultFmt  -- | A default logger config with@@ -153,6 +154,7 @@ -- * show everything by default -- * 'defaultJSONFmt' defaultJSONLoggerConfig :: LoggerConfig+{-# INLINABLE defaultJSONLoggerConfig #-} defaultJSONLoggerConfig = LoggerConfig 5 1000 NOTSET defaultJSONFmt  -- | A default timestamp cache with format @%Y-%m-%dT%H:%M:%S%Z@('iso8061DateFormat').@@ -171,6 +173,7 @@ newLogger :: LoggerConfig           -> MVar BufferedOutput           -> IO Logger+{-# INLINABLE newLogger #-} newLogger LoggerConfig{..} oLock = do     logsRef <- newIORef []     let flush = flushLogIORef oLock logsRef@@ -186,12 +189,14 @@  -- | Make a new logger write to 'stderrBuf'. newStdLogger :: LoggerConfig -> IO Logger+{-# INLINABLE newStdLogger #-} newStdLogger config = newLogger config stderrBuf  -- | Make a new file based logger with 'defaultFmt'. -- -- The file will be opened in append mode. newFileLogger :: LoggerConfig -> CB.CBytes -> IO Logger+{-# INLINABLE newFileLogger #-} newFileLogger config path = do     let res = ZF.initFile path (ZF.O_CREAT .|. ZF.O_RDWR .|. ZF.O_APPEND) ZF.DEFAULT_FILE_MODE     (file, _closeFunc) <- acquire res@@ -215,11 +220,13 @@              -> Int                 -- ^ buffer size to build each log              -> B.Builder ()        -- ^ formatted log              -> IO ()+{-# INLINABLE pushLogIORef #-} pushLogIORef logsRef loggerLineBufSize b = do     let !bs = B.buildWith loggerLineBufSize b     unless (V.null bs) $ atomicModifyIORef' logsRef (\ bss -> (bs:bss, ()))  flushLogIORef :: HasCallStack => MVar BufferedOutput -> IORef [V.Bytes] -> IO ()+{-# INLINABLE flushLogIORef #-} flushLogIORef oLock logsRef =     withMVar oLock $ \ o -> do         bss <- atomicModifyIORef' logsRef (\ bss -> ([], bss))@@ -230,6 +237,7 @@ -- -- @[FATAL][2021-02-01T15:03:30+0800][<interactive>:31:1][thread#669]...@ defaultFmt :: LogFormatter+{-# INLINABLE defaultFmt #-} defaultFmt ts level content cstack (ThreadId tid#) = do     B.square (defaultLevelFmt level)     B.square ts@@ -242,6 +250,7 @@ -- -- DEBUG level is 'Cyan', WARNING level is 'Yellow', FATAL and CRITICAL level are 'Red'. defaultColoredFmt :: LogFormatter+{-# INLINABLE defaultColoredFmt #-} defaultColoredFmt ts level content cstack (ThreadId tid#) = do     let blevel = defaultLevelFmt level     B.square (case level of@@ -260,6 +269,7 @@ -- -- > {"level":"FATAL","time":"2021-02-01T15:02:19+0800","loc":"<interactive>:27:1","theadId":606,"content":"..."}\n defaultJSONFmt :: LogFormatter+{-# INLINABLE defaultJSONFmt #-} defaultJSONFmt ts level content cstack (ThreadId tid#) = do     B.curly $ do         "level" `JB.kv` B.quotes (defaultLevelFmt level)@@ -275,6 +285,7 @@  -- | Default stack formatter which fetch the logging source and location. defaultFmtCallStack :: CallStack -> B.Builder ()+{-# INLINABLE defaultFmtCallStack #-} defaultFmtCallStack cs =  case reverse $ getCallStack cs of    [] -> "<no call stack found>"@@ -294,6 +305,7 @@  -- | Change the global logger. setDefaultLogger :: Logger -> IO ()+{-# INLINABLE setDefaultLogger #-} setDefaultLogger !logger = atomicWriteIORef globalLogger logger  -- | Get the global logger.@@ -301,16 +313,19 @@ -- This is a logger connected to stderr, if stderr is connect to TTY, -- then use 'defaultColoredFmt', otherwise use 'defaultFmt'. getDefaultLogger :: IO Logger+{-# INLINABLE getDefaultLogger #-} getDefaultLogger = readIORef globalLogger  -- | Manually flush global logger. flushDefaultLogger :: IO ()+{-# INLINABLE flushDefaultLogger #-} flushDefaultLogger = do     (Logger _ flush) <- getDefaultLogger     flush  -- | Flush global logger when program exits. withDefaultLogger :: IO () -> IO ()+{-# INLINABLE withDefaultLogger #-} withDefaultLogger = (`finally` flushDefaultLogger)  --------------------------------------------------------------------------------@@ -361,7 +376,7 @@ -- Level other than built-in ones, are formatted in decimal numeric format, i.e. -- @defaultLevelFmt 60 == "LEVEL60"@ defaultLevelFmt :: Level -> B.Builder ()-{-# INLINE defaultLevelFmt #-}+{-# INLINABLE defaultLevelFmt #-} defaultLevelFmt level = case level of     CRITICAL -> "CRITICAL"     FATAL    -> "FATAL"@@ -372,23 +387,23 @@     level'   -> "LEVEL" >> B.int level'  debug :: HasCallStack => B.Builder () -> IO ()-{-# INLINE debug #-}+{-# INLINABLE debug #-} debug = otherLevel_ DEBUG False callStack  info :: HasCallStack => B.Builder () -> IO ()-{-# INLINE info #-}+{-# INLINABLE info #-} info = otherLevel_ INFO False callStack  warning :: HasCallStack => B.Builder () -> IO ()-{-# INLINE warning #-}+{-# INLINABLE warning #-} warning = otherLevel_ WARNING False callStack  fatal :: HasCallStack => B.Builder () -> IO ()-{-# INLINE fatal #-}+{-# INLINABLE fatal #-} fatal = otherLevel_ FATAL True callStack  critical :: HasCallStack => B.Builder () -> IO ()-{-# INLINE critical #-}+{-# INLINABLE critical #-} critical = otherLevel_ CRITICAL True callStack  otherLevel :: HasCallStack@@ -396,11 +411,11 @@            -> Bool              -- ^ flush immediately?            -> B.Builder ()      -- ^ log content            -> IO ()-{-# INLINE otherLevel #-}+{-# INLINABLE otherLevel #-} otherLevel level flushNow bu = otherLevel_ level flushNow callStack bu  otherLevel_ :: Level -> Bool -> CallStack -> B.Builder () -> IO ()-{-# INLINE otherLevel_ #-}+{-# INLINABLE otherLevel_ #-} otherLevel_ level flushNow cstack bu = do     (Logger f _) <- getDefaultLogger     f level flushNow cstack bu@@ -408,19 +423,19 @@ --------------------------------------------------------------------------------  debugTo :: HasCallStack => Logger -> B.Builder () -> IO ()-{-# INLINE debugTo #-}+{-# INLINABLE debugTo #-} debugTo = otherLevelTo_ DEBUG False callStack  infoTo :: HasCallStack => Logger -> B.Builder () -> IO ()-{-# INLINE infoTo #-}+{-# INLINABLE infoTo #-} infoTo = otherLevelTo_ INFO False callStack  warningTo :: HasCallStack => Logger -> B.Builder () -> IO ()-{-# INLINE warningTo #-}+{-# INLINABLE warningTo #-} warningTo = otherLevelTo_ WARNING False callStack  fatalTo :: HasCallStack => Logger -> B.Builder () -> IO ()-{-# INLINE fatalTo #-}+{-# INLINABLE fatalTo #-} fatalTo = otherLevelTo_ FATAL True callStack  otherLevelTo :: HasCallStack@@ -429,11 +444,11 @@              -> Bool              -- ^ flush immediately?              -> B.Builder ()      -- ^ log content              -> IO ()-{-# INLINE otherLevelTo #-}+{-# INLINABLE otherLevelTo #-} otherLevelTo logger level flushNow = otherLevelTo_ level flushNow callStack logger  otherLevelTo_ :: Level -> Bool -> CallStack -> Logger -> B.Builder () -> IO ()-{-# INLINE otherLevelTo_ #-}+{-# INLINABLE otherLevelTo_ #-} otherLevelTo_ level flushNow cs (Logger f _) = f level flushNow cs  foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt

@@ -49,12 +49,13 @@ import           Data.IORef import           GHC.Conc import           System.IO.Unsafe-import           Z.Data.PrimRef.PrimIORef+import           Z.Data.PrimRef import           Z.IO.Exception import           Z.IO.UV.FFI_Env    (uv_hrtime)  -- queueSize :: Int+{-# INLINABLE queueSize #-} queueSize = 128  -- | A simple timing wheel@@ -72,6 +73,7 @@     -- running lock  newLowResTimerManager :: IO LowResTimerManager+{-# INLINABLE newLowResTimerManager #-} newLowResTimerManager = do     indexLock <- newMVar 0     regCounter <- newCounter 0@@ -100,6 +102,7 @@ -- This is not a must though, when we fetch timer manager we always take a modulo. -- lowResTimerManagerCapabilitiesChanged :: IO ()+{-# INLINABLE lowResTimerManagerCapabilitiesChanged #-} lowResTimerManagerCapabilitiesChanged = do     lrtmArray <- readIORef lowResTimerManager     let oldSize = sizeofArr lrtmArray@@ -193,7 +196,7 @@ -- queryLowResTimer :: LowResTimer -> IO Int {-# INLINABLE queryLowResTimer #-}-queryLowResTimer (LowResTimer c) = readPrimIORef c+queryLowResTimer (LowResTimer c) = readPrimRef c  -- | Cancel a timer, return the remaining ticks. --@@ -280,9 +283,10 @@ -- | Start low resolution timer loop, the loop is automatically stopped if there's no more new registrations. -- startLowResTimerManager :: LowResTimerManager -> Word64 -> IO ()+{-# INLINABLE startLowResTimerManager #-} startLowResTimerManager lrtm@(LowResTimerManager _ _ regCounter runningLock) !stdT = do     modifyMVar_ runningLock $ \ _ -> do     -- we shouldn't receive async exception here-        c <- readPrimIORef regCounter          -- unless something terribly wrong happened, e.g., stackoverflow+        c <- readPrimRef regCounter          -- unless something terribly wrong happened, e.g., stackoverflow         if c > 0         then do             t <- uv_hrtime@@ -311,6 +315,7 @@ -- | Scan the timeout queue in current tick index, and move tick index forward by one. -- fireLowResTimerQueue :: LowResTimerManager -> IO ()+{-# INLINABLE fireLowResTimerQueue #-} fireLowResTimerQueue (LowResTimerManager queue indexLock regCounter _) = do     (tList, tListRef) <- modifyMVar indexLock $ \ index -> do                 -- get the index lock         tListRef <- indexArrM queue index

@@ -118,6 +118,7 @@  -- | Indicate whether the given 'AddrInfoFlag' will have any effect on this system. addrInfoFlagImplemented :: AddrInfoFlag -> Bool+{-# INLINABLE addrInfoFlagImplemented #-} addrInfoFlagImplemented f = packBits addrInfoFlagMapping [f] /= 0  -- | Address info@@ -133,9 +134,12 @@   instance Storable AddrInfo where+    {-# INLINABLE sizeOf #-}     sizeOf    _ = #const sizeof(struct addrinfo)+    {-# INLINABLE alignment #-}     alignment _ = alignment (0 :: CInt) +    {-# INLINABLE peek #-}     peek p = do         ai_flags <- (#peek struct addrinfo, ai_flags) p         ai_family <- (#peek struct addrinfo, ai_family) p@@ -154,6 +158,7 @@           , addrCanonName = ai_canonname           } +    {-# INLINABLE poke #-}     poke p (AddrInfo flags family sockType protocol _ _) = do         (#poke struct addrinfo, ai_flags) p (packBits addrInfoFlagMapping flags)         (#poke struct addrinfo, ai_family) p family@@ -190,7 +195,7 @@     deriving (Eq, Read, Show)  nameInfoFlagMapping :: [(NameInfoFlag, CInt)]-+{-# INLINABLE nameInfoFlagMapping #-} nameInfoFlagMapping = [(NI_DGRAM, #const NI_DGRAM),                  (NI_NAMEREQD, #const NI_NAMEREQD),                  (NI_NOFQDN, #const NI_NOFQDN),@@ -209,6 +214,7 @@ -- 0  defaultHints :: AddrInfo+{-# INLINABLE defaultHints #-} defaultHints = AddrInfo {     addrFlags      = []   , addrFamily     = AF_UNSPEC@@ -263,6 +269,7 @@     -> HostName -- ^ host name to look up     -> ServiceName -- ^ service name to look up     -> IO [AddrInfo] -- ^ resolved addresses, with "best" first+{-# INLINABLE getAddrInfo #-} getAddrInfo hints host service = withUVInitDo $     bracket         (do withCBytes host $ \ ptr_h ->@@ -286,6 +293,7 @@ -- | Peek @addrinfo@ linked list. -- followAddrInfo :: Ptr AddrInfo -> IO [AddrInfo]+{-# INLINABLE followAddrInfo #-} followAddrInfo ptr_ai     | ptr_ai == nullPtr = return []     | otherwise = do@@ -318,6 +326,7 @@     -> Bool -- ^ whether to look up a service name     -> SocketAddr -- ^ the address to look up     -> IO (HostName, ServiceName)+{-# INLINABLE getNameInfo #-} getNameInfo flags doHost doService addr = withUVInitDo $ do     (host, (service, _)) <- allocCBytes (fromIntegral h_len) $ \ ptr_h ->         allocCBytes (fromIntegral s_len) $ \ ptr_s ->@@ -338,7 +347,7 @@ -- break if this property is not true. -- packBits :: (Eq a, Num b, Bits b) => [(a, b)] -> [a] -> b-{-# INLINE packBits #-}+{-# INLINABLE packBits #-} packBits mapping xs = List.foldl' go 0 mapping   where     go acc (k, v) | k `elem` xs = acc .|. v@@ -346,7 +355,7 @@  -- | Unpack a bitmask into a list of values. unpackBits :: (Num b, Bits b) => [(a, b)] -> b -> [a]-{-# INLINE unpackBits #-}+{-# INLINABLE unpackBits #-} -- Be permissive and ignore unknown bit values. At least on OS X, -- getaddrinfo returns an ai_flags field with bits set that have no -- entry in <netdb.h>.

@@ -59,11 +59,13 @@ -- | Default config, connect to ".\/ipc". -- defaultIPCClientConfig :: IPCClientConfig+{-# INLINABLE defaultIPCClientConfig #-} defaultIPCClientConfig = IPCClientConfig Nothing "./ipc"  -- | init a IPC client 'Resource', which open a new connect when used. -- initIPCClient :: IPCClientConfig -> Resource UVStream+{-# INLINABLE initIPCClient #-} initIPCClient (IPCClientConfig cname tname) = do     uvm <- liftIO getUVManager     client <- initIPCStream uvm@@ -92,6 +94,7 @@ -- Test it with @main = startIPCServer defaultIPCServerConfig@ -- defaultIPCServerConfig :: IPCServerConfig+{-# INLINABLE defaultIPCServerConfig #-} defaultIPCServerConfig = IPCServerConfig     "./ipc"     256@@ -106,6 +109,7 @@                                         -- run in a seperated haskell thread,                                        --  will be closed upon exception or worker finishes.                -> IO ()+{-# INLINABLE startIPCServer #-} startIPCServer IPCServerConfig{..} = startServerLoop     (max ipcListenBacklog 128)     initIPCStream@@ -122,5 +126,6 @@ --------------------------------------------------------------------------------  initIPCStream :: HasCallStack => UVManager -> Resource UVStream+{-# INLINABLE initIPCStream #-} initIPCStream = initUVStream (\ loop hdl ->     throwUVIfMinus_ (uv_pipe_init loop hdl 0))

@@ -205,6 +205,7 @@         T.toUTF8Builder port  sockAddrFamily :: SocketAddr -> SocketFamily+{-# INLINABLE sockAddrFamily #-} sockAddrFamily (SocketAddrIPv4 _ _) = AF_INET sockAddrFamily (SocketAddrIPv6 _ _ _ _) = AF_INET6 @@ -215,6 +216,7 @@ -- -- This is partial function, wrong address will throw 'InvalidArgument' exception. ipv4:: HasCallStack => CBytes -> PortNumber -> SocketAddr+{-# INLINABLE ipv4 #-} ipv4 str (PortNumber port) = unsafeDupablePerformIO . withSocketAddrStorageUnsafe $ \ p ->     withCBytesUnsafe str $ \ cstr -> throwUVIfMinus_ $ uv_ip4_addr cstr (fromIntegral port) p @@ -222,6 +224,7 @@ -- -- This is partial function, wrong address will throw 'InvalidArgument' exception. ipv6:: HasCallStack => CBytes -> PortNumber -> SocketAddr+{-# INLINABLE ipv6 #-} ipv6 str (PortNumber port) = unsafeDupablePerformIO . withSocketAddrStorageUnsafe $ \ p ->     withCBytesUnsafe str $ \ cstr -> throwUVIfMinus_ $ uv_ip6_addr cstr (fromIntegral port) p @@ -257,54 +260,71 @@  -- | @0.0.0.0@ ipv4Any             :: IPv4+{-# INLINABLE ipv4Any #-} ipv4Any              = IPv4 0  -- | @255.255.255.255@ ipv4Broadcast       :: IPv4+{-# INLINABLE ipv4Broadcast #-} ipv4Broadcast        = tupleToIPv4Addr (255,255,255,255)  -- | @255.255.255.255@ ipv4None            :: IPv4+{-# INLINABLE ipv4None #-} ipv4None             = tupleToIPv4Addr (255,255,255,255)  -- | @127.0.0.1@ ipv4Loopback        :: IPv4+{-# INLINABLE ipv4Loopback #-} ipv4Loopback         = tupleToIPv4Addr (127,  0,  0,  1)  -- | @224.0.0.0@ ipv4UnspecificGroup :: IPv4+{-# INLINABLE ipv4UnspecificGroup #-} ipv4UnspecificGroup  = tupleToIPv4Addr (224,  0,  0,  0)  -- | @224.0.0.1@ ipv4AllHostsGroup   :: IPv4+{-# INLINABLE ipv4AllHostsGroup #-} ipv4AllHostsGroup    = tupleToIPv4Addr (224,  0,  0,  1)  -- | @224.0.0.255@ ipv4MaxLocalGroup   :: IPv4+{-# INLINABLE ipv4MaxLocalGroup #-} ipv4MaxLocalGroup    = tupleToIPv4Addr (224,  0,  0,255)  instance Storable IPv4 where+    {-# INLINABLE sizeOf #-}     sizeOf _ = 4+    {-# INLINABLE alignment #-}     alignment _ = alignment (undefined :: Word32)+    {-# INLINABLE peek #-}     peek p = (IPv4 . ntohl) `fmap` peekByteOff p 0+    {-# INLINABLE poke #-}     poke p (IPv4 ia) = pokeByteOff p 0 (htonl ia)  instance Unaligned IPv4 where+    {-# INLINABLE unalignedSize #-}     unalignedSize = 4+    {-# INLINABLE pokeMBA #-}     pokeMBA p off x = pokeMBA p off (htonl (getIPv4Addr x))+    {-# INLINABLE peekMBA #-}     peekMBA p off = IPv4 . ntohl <$> peekMBA p off+    {-# INLINABLE indexBA #-}     indexBA p off = IPv4 (ntohl (indexBA p off))  -- | 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. ipv4AddrToTuple :: IPv4 -> (Word8, Word8, Word8, Word8)+{-# INLINE ipv4AddrToTuple #-} ipv4AddrToTuple (IPv4 ia) =     let byte i = fromIntegral (ia `shiftR` i) :: Word8     in (byte 24, byte 16, byte 8, byte 0)  -- | Converts IPv4 quadruple to 'IPv4'. tupleToIPv4Addr :: (Word8, Word8, Word8, Word8) -> IPv4+{-# INLINE tupleToIPv4Addr #-} tupleToIPv4Addr (b3, b2, b1, b0) =     let x `sl` i = fromIntegral x `shiftL` i :: Word32     in IPv4 $ (b3 `sl` 24) .|. (b2 `sl` 16) .|. (b1 `sl` 8) .|. (b0 `sl` 0)@@ -336,6 +356,7 @@  instance Show IPv6 where show = T.toString instance Print IPv6 where+    {-# INLINABLE toUTF8BuilderP #-}     toUTF8BuilderP _ ia6@(IPv6 a1 a2 a3 a4)         -- IPv4-Mapped IPv6 Address         | a1 == 0 && a2 == 0 && a3 == 0xffff =@@ -361,15 +382,18 @@  -- | @::@ ipv6Any      :: IPv6+{-# INLINABLE ipv6Any #-} ipv6Any       = IPv6 0 0 0 0  -- | @::1@ ipv6Loopback :: IPv6+{-# INLINABLE ipv6Loopback #-} ipv6Loopback  = IPv6 0 0 0 1  -- | convert 'IPv6' to octets. ipv6AddrToTuple :: IPv6 -> (Word16, Word16, Word16, Word16,                                         Word16, Word16, Word16, Word16)+{-# INLINABLE ipv6AddrToTuple #-} ipv6AddrToTuple (IPv6 w3 w2 w1 w0) =     let high, low :: Word32 -> Word16         high w = fromIntegral (w `shiftR` 16)@@ -379,20 +403,25 @@ -- | convert 'IPv6' from octets. tupleToIPv6Addr :: (Word16, Word16, Word16, Word16,                         Word16, Word16, Word16, Word16) -> IPv6+{-# INLINABLE tupleToIPv6Addr #-} tupleToIPv6Addr (w7, w6, w5, w4, w3, w2, w1, w0) =     let add :: Word16 -> Word16 -> Word32         high `add` low = (fromIntegral high `shiftL` 16) .|. (fromIntegral low)     in  IPv6 (w7 `add` w6) (w5 `add` w4) (w3 `add` w2) (w1 `add` w0)  instance Storable IPv6 where+    {-# INLINABLE sizeOf #-}     sizeOf _    = #size struct in6_addr+    {-# INLINABLE alignment #-}     alignment _ = #alignment struct in6_addr+    {-# INLINABLE peek #-}     peek p = do         a <- peek32 p 0         b <- peek32 p 1         c <- peek32 p 2         d <- peek32 p 3         return $ IPv6 a b c d+    {-# INLINABLE poke #-}     poke p (IPv6 a b c d) = do         poke32 p 0 a         poke32 p 1 b@@ -401,9 +430,11 @@   s6_addr_offset :: Int+{-# INLINABLE s6_addr_offset #-} s6_addr_offset = (#offset struct in6_addr, s6_addr)  peek32 :: Ptr a -> Int -> IO Word32+{-# INLINABLE peek32 #-} peek32 p i0 = do     let i' = i0 * 4         peekByte n = peekByteOff p (s6_addr_offset + i' + n) :: IO Word8@@ -415,6 +446,7 @@     return ((a0 `sl` 24) .|. (a1 `sl` 16) .|. (a2 `sl` 8) .|. (a3 `sl` 0))  poke32 :: Ptr a -> Int -> Word32 -> IO ()+{-# INLINABLE poke32 #-} poke32 p i0 a = do     let i' = i0 * 4         pokeByte n = pokeByteOff p (s6_addr_offset + i' + n)@@ -425,22 +457,23 @@     pokeByte 3 (a `sr`  0)  instance Unaligned IPv6 where+    {-# INLINABLE unalignedSize #-}     unalignedSize = (#size struct in6_addr)-+    {-# INLINABLE indexBA #-}     indexBA p off =         let a = indexBA p (off + s6_addr_offset + 0)             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 IPv6 (getBE a) (getBE b) (getBE c) (getBE d)-+    {-# INLINABLE peekMBA #-}     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 $ IPv6 (getBE a) (getBE b) (getBE c) (getBE d)-+    {-# INLINABLE pokeMBA #-}     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)@@ -450,6 +483,7 @@ --------------------------------------------------------------------------------  peekSocketAddr :: HasCallStack => Ptr SocketAddr -> IO SocketAddr+{-# INLINABLE peekSocketAddr #-} peekSocketAddr p = do     family <- (#peek struct sockaddr, sa_family) p     case family :: CSaFamily of@@ -469,6 +503,7 @@                 throwUVError errno (IOEInfo name desc callStack)  pokeSocketAddr :: Ptr SocketAddr -> SocketAddr -> IO ()+{-# INLINABLE pokeSocketAddr #-} pokeSocketAddr p (SocketAddrIPv4 addr port) =  do #if defined(darwin_HOST_OS)     clearPtr p (#size struct sockaddr_in)@@ -496,6 +531,7 @@ -- | Pass 'SocketAddr' to FFI as pointer. -- withSocketAddr :: SocketAddr -> (Ptr SocketAddr -> IO a) -> IO a+{-# INLINABLE withSocketAddr #-} withSocketAddr sa@(SocketAddrIPv4 _ _) f = do     allocaBytesAligned         (#size struct sockaddr_in)@@ -510,6 +546,7 @@ -- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY. -- withSocketAddrUnsafe :: SocketAddr -> (MBA## SocketAddr -> IO a) -> IO a+{-# INLINABLE withSocketAddrUnsafe #-} withSocketAddrUnsafe sa@(SocketAddrIPv4 _ _) f = do     (MutableByteArray p) <- newByteArray (#size struct sockaddr_in)     pokeSocketAddrMBA p sa@@ -520,11 +557,13 @@     f p  sizeOfSocketAddr :: SocketAddr -> CSize+{-# INLINABLE sizeOfSocketAddr #-} 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+{-# INLINABLE withSocketAddrStorage #-} withSocketAddrStorage f = do     allocaBytesAligned         (#size struct sockaddr_storage)@@ -535,15 +574,18 @@ -- USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY. -- withSocketAddrStorageUnsafe :: (MBA## SocketAddr -> IO ()) -> IO SocketAddr+{-# INLINABLE withSocketAddrStorageUnsafe #-} withSocketAddrStorageUnsafe f = do     (MutableByteArray p) <- newByteArray (#size struct sockaddr_storage)     f p     peekSocketAddrMBA p  sizeOfSocketAddrStorage :: CSize+{-# INLINABLE sizeOfSocketAddrStorage #-} sizeOfSocketAddrStorage = (#size struct sockaddr_storage)  peekSocketAddrMBA :: HasCallStack => MBA## SocketAddr -> IO SocketAddr+{-# INLINABLE peekSocketAddrMBA #-} peekSocketAddrMBA p = do     family <- peekMBA p (#offset struct sockaddr, sa_family)     case family :: CSaFamily of@@ -563,6 +605,7 @@                 throwUVError errno (IOEInfo name desc callStack)  pokeSocketAddrMBA :: MBA## SocketAddr -> SocketAddr -> IO ()+{-# INLINABLE pokeSocketAddrMBA #-} pokeSocketAddrMBA p (SocketAddrIPv4 addr port) =  do #if defined(darwin_HOST_OS)     clearMBA p (#size struct sockaddr_in)@@ -602,6 +645,7 @@ instance Show Interface where show = T.toString  peekInterface :: HasCallStack => Ptr Interface -> IO Interface+{-# INLINABLE peekInterface #-} peekInterface p = do     name' <- fromCString =<< (#peek struct uv_interface_address_s, name) p     phy <- fromPtr (p `plusPtr` (#offset struct uv_interface_address_s, phys_addr)) 6@@ -649,6 +693,7 @@  -- | Gets address information about the network interfaces on the system.  getInterface :: IO [Interface]+{-# INLINABLE getInterface #-} getInterface = bracket     (allocPrimUnsafe @(Ptr Interface) $ \ ppiface ->         fst <$> allocPrimUnsafe @CInt (uv_interface_addresses ppiface))@@ -681,37 +726,52 @@  -- | @:0@ portAny :: PortNumber+{-# INLINABLE portAny #-} portAny = PortNumber 0  defaultPortNumberHTTP :: PortNumber+{-# INLINABLE defaultPortNumberHTTP #-} defaultPortNumberHTTP = 80  defaultPortNumberHTTPS :: PortNumber+{-# INLINABLE defaultPortNumberHTTPS #-} defaultPortNumberHTTPS = 443  defaultPortNumberSMTP :: PortNumber+{-# INLINABLE defaultPortNumberSMTP #-} defaultPortNumberSMTP = 25  defaultPortNumberPOP3 :: PortNumber+{-# INLINABLE defaultPortNumberPOP3 #-} defaultPortNumberPOP3 = 110  defaultPortNumberIMAP :: PortNumber+{-# INLINABLE defaultPortNumberIMAP #-} defaultPortNumberIMAP = 143  defaultPortNumberIRC :: PortNumber+{-# INLINABLE defaultPortNumberIRC #-} defaultPortNumberIRC = 194  instance Storable PortNumber where-   sizeOf    _ = sizeOf    (0 :: Word16)-   alignment _ = alignment (0 :: Word16)-   poke p (PortNumber po) = poke (castPtr p) (htons po)-   peek p = PortNumber . ntohs <$> peek (castPtr p)+    {-# INLINABLE sizeOf #-}+    sizeOf    _ = sizeOf    (0 :: Word16)+    {-# INLINABLE alignment #-}+    alignment _ = alignment (0 :: Word16)+    {-# INLINABLE poke #-}+    poke p (PortNumber po) = poke (castPtr p) (htons po)+    {-# INLINABLE peek #-}+    peek p = PortNumber . ntohs <$> peek (castPtr p)  instance Unaligned PortNumber where-   unalignedSize = 2-   indexBA p off = PortNumber . ntohs $ indexBA p off-   pokeMBA p off (PortNumber po) = pokeMBA p off (htons po)-   peekMBA p off = PortNumber . ntohs <$> peekMBA p off+    {-# INLINABLE unalignedSize #-}+    unalignedSize = 2+    {-# INLINABLE indexBA #-}+    indexBA p off = PortNumber . ntohs $ indexBA p off+    {-# INLINABLE pokeMBA #-}+    pokeMBA p off (PortNumber po) = pokeMBA p off (htons po)+    {-# INLINABLE peekMBA #-}+    peekMBA p off = PortNumber . ntohs <$> peekMBA p off  -------------------------------------------------------------------------------- 

@@ -64,11 +64,13 @@ -- | Default config, connect to @localhost:8888@. -- defaultTCPClientConfig :: TCPClientConfig+{-# INLINABLE defaultTCPClientConfig #-} defaultTCPClientConfig = TCPClientConfig Nothing (SocketAddrIPv4 ipv4Loopback 8888) True 30  -- | init a TCP client 'Resource', which open a new connect when used. -- initTCPClient :: HasCallStack => TCPClientConfig -> Resource UVStream+{-# INLINABLE initTCPClient #-} initTCPClient TCPClientConfig{..} = do     uvm <- liftIO getUVManager     client <- initTCPStream uvm@@ -104,6 +106,7 @@ -- @main = startTCPServer defaultTCPServerConfig echoWorker@, now try @nc -v 127.0.0.1 8888@ -- defaultTCPServerConfig :: TCPServerConfig+{-# INLINABLE defaultTCPServerConfig #-} defaultTCPServerConfig = TCPServerConfig     (SocketAddrIPv4 ipv4Any 8888)     256@@ -120,6 +123,7 @@                                         -- run in a seperated haskell thread,                                         -- will be closed upon exception or worker finishes.                -> IO ()+{-# INLINABLE startTCPServer #-} startTCPServer TCPServerConfig{..} = startServerLoop     (max tcpListenBacklog 128)     initTCPStream@@ -224,10 +228,12 @@ --------------------------------------------------------------------------------  initTCPStream :: UVManager -> Resource UVStream+{-# INLINABLE initTCPStream #-} initTCPStream = initUVStream (\ loop hdl -> throwUVIfMinus_ (uv_tcp_init loop hdl))  -- | Enable or disable @TCP_NODELAY@, which enable or disable Nagle’s algorithm. setTCPNoDelay :: HasCallStack => UVStream -> Bool -> IO ()+{-# INLINABLE setTCPNoDelay #-} setTCPNoDelay uvs nodelay =     throwUVIfMinus_ (uv_tcp_nodelay (uvsHandle uvs) (if nodelay then 1 else 0)) @@ -237,12 +243,14 @@ -- will still happen. If the connection is still lost at the end of this procedure, -- then the connection is closed, pending io thread will throw 'TimeExpired' exception. setTCPKeepAlive :: HasCallStack => UVStream -> CUInt -> IO ()+{-# INLINABLE setTCPKeepAlive #-} setTCPKeepAlive uvs delay     | delay > 0 = throwUVIfMinus_ (uv_tcp_keepalive (uvsHandle uvs) 1 delay)     | otherwise = throwUVIfMinus_ (uv_tcp_keepalive (uvsHandle uvs) 0 0)  -- | Get the current address to which the handle is bound. getTCPSockName :: HasCallStack => UVStream -> IO SocketAddr+{-# INLINABLE getTCPSockName #-} getTCPSockName uvs = do     withSocketAddrStorageUnsafe $ \ paddr ->         void $ withPrimUnsafe (fromIntegral sizeOfSocketAddrStorage :: CInt) $ \ plen ->@@ -250,6 +258,7 @@  -- | Get the address of the peer connected to the handle. getTCPPeerName :: HasCallStack => UVStream -> IO SocketAddr+{-# INLINABLE getTCPPeerName #-} getTCPPeerName uvs = do     withSocketAddrStorageUnsafe $ \ paddr ->         void $ withPrimUnsafe (fromIntegral sizeOfSocketAddrStorage :: CInt) $ \ plen ->

@@ -59,7 +59,7 @@  import Control.Concurrent import Control.Monad-import Data.Primitive.PrimArray         as A+import qualified Data.Primitive.PrimArray       as A import Data.IORef import Data.Word import Data.Int@@ -68,12 +68,11 @@ import Foreign.Ptr (plusPtr) import Foreign.C 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.Print      as T-import Z.Data.JSON                      (JSON)+import Z.Data.CBytes+import qualified Z.Data.Vector.Base             as V+import qualified Z.Data.Vector.Extra            as V+import qualified Z.Data.Text.Print              as T+import Z.Data.JSON                              (JSON) import Z.IO.Network.SocketAddr import Z.Foreign import Z.IO.UV.FFI@@ -97,6 +96,7 @@  instance Show UDP where show = T.toString instance T.Print UDP where+    {-# INLINABLE toUTF8BuilderP #-}     toUTF8BuilderP _ (UDP hdl slot uvm _ _) = do         "UDP{udpHandle="    >> T.toUTF8Builder hdl         ",udpSlot="         >> T.toUTF8Builder slot@@ -117,11 +117,13 @@  -- | @UDPConfig 512 Nothing@ defaultUDPConfig :: UDPConfig+{-# INLINABLE defaultUDPConfig #-} defaultUDPConfig = UDPConfig 512 Nothing  -- | Initialize a UDP socket. -- initUDP :: UDPConfig -> Resource UDP+{-# INLINABLE initUDP #-} initUDP (UDPConfig sbsiz maddr) = initResource     (do uvm <- getUVManager         (hdl, slot) <- withUVManager uvm $ \ loop -> do@@ -146,12 +148,14 @@         unless c $ writeIORef closed True >> hs_uv_handle_close hdl)  checkUDPClosed :: HasCallStack => UDP -> IO ()+{-# INLINABLE checkUDPClosed #-} checkUDPClosed udp = do     c <- readIORef (udpClosed udp)     when c throwECLOSED  -- | Get the local IP and port of the 'UDP'. getSockName :: HasCallStack => UDP -> IO SocketAddr+{-# INLINABLE getSockName #-} getSockName udp@(UDP hdl _ _ _ _) = do     checkUDPClosed udp     withSocketAddrStorageUnsafe $ \ paddr ->@@ -172,6 +176,7 @@ -- | Associate the UDP handle to a remote address and port, -- so every message sent by this handle is automatically sent to that destination connectUDP :: HasCallStack => UDP -> SocketAddr -> IO ConnectedUDP+{-# INLINABLE connectUDP #-} connectUDP udp@(UDP hdl _ _ _ _) addr = do     checkUDPClosed udp     withSocketAddrUnsafe addr $ \ paddr ->@@ -180,6 +185,7 @@  -- | Disconnect the UDP handle from a remote address and port. disconnectUDP :: HasCallStack => ConnectedUDP -> IO UDP+{-# INLINABLE disconnectUDP #-} disconnectUDP (ConnectedUDP udp@(UDP hdl _ _ _ _)) = do     checkUDPClosed udp     throwUVIfMinus_ (uv_udp_disconnect hdl nullPtr)@@ -187,6 +193,7 @@  -- | Get the remote IP and port on 'ConnectedUDP'. getPeerName :: HasCallStack => ConnectedUDP -> IO SocketAddr+{-# INLINABLE getPeerName #-} getPeerName (ConnectedUDP udp@(UDP hdl _ _ _ _)) = do     checkUDPClosed udp     withSocketAddrStorageUnsafe $ \ paddr ->@@ -198,6 +205,7 @@ -- WARNING: A 'InvalidArgument' with errno 'UV_EMSGSIZE' will be thrown -- if message is larger than 'sendMsgSize'. sendConnectedUDP :: HasCallStack => ConnectedUDP -> V.Bytes -> IO ()+{-# INLINABLE sendConnectedUDP #-} sendConnectedUDP (ConnectedUDP udp@(UDP hdl _ uvm sbuf _)) (V.PrimVector ba s la) = mask_ $ do     checkUDPClosed udp     -- copy message to pinned buffer@@ -224,6 +232,7 @@ -- WARNING: A 'InvalidArgument' with errno 'UV_EMSGSIZE' will be thrown -- if message is larger than 'sendMsgSize'. sendUDP :: HasCallStack => UDP -> SocketAddr -> V.Bytes -> IO ()+{-# INLINABLE sendUDP #-} sendUDP udp@(UDP hdl _ uvm sbuf _) addr (V.PrimVector ba s la) = mask_ $ do     checkUDPClosed udp     -- copy message to pinned buffer@@ -248,12 +257,14 @@  -- | Set IP multicast loop flag. Makes multicast packets loop back to local sockets. setMulticastLoop :: HasCallStack => UDP -> Bool -> IO ()+{-# INLINABLE setMulticastLoop #-} setMulticastLoop udp@(UDP hdl _ _ _ _) loop = do     checkUDPClosed udp     throwUVIfMinus_ (uv_udp_set_multicast_loop hdl (if loop then 1 else 0))  -- | Set the multicast ttl. setMulticastTTL :: HasCallStack => UDP -> Int -> IO ()+{-# INLINABLE setMulticastTTL #-} setMulticastTTL udp@(UDP hdl _ _ _ _) ttl = do     checkUDPClosed udp     throwUVIfMinus_ (uv_udp_set_multicast_ttl hdl (fromIntegral ttl'))@@ -261,6 +272,7 @@  -- | Set the multicast interface to send or receive data on. setMulticastInterface :: HasCallStack => UDP -> CBytes ->IO ()+{-# INLINABLE setMulticastInterface #-} setMulticastInterface udp@(UDP hdl _ _ _ _) iaddr = do     checkUDPClosed udp     withCBytesUnsafe iaddr $ \ iaddrp ->@@ -268,6 +280,7 @@  -- | Set broadcast on or off. setBroadcast :: HasCallStack => UDP -> Bool -> IO ()+{-# INLINABLE setBroadcast #-} setBroadcast udp@(UDP hdl _ _ _ _) b = do     checkUDPClosed udp     throwUVIfMinus_ (uv_udp_set_broadcast hdl (if b then 1 else 0))@@ -277,6 +290,7 @@        => UDP        -> Int       -- ^ 1 ~ 255        -> IO ()+{-# INLINABLE setTTL #-} setTTL udp@(UDP hdl _ _ _ _) ttl = do     checkUDPClosed udp     throwUVIfMinus_ (uv_udp_set_ttl hdl (fromIntegral ttl))@@ -288,6 +302,7 @@               -> CBytes             -- ^ Interface address.               -> Membership       -- ^ UV_JOIN_GROUP | UV_LEAVE_GROUP               -> IO ()+{-# INLINABLE setMembership #-} setMembership udp@(UDP hdl _ _ _ _) gaddr iaddr member = do     checkUDPClosed udp     withCBytesUnsafe gaddr $ \ gaddrp ->@@ -302,6 +317,7 @@                     -> CBytes           -- ^ Source address.                     -> Membership     -- ^ UV_JOIN_GROUP | UV_LEAVE_GROUP                     -> IO ()+{-# INLINABLE setSourceMembership #-} setSourceMembership udp@(UDP hdl _ _ _ _) gaddr iaddr source member = do     checkUDPClosed udp     withCBytesUnsafe gaddr $ \ gaddrp ->@@ -324,6 +340,7 @@  -- | @UDPRecvConfig 512 6@ defaultUDPRecvConfig :: UDPRecvConfig+{-# INLINABLE defaultUDPRecvConfig #-} defaultUDPRecvConfig = UDPRecvConfig 512 6  @@ -355,6 +372,7 @@ -- Then we poke those cells out. -- newRecvBuf :: Int32 -> Int -> IO (A.MutablePrimArray RealWorld Word8, A.MutablePrimArray RealWorld (Ptr Word8))+{-# INLINABLE newRecvBuf #-} newRecvBuf bufSiz bufArrSiz = do     rbuf <- A.newPinnedPrimArray (fromIntegral bufsiz' * bufArrSiz')     rbufArr <- A.newPinnedPrimArray bufArrSiz'@@ -383,6 +401,7 @@             -> UDP             -> ((Maybe SocketAddr, Bool, V.Bytes) -> IO a)             -> IO ()+{-# INLINABLE recvUDPLoop #-} recvUDPLoop (UDPRecvConfig bufSiz bufArrSiz) udp@(UDP hdl slot uvm _ _) worker = do     bracket         (do check <- throwOOMIfNull $ hs_uv_check_alloc@@ -404,6 +423,7 @@ -- to indicate if the message is partial (larger than receive buffer size). -- recvUDP :: HasCallStack => UDPRecvConfig -> UDP -> IO [(Maybe SocketAddr, Bool, V.Bytes)]+{-# INLINABLE recvUDP #-} recvUDP (UDPRecvConfig bufSiz bufArrSiz) udp@(UDP hdl slot uvm _ _)  = do     bracket         (do check <- throwOOMIfNull $ hs_uv_check_alloc@@ -423,6 +443,7 @@             -> (A.MutablePrimArray RealWorld Word8, A.MutablePrimArray RealWorld (Ptr Word8))             -> Int32             -> IO [(Maybe SocketAddr, Bool, V.Bytes)]+{-# INLINABLE recvUDPWith #-} recvUDPWith udp@(UDP hdl slot uvm _ _) (rubf, rbufArr) bufSiz =     -- It's important to keep recv buffer alive, even if we don't directly use it     mask_ . withMutablePrimArrayContents rubf $ \ _ -> do

@@ -70,7 +70,7 @@ import Z.Data.CBytes import Z.Data.CBytes                    as CBytes import Z.Data.JSON                      (JSON)-import Z.Data.Vector                    as V+import qualified Z.Data.Vector          as V import qualified Z.Data.Text            as T import qualified Data.List              as List import Z.Data.Array.Unaligned@@ -88,6 +88,7 @@  -- | Default process options, start @".\/main"@ with no arguments, redirect all std streams to @\/dev\/null@. defaultProcessOptions :: ProcessOptions+{-# INLINABLE defaultProcessOptions #-} defaultProcessOptions = ProcessOptions     { processFile = "./main"     , processArgs = []@@ -106,6 +107,7 @@  -- | Wait until process exit and return the 'ExitCode'. waitProcessExit :: TVar ProcessState -> IO ExitCode+{-# INLINABLE waitProcessExit #-} waitProcessExit svar = atomically $ do     s <- readTVar svar     case s of ProcessExited e -> return e@@ -113,6 +115,7 @@  -- | Get process 'PID' if process is running. getProcessPID :: TVar ProcessState -> IO (Maybe PID)+{-# INLINABLE getProcessPID #-} getProcessPID svar = atomically $ do     s <- readTVar svar     case s of ProcessRunning pid -> return (Just pid)@@ -120,6 +123,7 @@  -- | Send signals to process. killPID :: HasCallStack => PID -> Signal -> IO ()+{-# INLINABLE killPID #-} killPID (PID pid) sig = throwUVIfMinus_ (uv_kill pid sig)  pattern SIGTERM :: Signal@@ -151,6 +155,7 @@ --   waitProcessExit pstate  -- wait for process exit on current thread. -- @ initProcess :: ProcessOptions -> Resource (Maybe UVStream, Maybe UVStream, Maybe UVStream, TVar ProcessState)+{-# INLINABLE initProcess #-} initProcess opt = initResource (spawn opt) $     \ (s0,s1,s2, pstate) -> do         _ <- waitProcessExit pstate@@ -163,6 +168,7 @@ -- The same as 'initProcess', but the clean action will try to send 'SIGTERM' -- to the process first. initProcess' :: ProcessOptions -> Resource (Maybe UVStream, Maybe UVStream, Maybe UVStream, TVar ProcessState)+{-# INLINABLE initProcess' #-} initProcess' opt = initResource (spawn opt) $     \ (s0, s1, s2, pstate) -> do         m_pid <- getProcessPID pstate@@ -179,6 +185,7 @@             => ProcessOptions                   -- ^ processStdStreams options are ignored             -> V.Bytes                          -- ^ stdin             -> IO (V.Bytes, V.Bytes, ExitCode)  -- ^ stdout, stderr, exit code+{-# INLINABLE readProcess #-} readProcess opts inp = do     withResource (initProcess opts{processStdStreams=(ProcessCreate, ProcessCreate, ProcessCreate)})         $ \ (Just s0, Just s1, Just s2, pstate) -> do@@ -202,6 +209,7 @@                 => ProcessOptions                   -- ^ processStdStreams options are ignored                 -> T.Text                           -- ^ stdin                 -> IO (T.Text, T.Text, ExitCode)    -- ^ stdout, stderr, exit code+{-# INLINABLE readProcessText #-} readProcessText opts inp = do     (out, err, e) <- readProcess opts (T.getUTF8Bytes inp)     return (T.validate out, T.validate err, e)@@ -210,6 +218,7 @@ -- -- Please manually close child process's std stream(if any) after process exits. spawn :: HasCallStack => ProcessOptions -> IO (Maybe UVStream, Maybe UVStream, Maybe UVStream, TVar ProcessState)+{-# INLINABLE spawn #-} spawn ProcessOptions{..} = do      (MutableByteArray popts##) <- newByteArray (#size uv_process_options_t)@@ -296,6 +305,7 @@ -- The returned value of priority is between -20 (high priority) and 19 (low priority). -- On Windows, the returned priority will equal one of the PRIORITY constants. getPriority :: HasCallStack => PID -> IO Priority+{-# INLINABLE getPriority #-} getPriority pid = do     (p, _) <- allocPrimUnsafe $ \ p_p -> throwUVIfMinus_ (uv_os_getpriority pid p_p)     return p@@ -307,4 +317,5 @@ -- 'PRIORITY_ABOVE_NORMAL', 'PRIORITY_HIGH', and 'PRIORITY_HIGHEST' are also provided for convenience. -- setPriority :: HasCallStack => PID -> Priority -> IO ()+{-# INLINABLE setPriority #-} setPriority pid p = throwUVIfMinus_ (uv_os_setpriority pid p)

@@ -39,7 +39,7 @@ import qualified Control.Monad.Catch        as MonadCatch import           Control.Monad.IO.Class import qualified Data.Map.Strict            as M-import           Z.Data.PrimRef.PrimIORef+import           Z.Data.PrimRef import           Z.Data.Array import qualified Z.Data.Vector              as  V import           Data.IORef@@ -81,7 +81,7 @@ -- 'with' \/ 'with''. -- initResource :: IO a -> (a -> IO ()) -> Resource a-{-# INLINE initResource #-}+{-# INLINABLE initResource #-} initResource create release = Resource $ do     r <- create     return $ (r, release r)@@ -92,7 +92,7 @@ -- inside 'Resource' monad. -- initResource_ :: IO a -> IO () -> Resource a-{-# INLINE initResource_ #-}+{-# INLINABLE initResource_ #-} initResource_ create release = Resource $ do     r <- create     return $ (r, release)@@ -188,7 +188,8 @@  -- | Dump the status of pool. statPool :: Pool key res -> IO (SmallArray (M.Map key Int))-statPool (Pool _ _ _ arr) = (`V.traverseVec` arr) $ \ resMapRef -> do+{-# INLINABLE statPool #-}+statPool (Pool _ _ _ arr) = (`V.traverse` arr) $ \ resMapRef -> do     mResMap <- readIORef resMapRef     case mResMap of         Just resMap -> return $ (`fmap` resMap) ( \ es ->@@ -203,6 +204,7 @@          -> Int     -- ^ maximum number of resources per local pool per key to be maintained.          -> Int     -- ^ amount of time after which an unused resource can be released (in seconds).          -> Resource (Pool key res)+{-# INLINABLE initPool #-} initPool resf limit itime = initResource createPool closePool   where     createPool = do@@ -215,7 +217,7 @@      closePool (Pool _ _ _ localPoolArr) = do         -- close all existed resource-        (`V.traverseVec_` localPoolArr) $ \ resMapRef ->+        (`V.traverse_` localPoolArr) $ \ resMapRef ->             atomicModifyIORef resMapRef $ \ mResMap ->                 case mResMap of                     Just resMap -> (Nothing, mapM_ closeEntry resMap)@@ -231,6 +233,7 @@ -- resource will be closed(not return to pool). withPool :: (MonadCatch.MonadMask m, MonadIO m, Ord key, HasCallStack)                    => Pool key res -> key -> (res -> m a) -> m a+{-# INLINABLE withPool #-} withPool (Pool resf limitPerKey itime arr) key f = do     !resMapRef <- indexArr arr . fst <$> liftIO (threadCapability =<< myThreadId)     fst <$> MonadCatch.generalBracket@@ -300,10 +303,12 @@                -> Int     -- ^ maximum number of resources per local pool to be maintained.                -> Int     -- ^ amount of time after which an unused resource can be released (in seconds).                -> Resource (SimplePool res)+{-# INLINABLE initSimplePool #-} initSimplePool f = initPool (const f)  -- | Open resource with 'SimplePool', see 'withPool' -- withSimplePool :: (MonadCatch.MonadMask m, MonadIO m, HasCallStack)                => SimplePool res -> (res -> m a) -> m a+{-# INLINABLE withSimplePool #-} withSimplePool pool = withPool pool ()

@@ -46,7 +46,7 @@   , stdin, stdout, stderr   , stdinBuf, stdoutBuf, stderrBuf     -- * utils-  , readStd, printStd, putStd, printStdLn, putStdLn+  , readStd, printStd, putStd, printStdLn, printStdLnP, putStdLn     -- * re-export   , withMVar   -- * Constant@@ -57,10 +57,12 @@   ) where  import Control.Monad+import Control.Monad.Primitive import Control.Concurrent.MVar import Foreign.Ptr import System.IO.Unsafe import qualified Z.Data.Builder             as B+import qualified Z.Data.Parser.Base         as P import qualified Z.Data.Text.Print          as T import qualified Z.Data.Vector              as V import Z.IO.UV.FFI@@ -252,13 +254,13 @@  -- | Get terminal's output window size in (width, height) format, -- return (-1, -1) if stdout is not connected to TTY.-getStdoutWinSize :: HasCallStack => IO (CInt, CInt)+getStdoutWinSize :: HasCallStack => IO (Int, Int) getStdoutWinSize = case stdout of     StdStream True hdl _ uvm ->         withUVManager' uvm $ do-            (w, (h, ())) <- allocPrimUnsafe $ \ w ->-                allocPrimUnsafe $ \ h -> throwUVIfMinus_ $ uv_tty_get_winsize hdl w h-            return (w, h)+            (w, (h, ())) <- allocPrimUnsafe @CInt $ \ w ->+                allocPrimUnsafe @CInt $ \ h -> throwUVIfMinus_ $ uv_tty_get_winsize hdl w h+            return (fromIntegral w, fromIntegral h)     _ -> return (-1, -1)  --------------------------------------------------------------------------------@@ -276,6 +278,10 @@ -- | Print a 'Print' and flush to stdout, with a linefeed. printStdLn :: (HasCallStack, T.Print a) => a -> IO () printStdLn s = putStdLn (T.toUTF8Builder s)++-- | Similar to 'printStdLn', 'P.Parser' debug tool.+printStdLnP :: (HasCallStack, T.Print a) => a -> P.Parser ()+printStdLnP s = unsafeIOToPrim $ putStdLn (T.toUTF8Builder s)  -- | Print a 'Builder' and flush to stdout, with a linefeed. putStdLn :: HasCallStack => B.Builder a -> IO ()

@@ -6,14 +6,11 @@ Maintainer  : winterland1989@gmail.com Stability   : experimental Portability : non-portable- Provides utilities to build <ANSI code sequences https://en.wikipedia.org/wiki/ANSI_escape_code>.- @ > putStd . bold . italicize . color Red  $ "hello" hello   -- bold, italicize and red @- -}  module Z.IO.StdStream.Ansi@@ -46,6 +43,7 @@     csi, sgr, colorToCode   ) where +import Control.Monad import qualified Z.Data.Builder as B import qualified Z.Data.Parser as P import qualified Z.Data.Text    as T@@ -58,6 +56,7 @@ csi :: [Int]  -- ^ List of parameters for the control sequence     -> B.Builder () -- ^ Character(s) that identify the control function     -> B.Builder ()+{-# INLINABLE csi #-} csi args code = do     B.char8 '\ESC'     B.char8 '['@@ -69,31 +68,38 @@   -> B.Builder () cursorDownLine, cursorUpLine :: Int -- ^ Number of lines to move                                      -> B.Builder ()-cursorUp n       = csi [n] (B.char8 'A')-cursorDown n     = csi [n] (B.char8 'B')-cursorForward n  = csi [n] (B.char8 'C')-cursorBackward n = csi [n] (B.char8 'D')-cursorDownLine n = csi [n] (B.char8 'E')-cursorUpLine n   = csi [n] (B.char8 'F')+{-# INLINABLE cursorUp #-}+cursorUp n       = when (n > 0) $ csi [n] (B.char8 'A')+{-# INLINABLE cursorDown #-}+cursorDown n     = when (n > 0) $ csi [n] (B.char8 'B')+{-# INLINABLE cursorForward #-}+cursorForward n  = when (n > 0) $ csi [n] (B.char8 'C')+{-# INLINABLE cursorBackward #-}+cursorBackward n = when (n > 0) $ csi [n] (B.char8 'D')+{-# INLINABLE cursorDownLine #-}+cursorDownLine n = when (n > 0) $ csi [n] (B.char8 'E')+{-# INLINABLE cursorUpLine #-}+cursorUpLine n   = when (n > 0) $ csi [n] (B.char8 'F') -getCursorPosition :: IO (Int, Int)-getCursorPosition = do-    withRawStdin . withMVar stdinBuf $ \ i -> do-        clearInputBuffer i-        putStd (csi [] "6n")-        readParser (do-            P.word8 ESC-            P.word8 BRACKET_LEFT-            !n <- P.int-            P.word8 SEMICOLON-            !m <- P.int-            P.word8 LETTER_R-            return (m, n)) i+getCursorPosition :: BufferedInput -> IO (Int, Int)+{-# INLINABLE getCursorPosition #-}+getCursorPosition i = do+    clearInputBuffer i+    putStd (csi [] "6n")+    readParser (do+        P.word8 ESC+        P.word8 BRACKET_LEFT+        !n <- P.int+        P.word8 SEMICOLON+        !m <- P.int+        P.word8 LETTER_R+        return (m, n)) i  -- | Code to move the cursor to the specified column. The column numbering is -- 1-based (that is, the left-most column is numbered 1). setCursorColumn :: Int -- ^ 1-based column to move to                 -> B.Builder ()+{-# INLINABLE setCursorColumn #-} setCursorColumn n = csi [n] (B.char8 'G')  -- | Code to move the cursor to the specified position (row and column). The@@ -101,34 +107,48 @@ setCursorPosition :: Int -- ^ 1-based row to move to                   -> Int -- ^ 1-based column to move to                   -> B.Builder ()+{-# INLINABLE setCursorPosition #-} setCursorPosition n m = csi [n, m] (B.char8 'G')  saveCursor, restoreCursor :: B.Builder ()+{-# INLINABLE saveCursor #-} saveCursor    = B.char8 '\ESC' >> B.char8 '7'+{-# INLINABLE restoreCursor #-} restoreCursor = B.char8 '\ESC' >> B.char8 '8'  clearFromCursorToScreenEnd, clearFromCursorToScreenBeginning, clearScreen :: B.Builder () clearFromCursorToLineEnd, clearFromCursorToLineBeginning, clearLine :: B.Builder () +{-# INLINABLE clearFromCursorToScreenEnd #-} clearFromCursorToScreenEnd       = csi [0] (B.char8 'J')+{-# INLINABLE clearFromCursorToScreenBeginning #-} clearFromCursorToScreenBeginning = csi [1] (B.char8 'J')+{-# INLINABLE clearScreen #-} clearScreen                      = csi [2] (B.char8 'J')+{-# INLINABLE clearFromCursorToLineEnd #-} clearFromCursorToLineEnd         = csi [0] (B.char8 'K')+{-# INLINABLE clearFromCursorToLineBeginning #-} clearFromCursorToLineBeginning   = csi [1] (B.char8 'K')+{-# INLINABLE clearLine #-} clearLine                        = csi [2] (B.char8 'K')  scrollPageUp, scrollPageDown :: Int -- ^ Number of lines to scroll by                              -> B.Builder()-scrollPageUp n   = csi [n] (B.char8 'S')-scrollPageDown n = csi [n] (B.char8 'T')+{-# INLINABLE scrollPageUp #-}+scrollPageUp n   = when (n > 0) $ csi [n] (B.char8 'S')+{-# INLINABLE scrollPageDown #-}+scrollPageDown n = when (n > 0) $ csi [n] (B.char8 'T')  hideCursor, showCursor :: B.Builder ()+{-# INLINABLE hideCursor #-} hideCursor = csi [] "?25l"+{-# INLINABLE showCursor #-} showCursor = csi [] "?25h"  -- | XTerm control sequence to set the Icon Name and Window Title. setTitle :: T.Text  -- ^ New Icon Name and Window Title          -> B.Builder ()+{-# INLINABLE setTitle #-} setTitle title = do     "\ESC]0;"     B.text (T.filter (/= '\007') title)@@ -136,6 +156,7 @@  sgr :: [Word8]  -- ^ List of sgr code for the control sequence     -> B.Builder ()+{-# INLINABLE sgr #-} sgr args = do     B.char8 '\ESC'     B.char8 '['@@ -143,52 +164,72 @@     B.char8 'm'  reset :: B.Builder ()+{-# INLINABLE reset #-} reset = sgr [0]  boldIntensity, faintIntensity, resetIntensity :: B.Builder ()+{-# INLINABLE boldIntensity #-} boldIntensity  = sgr [1]+{-# INLINABLE faintIntensity #-} faintIntensity = sgr [2]+{-# INLINABLE resetIntensity #-} resetIntensity    = sgr [22]  bold :: B.Builder () -> B.Builder ()+{-# INLINABLE bold #-} bold t = boldIntensity >> t >> resetIntensity  italicized, noItalicized :: B.Builder ()+{-# INLINABLE italicized #-} italicized      = sgr [3]+{-# INLINABLE noItalicized #-} noItalicized    = sgr [23]  -- | Italicize some text italicize :: B.Builder () -> B.Builder ()+{-# INLINABLE italicize #-} italicize t = italicized >> t >> noItalicized  singleUnderline, doubleUnderline, noUnderline :: B.Builder ()+{-# INLINABLE singleUnderline #-} singleUnderline = sgr [4]+{-# INLINABLE doubleUnderline #-} doubleUnderline = sgr [21]+{-# INLINABLE noUnderline #-} noUnderline   = sgr [24]  -- | Add single underline to some text underline  :: B.Builder () -> B.Builder ()+{-# INLINABLE underline #-} underline t = singleUnderline >> t >> singleUnderline  slowBlink, rapidBlink, blinkOff :: B.Builder () -- | less than 150 per minute+{-# INLINABLE slowBlink #-} slowBlink   = sgr [5] -- | MS-DOS ANSI.SYS, 150+ per minute; not widely supported+{-# INLINABLE rapidBlink #-} rapidBlink  = sgr [6]+{-# INLINABLE blinkOff #-} blinkOff     = sgr [25]  conceal, reveal :: B.Builder () -- | Aka Hide, not widely supported.+{-# INLINABLE conceal #-} conceal = sgr [8]+{-# INLINABLE reveal #-} reveal = sgr [28]  invert, invertOff :: B.Builder () -- | Swap foreground and background colors, inconsistent emulation+{-# INLINABLE invert #-} invert = sgr [7]+{-# INLINABLE invertOff #-} invertOff = sgr [27]  -- | Colorized some text color :: AnsiColor -> B.Builder () -> B.Builder ()+{-# INLINABLE color #-} color c t = do     setForeground c     t@@ -196,6 +237,7 @@  -- | Colorized some text with background color color' :: AnsiColor -> AnsiColor -> B.Builder () -> B.Builder ()+{-# INLINABLE color' #-} color' c1 c2 t = do     setForeground c1     setBackground c2@@ -205,6 +247,7 @@  -- | Colorized some text palette :: PaletteColor -> B.Builder () -> B.Builder ()+{-# INLINABLE palette #-} palette c t = do     setPaletteForeground c     t@@ -212,6 +255,7 @@  -- | Colorized some text with background color palette' :: PaletteColor -> PaletteColor -> B.Builder () -> B.Builder ()+{-# INLINABLE palette' #-} palette' c1 c2 t = do     setPaletteForeground c1     setPaletteBackground c2@@ -221,6 +265,7 @@  -- | Colorized some text rgb :: RGBColor -> B.Builder () -> B.Builder ()+{-# INLINABLE rgb #-} rgb c t = do     setRGBForeground c     t@@ -228,6 +273,7 @@  -- | Colorized some text with background color rgb' :: RGBColor -> RGBColor -> B.Builder () -> B.Builder ()+{-# INLINABLE rgb' #-} rgb' c1 c2 t = do     setRGBForeground c1     setRGBBackground c2@@ -236,21 +282,31 @@     setDefaultBackground  setForeground, setBrightForeground, setBackground, setBrightBackground :: AnsiColor -> B.Builder ()+{-# INLINABLE setForeground #-} setForeground c       = sgr [30 + colorToCode c]+{-# INLINABLE setBrightForeground #-} setBrightForeground c = sgr [90 + colorToCode c]+{-# INLINABLE setBackground #-} setBackground c       = sgr [40 + colorToCode c]+{-# INLINABLE setBrightBackground #-} setBrightBackground c = sgr [100 + colorToCode c]  setPaletteForeground, setPaletteBackground :: PaletteColor -> B.Builder ()+{-# INLINABLE setPaletteForeground #-} setPaletteForeground index = sgr [38, 5, index]+{-# INLINABLE setPaletteBackground #-} setPaletteBackground index = sgr [48, 5, index]  setRGBForeground, setRGBBackground :: RGBColor -> B.Builder ()+{-# INLINABLE setRGBForeground #-} setRGBForeground (r,g,b) = sgr [38, 2, r, g, b]+{-# INLINABLE setRGBBackground #-} setRGBBackground (r,g,b) = sgr [48, 2, r, g, b]  setDefaultForeground, setDefaultBackground :: B.Builder ()+{-# INLINABLE setDefaultForeground #-} setDefaultForeground = sgr [39]+{-# INLINABLE setDefaultBackground #-} setDefaultBackground = sgr [49]  -- | ANSI's eight standard colors@@ -266,6 +322,7 @@         deriving anyclass T.Print  colorToCode :: AnsiColor -> Word8+{-# INLINABLE colorToCode #-} colorToCode c = case c of     Black   -> 0     Red     -> 1

@@ -36,6 +36,7 @@  -- | A alternative version of 'getSystemTime'' based on libuv's @uv_gettimeofday@, which also doesn't use pinned allocation. getSystemTime' :: HasCallStack => IO SystemTime+{-# INLINABLE getSystemTime' #-} getSystemTime' = do     (TimeVal64 s us) <- getTimeOfDay     return (MkSystemTime s (fromIntegral us * 1000))@@ -48,6 +49,7 @@ -- The value is \"%Y-%m-%d %H:%M:%S\". -- This should be used with 'formatSystemTime' and 'parseSystemTime'. simpleDateFormat :: TimeFormat+{-# INLINABLE simpleDateFormat #-} simpleDateFormat = "%Y-%m-%d %H:%M:%S"  -- | Simple format @2020-10-16T03:15:29@.@@ -55,6 +57,7 @@ -- The value is \"%Y-%m-%dT%H:%M:%S%z\". -- This should be used with 'formatSystemTime' and 'parseSystemTime'. iso8061DateFormat :: TimeFormat+{-# INLINABLE iso8061DateFormat #-} iso8061DateFormat = "%Y-%m-%dT%H:%M:%S%z"  -- | Format for web (RFC 2616).@@ -62,6 +65,7 @@ -- The value is \"%a, %d %b %Y %H:%M:%S GMT\". -- This should be used with 'formatSystemTimeGMT' and 'parseSystemTimeGMT'. webDateFormat :: TimeFormat+{-# INLINABLE webDateFormat #-} webDateFormat = "%a, %d %b %Y %H:%M:%S GMT"  -- | Format for e-mail (RFC 5322).@@ -69,6 +73,7 @@ -- The value is \"%a, %d %b %Y %H:%M:%S %z\". -- This should be used with 'formatSystemTime' and 'parseSystemTime'. mailDateFormat :: TimeFormat+{-# INLINABLE mailDateFormat #-} mailDateFormat = "%a, %d %b %Y %H:%M:%S %z"  ----------------------------------------------------------------@@ -79,7 +84,7 @@ -- formatSystemTime :: TimeFormat -> SystemTime -> IO CBytes formatSystemTime fmt t = formatSystemTimeHelper c_format_unix_time fmt t-{-# INLINE formatSystemTime #-}+{-# INLINABLE formatSystemTime #-}  -- | Formatting 'SystemTime' to 'CBytes' in GMT. --@@ -98,7 +103,7 @@ formatSystemTimeGMT :: TimeFormat -> SystemTime -> CBytes formatSystemTimeGMT fmt t =     unsafePerformIO $ formatSystemTimeHelper c_format_unix_time_gmt fmt t-{-# INLINE formatSystemTimeGMT #-}+{-# INLINABLE formatSystemTimeGMT #-}  ---------------------------------------------------------------- -- | Parsing 'CBytes' to 'SystemTime' interpreting as localtime.@@ -120,6 +125,7 @@ -- @ -- parseSystemTime :: TimeFormat -> CBytes -> IO SystemTime+{-# INLINABLE parseSystemTime #-} parseSystemTime fmt str =     withCBytesUnsafe fmt $ \cfmt ->         withCBytesUnsafe str $ \cstr -> do@@ -134,6 +140,7 @@ -- MkSystemTime {systemSeconds = 0, systemNanoseconds = 0}  parseSystemTimeGMT :: TimeFormat -> CBytes -> SystemTime+{-# INLINABLE parseSystemTimeGMT #-} parseSystemTimeGMT fmt str = unsafePerformIO $     withCBytesUnsafe fmt $ \cfmt ->         withCBytesUnsafe str $ \cstr -> do@@ -160,6 +167,7 @@     -> TimeFormat     -> SystemTime     -> IO CBytes+{-# INLINABLE formatSystemTimeHelper #-} formatSystemTimeHelper formatFun fmt t = go 80   where     MkSystemTime sec _ = t

@@ -22,12 +22,14 @@  -- | Returns the error message for the given error code. Leaks a few bytes of memory when you call it with an unknown error code. uvStdError :: CInt -> IO Text+{-# INLINABLE uvStdError #-} uvStdError errno = toText <$> (fromCString =<< uv_strerror errno)  foreign import ccall unsafe uv_strerror :: CInt -> IO CString  -- | Returns the error name for the given error code. Leaks a few bytes of memory when you call it with an unknown error code. uvErrName :: CInt -> IO Text+{-# INLINABLE uvErrName #-} uvErrName errno = toText <$> (fromCString =<< uv_err_name errno)  foreign import ccall unsafe uv_err_name :: CInt -> IO CString

@@ -62,15 +62,18 @@ data UVLoopData  peekUVEventQueue :: Ptr UVLoopData -> IO (Int, Ptr Int)+{-# INLINABLE peekUVEventQueue #-} peekUVEventQueue p = (,)     <$> (#{peek hs_loop_data, event_counter          } p)     <*> (#{peek hs_loop_data, event_queue            } p)  clearUVEventCounter :: Ptr UVLoopData -> IO ()+{-# INLINABLE clearUVEventCounter #-} clearUVEventCounter p = do     #{poke hs_loop_data, event_counter          } p $ (0 :: Int)  peekUVBufferTable :: Ptr UVLoopData -> IO (Ptr (Ptr Word8), Ptr CSsize)+{-# INLINABLE peekUVBufferTable #-} peekUVBufferTable p = (,)     <$> (#{peek hs_loop_data, buffer_table          } p)     <*> (#{peek hs_loop_data, buffer_size_table     } p)@@ -86,6 +89,7 @@  -- | Peek loop data pointer from uv loop  pointer. peekUVLoopData :: Ptr UVLoop -> IO (Ptr UVLoopData)+{-# INLINABLE peekUVLoopData #-} peekUVLoopData p = #{peek uv_loop_t, data} p  foreign import ccall unsafe hs_uv_loop_init      :: Int -> IO (Ptr UVLoop)@@ -110,6 +114,7 @@ data UVHandle  peekUVHandleData :: Ptr UVHandle -> IO UVSlotUnsafe+{-# INLINABLE peekUVHandleData #-} peekUVHandleData p =  UVSlotUnsafe <$> (#{peek uv_handle_t, data} p :: IO Int)  foreign import ccall unsafe hs_uv_fileno :: Ptr UVHandle -> IO FD@@ -155,6 +160,7 @@ foreign import ccall unsafe uv_tcp_getpeername :: Ptr UVHandle -> MBA## SocketAddr -> MBA## CInt -> IO CInt  uV_TCP_IPV6ONLY :: CUInt+{-# INLINABLE uV_TCP_IPV6ONLY #-} uV_TCP_IPV6ONLY = #const UV_TCP_IPV6ONLY  foreign import ccall unsafe uv_tcp_bind :: Ptr UVHandle -> MBA## SocketAddr -> CUInt -> IO CInt@@ -515,6 +521,7 @@     | otherwise          = DirEntUnknown  peekUVDirEnt :: Ptr DirEntType -> IO (CString, UVDirEntType)+{-# INLINABLE peekUVDirEnt #-} #ifdef HAVE_DIRENT_TYPES peekUVDirEnt p = (,) (#{ptr hs_uv__dirent_t, d_name } p) <$> (#{peek hs_uv__dirent_t, d_type } p) #else@@ -537,10 +544,14 @@         deriving anyclass (Print, JSON)  instance Storable UVTimeSpec where+    {-# INLINABLE sizeOf #-}     sizeOf _  = #{size uv_timespec_t}+    {-# INLINABLE alignment #-}     alignment _ = #{alignment uv_timespec_t}+    {-# INLINABLE peek #-}     peek p = UVTimeSpec <$> (#{peek uv_timespec_t, tv_sec } p)                         <*> (#{peek uv_timespec_t, tv_nsec } p)+    {-# INLINABLE poke #-}     poke p (UVTimeSpec sec nsec) = do         (#{poke uv_timespec_t, tv_sec  } p sec)         (#{poke uv_timespec_t, tv_nsec } p nsec)@@ -566,9 +577,11 @@       deriving anyclass (Print, JSON)  uvStatSize :: Int+{-# INLINABLE uvStatSize #-} uvStatSize = #{size uv_stat_t}  peekUVStat :: Ptr FStat -> IO FStat+{-# INLINABLE peekUVStat #-} peekUVStat p = FStat     <$> (#{peek uv_stat_t, st_dev          } p)     <*> (fromIntegral <$> (#{peek uv_stat_t, st_mode } p :: IO Word64))@@ -821,6 +834,7 @@   deriving anyclass (Print, JSON)  processStdStreamFlag :: ProcessStdStream -> CInt+{-# INLINABLE processStdStreamFlag #-} processStdStreamFlag ProcessIgnore = #const UV_IGNORE processStdStreamFlag ProcessCreate = (#const UV_CREATE_PIPE)                             .|. (#const UV_READABLE_PIPE)

@@ -75,9 +75,11 @@         deriving anyclass (Print, JSON)  sizeOfResUsage :: Int+{-# INLINABLE sizeOfResUsage #-} sizeOfResUsage = #size uv_rusage_t  peekResUsage :: MBA## a -> IO ResUsage+{-# INLINABLE peekResUsage #-} peekResUsage mba = do     utime_sec :: CLong <- peekMBA mba (#offset  uv_rusage_t, ru_utime )     utime_usec :: CLong <- peekMBA mba ((#offset  uv_rusage_t, ru_utime) + sizeOf (undefined :: CLong))@@ -147,6 +149,7 @@         deriving anyclass (Print, JSON)  getOSName :: HasCallStack => IO OSName+{-# INLINABLE getOSName #-} getOSName = do     (MutableByteArray mba##) <- newByteArray (#size uv_utsname_t)     throwUVIfMinus_ (uv_os_uname mba##)@@ -180,6 +183,7 @@ -- On non-Windows systems, all data comes from getpwuid_r(3). -- On Windows, uid and gid are set to -1 and have no meaning, and shell is empty. getPassWD :: HasCallStack => IO PassWD+{-# INLINABLE getPassWD #-} getPassWD =  bracket     (do mpa@(MutableByteArray mba##) <- newByteArray (#size uv_passwd_t)         throwUVIfMinus_ (uv_os_get_passwd mba##)@@ -215,6 +219,7 @@  -- | Gets information about the CPUs on the system. getCPUInfo :: HasCallStack => IO [CPUInfo]+{-# INLINABLE getCPUInfo #-} getCPUInfo = bracket     (do (p, (len, _)) <-  allocPrimUnsafe $ \ pp ->             allocPrimUnsafe $ \ plen ->@@ -224,6 +229,7 @@     (\ (p, len) -> forM [0..fromIntegral len-1] (peekCPUInfoOff p))  peekCPUInfoOff :: Ptr CPUInfo -> Int -> IO CPUInfo+{-# INLINABLE peekCPUInfoOff #-} peekCPUInfoOff p off = do     let p' = p `plusPtr` (off * (#size uv_cpu_info_t))     model <- fromCString =<< (#peek uv_cpu_info_t, model) p'@@ -239,6 +245,7 @@  -- | Gets the load average. See: <https://en.wikipedia.org/wiki/Load_(computing)> getLoadAvg :: IO (Double, Double, Double)+{-# INLINABLE getLoadAvg #-} getLoadAvg = do     (arr, _) <- allocPrimArrayUnsafe 3 uv_loadavg     return ( indexPrimArray arr 0@@ -258,6 +265,7 @@ -- | Cross-platform implementation of <https://man7.org/linux/man-pages/man2/gettimeofday.2.html gettimeofday(2)>. -- The timezone argument to gettimeofday() is not supported, as it is considered obsolete. getTimeOfDay :: HasCallStack => IO TimeVal64+{-# INLINABLE getTimeOfDay #-} getTimeOfDay = do     (MutableByteArray mba##) <- newByteArray (#size uv_timeval64_t)     throwUVIfMinus_ (uv_gettimeofday mba##)

@@ -55,7 +55,7 @@ import           GHC.Conc.Sync            (labelThread) import           System.IO.Unsafe import           Z.Data.Array-import           Z.Data.PrimRef.PrimIORef+import           Z.Data.PrimRef import qualified Z.Data.Text.Print as T import           Z.IO.Exception import           Z.IO.Resource@@ -82,6 +82,7 @@ instance Show UVManager where show = T.toString  instance T.Print UVManager where+    {-# INLINABLE toUTF8BuilderP #-}     toUTF8BuilderP p uvm = T.parenWhen (p > 10) $         "UVManager on capability " >> T.int (uvmCap uvm) @@ -162,6 +163,7 @@     pokeElemOff bufSizTable slot (fromIntegral bufSiz)  initUVManager :: HasCallStack => Int -> Int -> Resource UVManager+{-# INLINABLE initUVManager #-} initUVManager siz cap = do     loop  <- initResource                 (throwOOMIfNull $ hs_uv_loop_init (fromIntegral siz))@@ -180,6 +182,7 @@ -- libuv is not thread safe, use this function to perform any action which will mutate uv_loop's state. -- withUVManager :: HasCallStack => UVManager -> (Ptr UVLoop -> IO a) -> IO a+{-# INLINABLE withUVManager #-} withUVManager (UVManager _ loop loopData runningLock _) f = go   where     go = do@@ -205,11 +208,13 @@ -- In fact most of the libuv's functions are not thread safe, so watch out! -- withUVManager' :: HasCallStack => UVManager -> IO a -> IO a+{-# INLINABLE withUVManager' #-} withUVManager' uvm f = withUVManager uvm (\ _ -> f)  -- | Start the uv loop -- startUVManager :: HasCallStack => UVManager -> IO ()+{-# INLINABLE startUVManager #-} startUVManager uvm@(UVManager _ _ _ runningLock _) = poll -- use a closure capture uvm in case of stack memory leaking   where     -- we borrow mio's non-blocking/blocking poll strategy here@@ -267,7 +272,7 @@ -- Always use this function to turn an 'UVSlotUnsafe' into 'UVSlot', so that the block -- table size synchronize with libuv side's slot table. getUVSlot :: HasCallStack => UVManager -> IO UVSlotUnsafe -> IO UVSlot-{-# INLINE getUVSlot #-}+{-# INLINABLE getUVSlot #-} getUVSlot (UVManager blockTableRef _ _ _ _) f = do     slot <- throwUVIfMinus (unsafeGetSlot <$> f)     blockTable <- readIORef blockTableRef@@ -287,6 +292,7 @@ -- | Cancel uv async function (actions which can be cancelled with 'uv_cancel') with -- best effort, if the action is already performed, run an extra clean up action. cancelUVReq :: UVManager -> UVSlot -> (Int -> IO ()) -> IO ()+{-# INLINABLE cancelUVReq #-} cancelUVReq uvm slot extra_cleanup = withUVManager uvm $ \ loop -> do     m <- getBlockMVar uvm slot     r <- tryTakeMVar m@@ -306,6 +312,7 @@ -- async function with best efforts, withUVRequest :: HasCallStack               => UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO Int+{-# INLINABLE withUVRequest #-} withUVRequest uvm f = do     (slot, m) <- withUVManager uvm $ \ loop -> mask_ $ do         slot <- getUVSlot uvm (f loop)@@ -318,6 +325,7 @@ -- | Same with 'withUVRequest' but disgard the result. withUVRequest_ :: HasCallStack                => UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> IO ()+{-# INLINABLE withUVRequest_ #-} withUVRequest_ uvm f = void (withUVRequest uvm f)  -- | Same with 'withUVRequest' but apply an convert function to result.@@ -330,6 +338,7 @@                -> (Ptr UVLoop -> IO UVSlotUnsafe)                -> (Int -> IO b)     -- ^ convert function                -> IO b+{-# INLINABLE withUVRequest' #-} withUVRequest' uvm f g = do     (slot, m) <- withUVManager uvm $ \ loop -> mask_ $ do         slot <- getUVSlot uvm (f loop)@@ -345,6 +354,7 @@ -- e.g. release result memory. withUVRequestEx :: HasCallStack                 => UVManager -> (Ptr UVLoop -> IO UVSlotUnsafe) -> (Int -> IO ()) -> IO Int+{-# INLINABLE withUVRequestEx #-} withUVRequestEx uvm f extra_cleanup = do     (slot, m) <- withUVManager uvm $ \ loop -> mask_ $ do         slot <- getUVSlot uvm (f loop)@@ -364,6 +374,7 @@ -- we solve this problem with simple round-robin load-balancing: forkBa will automatically -- distribute new threads to all capabilities in round-robin manner. Thus its name forkBa(lance). forkBa :: IO () -> IO ThreadId+{-# INLINABLE forkBa #-} forkBa io = do     i <- atomicAddCounter counter 1     forkOn i io

@@ -51,6 +51,7 @@ instance Show UVStream where show = T.toString  instance T.Print UVStream where+    {-# INLINABLE toUTF8BuilderP #-}     toUTF8BuilderP _ (UVStream hdl slot uvm _) = do         "UVStream{uvsHandle="  >> T.toUTF8Builder hdl         ",uvsSlot="            >> T.toUTF8Builder slot@@ -72,6 +73,7 @@              => (Ptr UVLoop -> Ptr UVHandle -> IO ())              -> UVManager              -> Resource UVStream+{-# INLINABLE initUVStream #-} initUVStream f uvm = initResource     (withUVManager uvm $ \ loop -> do         hdl <- hs_uv_handle_alloc loop@@ -85,6 +87,7 @@  -- | Manually close a uv stream. closeUVStream :: UVStream -> IO ()+{-# INLINABLE closeUVStream #-} closeUVStream (UVStream hdl _ uvm closed) = withUVManager' uvm $ do     c <- readIORef closed     -- hs_uv_handle_close won't return error@@ -94,6 +97,7 @@ -- -- Futher writing will throw 'ResourceVanished'(EPIPE). shutdownUVStream :: HasCallStack => UVStream -> IO ()+{-# INLINABLE shutdownUVStream #-} shutdownUVStream (UVStream hdl _ uvm closed) = do     c <- readIORef closed     when c throwECLOSED@@ -106,6 +110,7 @@  -- | Get stream fd getUVStreamFD :: HasCallStack => UVStream -> IO FD+{-# INLINABLE getUVStreamFD #-} getUVStreamFD (UVStream hdl _ _ closed) = do     c <- readIORef closed     when c throwECLOSED@@ -187,10 +192,12 @@  -- | Write "hello world" to a 'UVStream'. helloWorld :: UVStream -> IO ()+{-# INLINABLE helloWorld #-} helloWorld uvs = writeOutput uvs (Ptr "hello world"#) 11  -- | Echo whatever received bytes. echo :: UVStream -> IO ()+{-# INLINABLE echo #-} echo uvs = do     i <- newBufferedInput uvs     o <- newBufferedOutput uvs

@@ -20,7 +20,7 @@ -- This functions will run 'uv__once_init' once if not run before, -- withUVInitDo :: IO a -> IO a-{-# INLINE withUVInitDo #-}+{-# INLINABLE withUVInitDo #-}  #if defined(mingw32_HOST_OS) 

@@ -7,63 +7,74 @@ -- -- The notes on linux 'writeFileP' applied to 'FilePtr' too. data FilePtr = FilePtr {-# UNPACK #-} !File-                       {-# UNPACK #-} !(PrimIORef Int64)+                       {-# UNPACK #-} !(PrimRef RealWorld Int64)  -- |  Create a file offset bundle from an 'File'. -- newFilePtr :: File       -- ^ the file we're reading            -> Int64      -- ^ initial offset            -> IO FilePtr-newFilePtr uvf off = FilePtr uvf <$> newPrimIORef off+{-# INLINABLE newFilePtr #-}+newFilePtr uvf off = FilePtr uvf <$> newPrimRef off  -- | Get current offset. getFilePtrOffset :: FilePtr -> IO Int64-getFilePtrOffset (FilePtr _ offsetRef) = readPrimIORef offsetRef+{-# INLINABLE getFilePtrOffset #-}+getFilePtrOffset (FilePtr _ offsetRef) = readPrimRef offsetRef  -- | Change current offset. setFilePtrOffset :: FilePtr -> Int64 -> IO ()-setFilePtrOffset (FilePtr _ offsetRef) = writePrimIORef offsetRef+{-# INLINABLE setFilePtrOffset #-}+setFilePtrOffset (FilePtr _ offsetRef) = writePrimRef offsetRef  instance Input FilePtr where+    {-# INLINABLE readInput #-}     readInput (FilePtr file offsetRef) buf bufSiz =-        readPrimIORef offsetRef >>= \ off -> do+        readPrimRef offsetRef >>= \ off -> do             l <- readFileP file buf bufSiz off-            writePrimIORef offsetRef (off + fromIntegral l)+            writePrimRef offsetRef (off + fromIntegral l)             return l  instance Output FilePtr where+    {-# INLINABLE writeOutput #-}     writeOutput (FilePtr file offsetRef) buf bufSiz =-        readPrimIORef offsetRef >>= \ off -> do+        readPrimRef offsetRef >>= \ off -> do             writeFileP file buf bufSiz off-            writePrimIORef offsetRef (off + fromIntegral bufSiz)+            writePrimRef offsetRef (off + fromIntegral bufSiz)  -- | Quickly open a file and read its content. readFile :: HasCallStack => CBytes -> IO V.Bytes+{-# INLINABLE readFile #-} readFile filename = do     withResource (initFile filename O_RDONLY DEFAULT_FILE_MODE) $ \ file -> do         readAll' =<< newBufferedInput file  -- | Quickly open a file and read its content as UTF8 text. readTextFile :: HasCallStack => CBytes -> IO T.Text+{-# INLINABLE readTextFile #-} readTextFile filename = T.validate <$> readFile filename  -- | Quickly open a file and write some content. writeFile :: HasCallStack => CBytes -> V.Bytes -> IO ()+{-# INLINABLE writeFile #-} writeFile filename content = do     withResource (initFile filename (O_WRONLY .|. O_CREAT) DEFAULT_FILE_MODE) $ \ file -> do         withPrimVectorSafe content (writeOutput file)  -- | Quickly open a file and write some content as UTF8 text. writeTextFile :: HasCallStack => CBytes -> T.Text -> IO ()+{-# INLINABLE writeTextFile #-} writeTextFile filename content = writeFile filename (T.getUTF8Bytes content)  -- | Quickly open a file and read its content as a JSON value. -- Throw 'OtherError' with name @EPARSE@ if JSON value is not parsed. readJSONFile :: (HasCallStack, JSON.JSON a) => CBytes -> IO a+{-# INLINABLE readJSONFile #-} readJSONFile filename = unwrap "EPARSE" . JSON.decode' =<< readFile filename  -- | Quickly open a file and write a JSON Value. writeJSONFile :: (HasCallStack, JSON.JSON a) => CBytes -> a -> IO ()+{-# INLINABLE writeJSONFile #-} writeJSONFile filename x = writeFile filename (JSON.encode x)  --------------------------------------------------------------------------------@@ -76,6 +87,7 @@ --  scandirRecursively "."  (\\ p _ -> (== ".hs") . snd \<$\> splitExtension p) -- @ scandirRecursively :: HasCallStack => CBytes -> (CBytes -> DirEntType -> IO Bool) -> IO [CBytes]+{-# INLINABLE scandirRecursively #-} scandirRecursively dir p = loop [] =<< P.normalize dir   where     loop acc0 pdir =@@ -93,44 +105,53 @@ -- | Does given path exist? -- doesPathExist :: CBytes -> IO Bool+{-# INLINABLE doesPathExist #-} doesPathExist path = maybe False (const True) <$> stat' path  -- | Returns 'True' if the argument file exists and is either a file or a -- symbolic link to a file, and 'False' otherwise. doesFileExist :: CBytes -> IO Bool+{-# INLINABLE doesFileExist #-} doesFileExist path = maybe False isFileSt <$> stat' path  -- | Returns 'True' if the argument directory exists and is either a directory or a -- symbolic link to a directory, and 'False' otherwise. doesDirExist :: CBytes -> IO Bool+{-# INLINABLE doesDirExist #-} doesDirExist path = maybe False isDirSt <$> stat' path  --------------------------------------------------------------------------------  -- | If given path is a symbolic link? isLink :: HasCallStack => CBytes -> IO Bool+{-# INLINABLE isLink #-} isLink = fmap isLinkSt . lstat  -- | If given path is a directory or a symbolic link to a directory? isDir :: HasCallStack => CBytes -> IO Bool+{-# INLINABLE isDir #-} isDir = fmap isDirSt . stat  -- | If given path is a file or a symbolic link to a file? isFile :: HasCallStack => CBytes -> IO Bool+{-# INLINABLE isFile #-} isFile = fmap isFileSt . stat  -- | Shortcut to @\\ st -> stMode st .&. S_IFMT == S_IFLNK@ -- -- Note you should use 'lstat' to get the link's stat. isLinkSt :: FStat -> Bool+{-# INLINABLE isLinkSt #-} isLinkSt st = stMode st .&. S_IFMT == S_IFLNK  -- | Shortcut to @\\ st -> stMode st .&. S_IFMT == S_IFDIR@ isDirSt :: FStat -> Bool+{-# INLINABLE isDirSt #-} isDirSt st = stMode st .&. S_IFMT == S_IFDIR  -- | Shortcut to @\\ st -> stMode st .&. S_IFMT == S_IFREG@ isFileSt :: FStat -> Bool+{-# INLINABLE isFileSt #-} isFileSt st = stMode st .&. S_IFMT == S_IFREG  -------------------------------------------------------------------------------@@ -143,6 +164,7 @@ -- ("/var/folders/3l/cfdy03vd1gvd1x75gg_js7280000gn/T/Z-IO-bYgZDX",File 13) -- initTempFile :: HasCallStack => Resource (CBytes, File)+{-# INLINABLE initTempFile #-} initTempFile = do     d <- liftIO $ Env.getTempDir     mkstemp d "Z-IO-" False@@ -155,4 +177,5 @@ -- "/tmp/Z-IO-xfWR0L" -- initTempDir :: HasCallStack => Resource CBytes+{-# INLINABLE initTempDir #-} initTempDir = initResource (Env.getTempDir >>= (`P.join` "Z-IO-") >>= mkdtemp) rmrf

@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}++module Z.IO.BIO.BaseSpec where++import           Control.Concurrent+import           Control.Monad+import qualified Codec.Compression.Zlib as TheZlib+import           Data.IORef+import qualified Z.Data.Vector         as V+import           Z.IO.BIO.Zlib+import           Z.IO.BIO.Base+import           Z.IO+import           Test.QuickCheck+import           Test.QuickCheck.Function+import           Test.QuickCheck.Property+import           Test.Hspec+import           Test.Hspec.QuickCheck+import           Test.HUnit+import           System.IO.Unsafe+++spec :: Spec+spec = describe "BIO" . modifyMaxSize (*10) $ do++    describe "decode . encode === id(Base64)" $+        prop "Base64" $ \ xs ->+            let r = unsafePerformIO $ do+                    let src = sourceFromList xs+                    (rRef, sink) <- sinkToList+                    enc <- newBase64Encoder+                    dec <- newBase64Decoder+                    run_ $ src . enc . dec . sink+                    takeMVar rRef+            in V.concat r === V.concat xs++    describe "decode . encode === id(Hex)" $ do+        prop "Hex" $ \ xs upper ->+            let r = unsafePerformIO $ do+                    let src = sourceFromList xs+                    (rRef, sink) <- sinkToList+                    dec <- newHexDecoder+                    run_ $ src . hexEncode upper . dec . sink+                    takeMVar rRef+            in V.concat r === V.concat xs+

@@ -7,8 +7,7 @@ import           Control.Monad import           Control.Monad.IO.Class import           Data.IORef-import           Z.IO.BIO.Concurrent-import           Z.IO.BIO+import qualified Z.IO.BIO               as BIO import           Test.QuickCheck import           Test.QuickCheck.Function import           Test.QuickCheck.Property@@ -22,23 +21,23 @@ spec :: Spec spec = describe "BIO.Concurrent" $ do -    prop "zipBIO works like zip on Sources" $ \ xs ys -> monadicIO $ do-        (zs :: [(Int, Int)]) <- liftIO . runBIO $ zipBIO  (sourceFromList xs) (sourceFromList ys)+    prop "zip works like zip on Sources" $ \ xs ys -> monadicIO $ do+        (zs :: [(Int, Int)]) <- liftIO . BIO.run $ BIO.zip  (BIO.sourceFromList xs) (BIO.sourceFromList ys)         QM.assert (zs == zip xs ys)      it "TQueueNode works as expected" $ do         let content = [1..1000] -        (sink, src) <- newTQueueNode 2+        (sink, src) <- BIO.newTQueuePair 2         sumRef <- newIORef 0          let producter = do                 src' <- sourceListWithDelay content-                runBIO_ (src' . sink)+                BIO.run_ (src' . sink)          let consumer =  do-                (rRef, sink') <- sinkToList-                runBIO_ (src . sink')+                (rRef, sink') <- BIO.sinkToList+                BIO.run_ (src . sink')                 r <- takeMVar rRef                 atomicModifyIORef' sumRef $ \ x -> (x + sum r, ()) @@ -56,16 +55,16 @@     it "TBQueueNode works as expected" $ do         let content = [1..1000] -        (sink, src) <- newTBQueueNode 2 10+        (sink, src) <- BIO.newTBQueuePair 2 10         sumRef <- newIORef 0          let producter = do                 src' <- sourceListWithDelay content-                runBIO_ (src' . sink)+                BIO.run_ (src' . sink)          let consumer =  do-                (rRef, sink') <- sinkToList-                runBIO_ (src . sink')+                (rRef, sink') <- BIO.sinkToList+                BIO.run_ (src . sink')                 r <- takeMVar rRef                 atomicModifyIORef' sumRef $ \ x -> (x + sum r, ()) @@ -83,17 +82,17 @@     it "TChanNode works as expected" $ do         let content = [1..1000] -        (sink, srcf) <- newBroadcastTChanNode 2+        (sink, srcf) <- BIO.newBroadcastTChanPair 2         sumRef <- newIORef 0          let producter = do                 src' <- sourceListWithDelay content-                runBIO_ (src' . sink)+                BIO.run_ (src' . sink)          let consumer =  do-                (rRef, sink') <- sinkToList+                (rRef, sink') <- BIO.sinkToList                 src <- srcf-                runBIO_ (src . sink')+                BIO.run_ (src . sink')                 r <- takeMVar rRef                 atomicModifyIORef' sumRef $ \ x -> (x + sum r, ()) @@ -109,7 +108,7 @@         s @?= (sum content * 2 * 3)  -sourceListWithDelay :: [Int] -> IO (Source Int)+sourceListWithDelay :: [Int] -> IO (BIO.Source Int) sourceListWithDelay xs = do     return $ \ k _ -> do         forM_ xs $ \ x -> do

@@ -9,6 +9,7 @@ import           Data.ByteString.Lazy  as BL import           Z.Data.Vector         as V import           Z.IO.BIO.Zlib+import           Z.IO.BIO import           Z.IO import           Test.QuickCheck import           Test.QuickCheck.Function

@@ -1,45 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Z.IO.BIOSpec where--import           Control.Concurrent-import           Control.Monad-import qualified Codec.Compression.Zlib as TheZlib-import           Data.IORef-import qualified Z.Data.Vector         as V-import           Z.IO.BIO.Zlib-import           Z.IO-import           Test.QuickCheck-import           Test.QuickCheck.Function-import           Test.QuickCheck.Property-import           Test.Hspec-import           Test.Hspec.QuickCheck-import           Test.HUnit-import           System.IO.Unsafe---spec :: Spec-spec = describe "BIO" . modifyMaxSize (*10) $ do--    describe "decode . encode === id(Base64)" $-        prop "Base64" $ \ xs ->-            let r = unsafePerformIO $ do-                    let src = sourceFromList xs-                    (rRef, sink) <- sinkToList-                    enc <- newBase64Encoder-                    dec <- newBase64Decoder-                    runBIO $ src . enc . dec . sink-                    takeMVar rRef-            in V.concat r === V.concat xs--    describe "decode . encode === id(Hex)" $ do-        prop "Hex" $ \ xs upper ->-            let r = unsafePerformIO $ do-                    let src = sourceFromList xs-                    (rRef, sink) <- sinkToList-                    let enc = hexEncoder upper-                    dec <- newHexDecoder-                    runBIO $ src . enc . dec . sink-                    takeMVar rRef-            in V.concat r === V.concat xs-

@@ -3,7 +3,7 @@ import           Control.Concurrent import           Control.Monad import           Control.Monad.IO.Class-import           Z.Data.PrimRef.PrimIORef+import           Z.Data.PrimRef import           Z.IO.LowResTimer import           Test.Hspec import           Test.HUnit@@ -22,7 +22,7 @@         assertEqual "timer manager should start" True running          threadDelay 2000000 -- make sure all timers are fired-        c' <- readPrimIORef c+        c' <- readPrimRef c         assertEqual "timers registration counter" 100000 c'          threadDelay 100000  -- another 0.1s@@ -38,7 +38,7 @@             throttledAdd             threadDelay 100000         threadDelay 10000000  -- wait 10s here-        c' <- readPrimIORef c+        c' <- readPrimRef c         assertBool ("throttled add " ++ show c') (5  <= c' && c' <= 8)    -- on osx CI threadDelay drift too much      it "throttleTrailing" $ do@@ -48,5 +48,5 @@             throttledAdd             threadDelay 100000         threadDelay 10000000  -- wait 10s here-        c' <- readPrimIORef c+        c' <- readPrimRef c         assertBool ("throttled add " ++ show c') (5  <= c' && c' <= 8)    -- on osx CI threadDelay drift too muc

@@ -6,8 +6,8 @@ import           Control.Monad import           Data.Bits import           Data.IORef-import           Z.Data.Vector         as V-import           Z.Data.Vector.Base    as V+import qualified Z.Data.Vector         as V+import qualified Z.Data.Vector.Base    as V import           Data.List               as List import           Foreign.Marshal.Array import           Foreign.Ptr

@@ -5,7 +5,7 @@ import           Control.Concurrent import           Control.Exception import           Control.Monad-import           Z.Data.PrimRef.PrimIORef+import           Z.Data.PrimRef import           Z.IO.Resource          as R import           Test.Hspec import           Test.HUnit@@ -30,20 +30,20 @@              threadDelay 1000000 -            r <- readPrimIORef resCounter+            r <- readPrimRef resCounter             assertEqual "pool should keep returned resources alive" 100 r              threadDelay 5000000  -- after 5s, 200 thread should release all resources -            w <- readPrimIORef workerCounter+            w <- readPrimRef workerCounter             assertEqual "worker should be able to get resource" 200 w -            r <- readPrimIORef resCounter+            r <- readPrimRef resCounter             assertEqual "pool should reap unused resources" 0 r              -- Let's test again -            writePrimIORef workerCounter 0+            writePrimRef workerCounter 0              forM_ [1..200] $ \ k -> forkIO. R.withSimplePool pool $ \ i -> do                 atomicAddCounter_ workerCounter 1@@ -51,15 +51,15 @@              threadDelay 1000000 -            r <- readPrimIORef resCounter+            r <- readPrimRef resCounter             assertEqual "pool should keep returned resources alive" 100 r              threadDelay 5000000 -            w <- readPrimIORef workerCounter+            w <- readPrimRef workerCounter             assertEqual "worker should be able to get resource" 200 w -            r <- readPrimIORef resCounter+            r <- readPrimRef resCounter             assertEqual "pool should reap unused resources" 0 r      it "resource pool under exceptions" $ do@@ -77,5 +77,5 @@              threadDelay 5000000 -            r <- readPrimIORef resCounter+            r <- readPrimRef resCounter             assertEqual "pool should reap unused resources" 0 r