Z-IO 0.1.9.0 → 0.2.0.0
raw patch · 19 files changed
+492/−378 lines, 19 filesdep ~Z-DataPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: Z-Data
API changes (from Hackage documentation)
- Z.IO.LowResTimer: TimeOutException :: ThreadId -> CallStack -> TimeOutException
- Z.IO.LowResTimer: data TimeOutException
+ Z.IO.BIO: BIOException :: e -> BIOException
+ Z.IO.BIO: JSONConvertException :: ConvertError -> CallStack -> JSONConvertException
+ Z.IO.BIO: data BIOException
+ Z.IO.BIO: data JSONConvertException
+ Z.IO.BIO: instance GHC.Exception.Type.Exception Z.IO.BIO.BIOException
+ Z.IO.BIO: instance GHC.Exception.Type.Exception Z.IO.BIO.JSONConvertException
+ Z.IO.BIO: instance GHC.Show.Show Z.IO.BIO.BIOException
+ Z.IO.BIO: instance GHC.Show.Show Z.IO.BIO.JSONConvertException
+ Z.IO.BIO: sourceJSONFromBuffered :: forall a. FromValue a => BufferedInput -> Source a
+ Z.IO.BIO: sourceJSONFromInput :: (Input i, FromValue a) => i -> IO (Source a)
+ Z.IO.BIO: sourceParsedBufferInput :: Parser a -> BufferedInput -> Source a
- Z.IO.BIO: sourceParsedInput :: Input i => i -> Parser a -> IO (Source a)
+ Z.IO.BIO: sourceParsedInput :: Input i => Parser a -> i -> IO (Source a)
- Z.IO.FileSystem.FilePath: relative :: CBytes -> CBytes -> IO CBytes
+ Z.IO.FileSystem.FilePath: relative :: HasCallStack => CBytes -> CBytes -> IO CBytes
Files
- ChangeLog.md +11/−3
- README.md +12/−8
- Z-IO.cabal +3/−3
- Z/IO/BIO.hs +193/−135
- Z/IO/BIO/Zlib.hsc +6/−7
- Z/IO/Buffered.hs +4/−3
- Z/IO/Exception.hs +12/−13
- Z/IO/FileSystem/FilePath.hsc +12/−4
- Z/IO/FileSystem/Watch.hs +1/−1
- Z/IO/Logger.hs +1/−1
- Z/IO/LowResTimer.hs +43/−38
- Z/IO/Network/TCP.hs +1/−1
- Z/IO/Process.hsc +21/−21
- test/Z/IO/LowResTimerSpec.hs +6/−6
- test/Z/IO/Network/TCPSpec.hs +1/−1
- test/Z/IO/Network/UDPSpec.hs +3/−3
- test/Z/IO/ResourceSpec.hs +17/−21
- third_party/cwalk/include/cwalk.h +139/−108
- third_party/cwalk/src/cwalk.c +6/−1
ChangeLog.md view
@@ -1,7 +1,15 @@ # Revision history for Z-IO -## 0.1.9.0 -- 2020-10-24 +## 0.2.0.0 -- 2020-12-16++* Add `sourceParsedBufferInput` and JSON sources to `Z.IO.BIO`.+* Fix `readLine` and `newLineSplitter`.+* Improve low resolution timer precision.+* Fix a bug in `Z.IO.FileSystem.FilePath.relative`, see [#17](https://github.com/likle/cwalk/issues/17).++## 0.1.9.0 -- 2020-11-23+ * Clean up API in `Z.IO.Buffered`, remove `readToMagic'`, `readLine'`, `readExactly'`. * `readExactly` now throw exception when not reading enough bytes before EOF. * Add `Show/ShowT` instance to `UVStream`, `StdStream`, `UDP`, `UVManager`.@@ -9,11 +17,11 @@ * Rename `InetAddr` to `IPv4`, `Inet6Addr` to `IPv6`, change `SocketAddr` 's constructor name, and payload order. * Add `seek` to `Z.IO.FileSystem`. -## 0.1.8.1 -- 2020-10-24+## 0.1.8.1 -- 2020-11-21 * Export `ZStream` type from `Z.IO.BIO.Zlib` -## 0.1.8.0 -- 2020-10-24+## 0.1.8.0 -- 2020-11-20 * Remove type index from `BufferedInput`, `BufferedOutput`. * Add `Z.IO.BIO` module to facilitate streaming process, and `Z.IO.BIO.Concurrent` to facilitate producer-consumer model.
README.md view
@@ -1,6 +1,10 @@ ## Z-IO -[](https://hackage.haskell.org/package/Z-IO) [](https://github.com/haskell-Z/z-io/actions) [](https://github.com/haskell-Z/z-io/actions) [](https://github.com/haskell-Z/z-io/actions)+[](https://hackage.haskell.org/package/Z-IO)+[](https://github.com/haskell-Z/z-io/actions)+[](https://github.com/haskell-Z/z-io/actions)+[](https://github.com/haskell-Z/z-io/actions)+[](https://github.com/haskell-Z/z-io/actions) This package is part of [Z](https://github.com/haskell-Z/Z) project, provides basic IO operations: @@ -21,11 +25,11 @@ ## Example usage ```haskell-> :set -XOverloadedStrings +> :set -XOverloadedStrings > import Z.IO.Network > import Z.IO.Resource > import Z.IO.Buffered-> +> > -- call getAddrInfo to perform DNS > head <$> getAddrInfo Nothing "www.bing.com" "http" AddrInfo {addrFlags = [AI_ADDRCONFIG,AI_V4MAPPED], addrFamily = SocketFamily 2, addrSocketType = SocketType 1, addrProtocol = ProtocolNumber 6, addrAddress = 204.79.197.200:80, addrCanonName = }@@ -35,7 +39,7 @@ > :{ let addr = ipv4 "13.107.21.200" 80 in withResource (initTCPClient defaultTCPClientConfig{ tcpRemoteAddr = addr}) $ \ tcp -> do- i <- newBufferedInput tcp + i <- newBufferedInput tcp o <- newBufferedOutput tcp writeBuffer o "GET http://www.bing.com HTTP/1.1\r\nHost: www.bing.com\r\n\r\n" flushBuffer o@@ -45,9 +49,9 @@ > > -- Start a TCP echo server, use @nc -v localhost 8080@ to test > :{-startTCPServer defaultTCPServerConfig{ +startTCPServer defaultTCPServerConfig{ tcpListenAddr = SocketAddrIPv4 ipv4Loopback 8080} $ \ tcp -> do- i <- newBufferedInput tcp + i <- newBufferedInput tcp o <- newBufferedOutput tcp forever $ readBuffer i >>= writeBuffer o >> flushBuffer o }@@ -58,13 +62,13 @@ ```bash # get code-git clone --recursive git@github.com:haskell-Z/z-io.git +git clone --recursive git@github.com:haskell-Z/z-io.git cd z-io # build cabal build # test cabal run Z-IO-Test-# install +# install cabal install # generate document cabal haddock
Z-IO.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: Z-IO-version: 0.1.9.0+version: 0.2.0.0 synopsis: Simple and high performance IO toolkit for Haskell description: Simple and high performance IO toolkit for Haskell, including file system, network, ipc and more!@@ -128,7 +128,7 @@ , unix-time >= 0.4.7 && < 0.5 , unordered-containers == 0.2.* , containers == 0.6.*- , Z-Data >= 0.1.9.1 && < 0.2.0+ , Z-Data >= 0.2.0 && < 0.3 default-language: Haskell2010 default-extensions: BangPatterns@@ -357,7 +357,7 @@ main-is: Spec.hs hs-source-dirs: test/ build-depends: base- , Z-IO+ , Z-IO , Z-Data , hspec >= 2.5.4 , hashable
Z/IO/BIO.hs view
@@ -47,37 +47,38 @@ module Z.IO.BIO ( -- * The BIO type BIO(..), Source, Sink+ , BIOException(..), ParseException(..), JSONConvertException(..)+ -- ** Basic combinators , (>|>), (>~>), (>!>), appendSource , concatSource, zipSource, zipBIO , joinSink, fuseSink- , pureBIO, ioBIO- , ParseException(..) -- * Run BIO chain , runBIO , runSource, runSource_ , runBlock, runBlock_, unsafeRunBlock , runBlocks, runBlocks_, unsafeRunBlocks -- * Make new BIO+ , pureBIO, ioBIO+ -- ** Source , sourceFromList+ , sourceFromFile+ , sourceFromBuffered, sourceFromInput+ , sourceTextFromBuffered, sourceTextFromInput+ , sourceJSONFromBuffered, sourceJSONFromInput+ , sourceParsedBufferInput, sourceParsedInput+ -- ** Sink , sinkToList- , sourceFromBuffered- , sourceTextFromBuffered , sinkToBuffered , sinkBuilderToBuffered- -- * Input & Output BIO adapters- , sourceFromInput- , sourceFromFile- , sourceTextFromInput- , sourceParsedInput , sinkToOutput , sinkToFile , sinkBuilderToOutput , sinkToIO- -- * Bytes specific+ -- ** Bytes specific , newParserNode, newReChunk, newUTF8Decoder, newMagicSplitter, newLineSplitter , newBase64Encoder, newBase64Decoder , hexEncoder, newHexDecoder- -- * Generic BIO+ -- ** Generic BIO , newCounterNode , newSeqNumNode , newGroupingNode@@ -85,28 +86,31 @@ import Control.Monad import Control.Monad.IO.Class+import Data.Bits ((.|.)) import Data.IORef-import qualified Data.List as List+import qualified Data.List as List+import Data.Sequence (Seq (..))+import qualified Data.Sequence as Seq+import Data.Typeable (cast) import Data.Void import Data.Word-import Data.Bits ((.|.))-import qualified Data.Sequence as Seq-import Data.Sequence (Seq(..))-import System.IO.Unsafe (unsafePerformIO)-import qualified Z.Data.Array as A-import qualified Z.Data.Builder as B-import qualified Z.Data.Parser as P-import Z.Data.CBytes (CBytes)+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.JSON.Value 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 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 as FS+import qualified Z.IO.FileSystem as FS import Z.IO.Resource -- | A 'BIO'(blocked IO) node.@@ -144,13 +148,15 @@ -- ^ Push a block of input, perform some effect, and return output, -- if input is not enough to produce any output yet, return 'Nothing'. , pull :: HasCallStack => IO (Maybe out)- -- ^ When input reaches EOF, there may be a finalize stage to output trailing output blocks.- -- return 'Nothing' to indicate current node reaches EOF too.+ -- ^ When input reaches EOF, there may be a finalize stage to output+ -- trailing output blocks. return 'Nothing' to indicate current node+ -- reaches EOF too. } -- | Type alias for 'BIO' node which never takes input. ----- 'push' is not available by type system, and 'pull' return 'Nothing' when reaches EOF.+-- 'push' is not available by type system, and 'pull' return 'Nothing' when+-- reaches EOF. type Source out = BIO Void out -- | Type alias for 'BIO' node which only takes input and perform effects.@@ -169,6 +175,44 @@ r <- pull return $! fmap f r +-- | Exception when run BIO failed.+--+-- Note this exception is a sub-type of 'SomeIOException'.+data BIOException = forall e. Exception e => BIOException e++instance Show BIOException where+ show (BIOException e) = show e++instance Exception BIOException where+ toException = ioExceptionToException+ fromException = ioExceptionFromException++bioExceptionToException :: Exception e => e -> SomeException+bioExceptionToException = toException . BIOException++bioExceptionFromException :: Exception e => SomeException -> Maybe e+bioExceptionFromException x = do+ BIOException a <- fromException x+ cast a++-- | Exception when BIO parse failed, this exception is one of a particular+-- 'BIOException'.+data ParseException = ParseException P.ParseError CallStack+ deriving Show++instance Exception ParseException where+ toException = bioExceptionToException+ fromException = bioExceptionFromException++-- | Exception when BIO convert to json failed, this exception is one of a+-- particular 'BIOException'.+data JSONConvertException = JSONConvertException JSON.ConvertError CallStack+ deriving Show++instance Exception JSONConvertException where+ toException = bioExceptionToException+ fromException = bioExceptionFromException+ infixl 3 >|> infixl 3 >~> @@ -187,7 +231,7 @@ Just x' -> do y <- pushB x' case y of Nothing -> pull_ -- draw input from A until there's an output from B- _ -> return y+ _ -> return y _ -> pullB -- | Flipped 'fmap' for easier chaining.@@ -207,19 +251,6 @@ case r of Just r' -> Just <$!> f r' _ -> return Nothing --- | 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-pureBIO f = BIO (\ x -> let !r = f x in return (Just r)) (return Nothing)---- | 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-ioBIO f = BIO (\ x -> Just <$!> f x) (return Nothing)- -- | Connect two 'BIO' source, after first reach EOF, draw element from second. appendSource :: Source a -> Source a -> IO (Source a) {-# INLINE appendSource #-}@@ -254,9 +285,8 @@ (s:rest) -> do r <- pull s case r of- Just _ -> return r- _ -> writeIORef ref rest >> loop ref-+ Just _ -> return r+ _ -> writeIORef ref rest >> loop ref -- | Zip two 'BIO' source into one, reach EOF when either one reached EOF. zipSource :: Source a -> Source b -> IO (Source (a,b))@@ -273,7 +303,7 @@ let r = (,) <$> mA <*> mB case r of Just _ -> return r- _ -> writeIORef finRef True >> return Nothing+ _ -> writeIORef finRef True >> return Nothing } -- | Zip two 'BIO' node into one, reach EOF when either one reached EOF.@@ -311,15 +341,17 @@ aSeq <- readIORef aSeqRef bSeq <- readIORef bSeqRef ma <- case aSeq of (_ :|> a) -> return (Just a)- _ -> pullA+ _ -> pullA mb <- case bSeq of (_ :|> b) -> return (Just b)- _ -> pullB+ _ -> pullB case ma of Just a -> case mb of Just b -> return (Just (a, b))- _ -> writeIORef finRef True >> return Nothing+ _ -> writeIORef finRef True >> return Nothing _ -> writeIORef finRef True >> return Nothing +-------------------------------------------------------------------------------+-- Run BIO -- | Run a 'BIO' loop (source >|> ... >|> sink). runBIO :: BIO Void Void -> IO ()@@ -344,7 +376,7 @@ loop f = do r <- f case r of Just _ -> loop f- _ -> return ()+ _ -> return () -- | Supply a single block of input, then run BIO node until EOF. --@@ -354,7 +386,7 @@ runBlock BIO{..} inp = do x <- push inp let acc = case x of Just x' -> [x']- _ -> []+ _ -> [] loop pull acc where loop f acc = do@@ -362,7 +394,6 @@ case r of Just r' -> loop f (r':acc) _ -> return (List.reverse acc) - -- | Supply a single block of input, then run BIO node until EOF with collecting result. -- -- Note many 'BIO' node will be closed or not be able to take new input after drained.@@ -396,13 +427,13 @@ r <- push inp case r of Just r' -> loop (r':acc) inps- _ -> loop acc inps+ _ -> loop acc inps loop acc [] = loop' acc loop' acc = do r <- pull case r of Just r' -> loop' (r':acc)- _ -> return (List.reverse acc)+ _ -> return (List.reverse acc) -- | Supply blocks of input, then run BIO node until EOF with collecting result. --@@ -416,7 +447,7 @@ r <- pull bio case r of Just _ -> loop- _ -> return ()+ _ -> return () -- | Wrap a stream computation into a pure interface. --@@ -425,9 +456,96 @@ {-# INLINABLE unsafeRunBlocks #-} unsafeRunBlocks new inps = unsafePerformIO (new >>= \ bio -> runBlocks bio inps) +-------------------------------------------------------------------------------+-- Source++-- | Source a list from memory.+--+sourceFromList :: [a] -> IO (Source a)+sourceFromList xs0 = do+ xsRef <- newIORef xs0+ return BIO{ pull = popper xsRef }+ where+ popper xsRef = do+ xs <- readIORef xsRef+ case xs of+ (x:xs') -> do+ writeIORef xsRef xs'+ return (Just x)+ _ -> return Nothing++-- | Turn a 'BufferedInput' into 'BIO' source, map EOF to Nothing.+--+sourceFromBuffered :: BufferedInput -> Source V.Bytes+{-# INLINABLE sourceFromBuffered #-}+sourceFromBuffered i = BIO{ pull = do+ readBuffer i >>= \ x -> if V.null x then return Nothing+ else return (Just x)}++-- | Turn a UTF8 encoded 'BufferedInput' into 'BIO' source, map EOF to Nothing.+--+sourceTextFromBuffered :: BufferedInput -> Source T.Text+{-# INLINABLE sourceTextFromBuffered #-}+sourceTextFromBuffered i = BIO{ pull = do+ readBufferText i >>= \ x -> if T.null x then return Nothing+ else return (Just x)}++-- | Turn a 'JSON' encoded 'BufferedInput' into 'BIO' source, ignoring any+-- whitespaces bewteen JSON objects. If EOF reached, then return Nothing.+sourceJSONFromBuffered :: forall a. JSON.FromValue a => BufferedInput -> Source a+{-# INLINABLE sourceJSONFromBuffered #-}+sourceJSONFromBuffered i = sourceParsedBufferInput JSON.value i >!> convert+ where+ convert :: JSON.Value -> IO a+ convert jval =+ case JSON.convert' jval of+ Left e -> throwIO $ JSONConvertException e callStack+ Right r -> return r++-- | Turn buffered input device into a packet source.+sourceParsedBufferInput :: P.Parser a -> BufferedInput -> Source a+{-# INLINABLE sourceParsedBufferInput #-}+sourceParsedBufferInput p bi = BIO{ pull = do+ bs <- readBuffer bi+ if V.null bs+ then return Nothing+ else do+ (rest, r) <- P.parseChunks p (readBuffer bi) bs+ unReadBuffer rest bi+ case r of Right v -> return (Just v)+ Left e -> throwIO (ParseException e callStack)}++-- | Turn an input device into a 'V.Bytes' source.+sourceFromInput :: Input i => i -> IO (Source V.Bytes)+{-# INLINABLE sourceFromInput #-}+sourceFromInput i = sourceFromBuffered <$> newBufferedInput i++-- | Turn an input device into a 'T.Text' source.+sourceTextFromInput :: Input i => i -> IO (Source T.Text)+{-# INLINABLE sourceTextFromInput #-}+sourceTextFromInput i = sourceTextFromBuffered <$> newBufferedInput i++-- | Turn an input device into a 'JSON' source.+sourceJSONFromInput :: (Input i, JSON.FromValue a) => i -> IO (Source a)+sourceJSONFromInput i = sourceJSONFromBuffered <$> newBufferedInput i+{-# INLINABLE sourceJSONFromInput #-}++-- | Turn a file into a 'V.Bytes' source.+sourceFromFile :: CBytes -> Resource (Source V.Bytes)+{-# INLINABLE sourceFromFile #-}+sourceFromFile p = do+ f <- FS.initFile p FS.O_RDONLY FS.DEFAULT_MODE+ liftIO (sourceFromInput f)++-- | Turn input device into a packet source.+sourceParsedInput :: Input i => P.Parser a -> i -> IO (Source a)+{-# INLINABLE sourceParsedInput #-}+sourceParsedInput p i = sourceParsedBufferInput p <$> newBufferedInput i+ --------------------------------------------------------------------------------+-- Sink+ -- | Turn a 'BufferedOutput' into a 'V.Bytes' sink.--- sinkToBuffered :: BufferedOutput -> Sink V.Bytes {-# INLINABLE sinkToBuffered #-} sinkToBuffered bo = BIO push_ pull_@@ -486,21 +604,6 @@ push_ x = f x >> pure Nothing pull_ = pure Nothing --- | Source a list from memory.----sourceFromList :: [a] -> IO (Source a)-sourceFromList xs0 = do- xsRef <- newIORef xs0- return BIO{ pull = popper xsRef }- where- popper xsRef = do- xs <- readIORef xsRef- case xs of- (x:xs') -> do- writeIORef xsRef xs'- return (Just x)- _ -> return Nothing- -- | Sink to a list in memory. -- -- The list's 'IORef' is not thread safe here,@@ -513,58 +616,21 @@ return (xsRef, BIO (\ x -> modifyIORef xsRef (x:) >> return Nothing) (modifyIORef xsRef reverse >> return Nothing)) --- | Turn a 'BufferedInput' into 'BIO' source, map EOF to Nothing.----sourceFromBuffered :: BufferedInput -> Source V.Bytes-{-# INLINABLE sourceFromBuffered #-}-sourceFromBuffered i = BIO{ pull = do- readBuffer i >>= \ x -> if V.null x then return Nothing- else return (Just x)}+--------------------------------------------------------------------------------+-- Nodes --- | Turn a UTF8 encoded 'BufferedInput' into 'BIO' source, map EOF to Nothing.+-- | BIO node from a pure function. ---sourceTextFromBuffered :: BufferedInput -> Source T.Text-{-# INLINABLE sourceTextFromBuffered #-}-sourceTextFromBuffered i = BIO{ pull = do- readBufferText i >>= \ x -> if T.null x then return Nothing- else return (Just x)}---- | Turn an input device into a 'V.Bytes' source.-sourceFromInput :: Input i => i -> IO (Source V.Bytes)-{-# INLINABLE sourceFromInput #-}-sourceFromInput i =- newBufferedInput i >>= return . sourceFromBuffered---- | Turn a file into a 'V.Bytes' source.-sourceFromFile :: CBytes -> Resource (Source V.Bytes)-{-# INLINABLE sourceFromFile #-}-sourceFromFile p = do- f <- FS.initFile p FS.O_RDONLY FS.DEFAULT_MODE- liftIO (sourceFromInput f)---- | Turn an input device into a 'T.Text' source.-sourceTextFromInput :: Input i => i -> IO (Source T.Text)-{-# INLINABLE sourceTextFromInput #-}-sourceTextFromInput i =- newBufferedInput i >>= return . sourceTextFromBuffered---- | Turn input device into a packet source, see 'sourceParsedInput''.-sourceParsedInput :: Input i => i -> P.Parser a -> IO (Source a)-{-# INLINABLE sourceParsedInput #-}-sourceParsedInput i p =- newBufferedInput i >>= return . loopParse- where- loopParse bi = BIO{ pull = do- bs <- readBuffer bi- if V.null bs- then return Nothing- else do- (rest, r) <- P.parseChunks p (readBuffer bi) bs- unReadBuffer rest bi- case r of Right v -> return (Just v)- Left e -> throwIO (ParseException e callStack)}+-- BIO node made with this funtion are stateless, thus can be reused across chains.+pureBIO :: (a -> b) -> BIO a b+pureBIO f = BIO (\ x -> let !r = f x in return (Just r)) (return Nothing) ---------------------------------------------------------------------------------+-- | 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+ioBIO f = BIO (\ x -> Just <$!> f x) (return Nothing) -- | Make a chunk size divider. --@@ -598,21 +664,13 @@ writeIORef trailingRef V.empty return (Just trailing) ---- | Exception when parsing failed in streams.------ Note this exception is a sub-type of 'SomeIOException'.-data ParseException = ParseException P.ParseError CallStack deriving Show-instance Exception ParseException where- toException = ioExceptionToException- fromException = ioExceptionFromException- -- | Read buffer and parse with 'Parser'. ----- This function will continuously draw data from input before parsing finish. Unconsumed--- bytes will be returned to buffer.+-- This function will continuously draw data from input before parsing finish.+-- Unconsumed bytes will be returned to buffer. ----- Return 'Nothing' if reach EOF before parsing, throw 'ParseException' if parsing fail.+-- Return 'Nothing' if reach EOF before parsing, throw 'ParseException' if+-- parsing fail. newParserNode :: P.Parser a -> IO (BIO V.Bytes a) {-# INLINABLE newParserNode #-} newParserNode p = do@@ -624,7 +682,7 @@ lastResult <- readIORef resultRef let (chunk, f) = case lastResult of Left trailing -> (trailing `V.append` bs, P.parseChunk p)- Right x -> (bs, x)+ Right x -> (bs, x) case f chunk of P.Success a trailing' -> do writeIORef resultRef (Left trailing')@@ -735,9 +793,10 @@ where dropLineEnd bs@(V.PrimVector arr s l) = case bs `V.indexMaybe` (l-2) of- Nothing -> V.PrimVector arr s (l-1) 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)@@ -832,4 +891,3 @@ return . Just =<< A.unsafeFreezeArr marr' #endif else return Nothing-
Z/IO/BIO/Zlib.hsc view
@@ -47,17 +47,16 @@ import Control.Monad import Data.IORef-import Data.Typeable-import Data.Word import qualified Data.List as List+import Data.Word import Foreign hiding (void) import Foreign.C import GHC.Generics import Z.Data.Array as A import Z.Data.CBytes as CBytes-import Z.Data.Vector.Base as V+import Z.Data.JSON (EncodeJSON, FromValue, ToValue) import Z.Data.Text.ShowT (ShowT)-import Z.Data.JSON (EncodeJSON, ToValue, FromValue)+import Z.Data.Vector.Base as V import Z.Foreign import Z.IO.BIO import Z.IO.Exception@@ -164,7 +163,7 @@ zflush finRef zs bufRef acc = do fin <- readIORef finRef- if fin + if fin then return Nothing else do buf <- readIORef bufRef@@ -182,7 +181,7 @@ else do oarr <- A.unsafeFreezeArr buf let trailing = V.concat . List.reverse $ V.PrimVector oarr 0 osiz : acc- -- stream ends + -- stream ends writeIORef finRef True if V.null trailing then return Nothing else return (Just trailing) @@ -312,7 +311,7 @@ toZErrorMsg _ = "Z_UNEXPECTED" -- | Zlib exceptions, a sub exception type to 'SomeIOException'.-data ZlibException = ZlibException CBytes CallStack deriving (Show, Typeable)+data ZlibException = ZlibException CBytes CallStack deriving Show instance Exception ZlibException where toException = ioExceptionToException fromException = ioExceptionFromException
Z/IO/Buffered.hs view
@@ -223,7 +223,7 @@ return (T.validate (V.fromArr arr s i)) else return (T.validate bs) --- | Read N bytes(may be smaller than N if EOF reached).+-- | Read exactly N bytes. -- -- If EOF reached before N bytes read, a 'IncompleteInput' will be thrown readExactly :: HasCallStack => Int -> BufferedInput -> IO V.Bytes@@ -245,7 +245,7 @@ chunks <- go h (n - l) return (chunk : chunks) --- | Read all chunks from a 'BufferedInput'.+-- | Read all chunks from a 'BufferedInput' until EOF. -- -- This function will loop read until meet EOF('Input' device return 'V.empty'), -- Useful for reading small file into memory.@@ -337,9 +337,10 @@ if l == 0 then return Nothing else return $ case bs `V.indexMaybe` (l-2) of- Nothing -> Just (V.PrimVector arr s (l-1)) Just r | r == 13 -> Just (V.PrimVector arr s (l-2)) | otherwise -> Just (V.PrimVector arr s (l-1))+ _ | V.head bs == 10 -> Just (V.PrimVector arr s (l-1))+ | otherwise -> Just (V.PrimVector arr s l) --------------------------------------------------------------------------------
Z/IO/Exception.hs view
@@ -21,7 +21,7 @@ Example for library author defining new io exception: @- data MyNetworkException = MyNetworkException IOEInfo ... deriving (Show, Typeable)+ data MyNetworkException = MyNetworkException IOEInfo ... deriving Show instance Exception MyNetworkException where toException = ioExceptionToException fromException = ioExceptionFromException@@ -72,22 +72,21 @@ , module Z.IO.UV.Errno ) where -import Control.Exception hiding (IOException)-import Control.Monad-import Control.Concurrent.STM-import Data.Typeable-import Foreign.Ptr-import Foreign.C.Types-import GHC.Stack-import Z.IO.UV.Errno-import qualified Z.Data.Text as T-import qualified Z.Data.Text.ShowT as T+import Control.Concurrent.STM+import Control.Exception hiding (IOException)+import Control.Monad+import Data.Typeable (cast)+import Foreign.C.Types+import Foreign.Ptr+import GHC.Stack+import qualified Z.Data.Text as T+import qualified Z.Data.Text.ShowT as T+import Z.IO.UV.Errno -- | The root type of all io exceptions, you can catch all io exception by catching this root type. -- data SomeIOException = forall e . Exception e => SomeIOException e- deriving Typeable instance Show SomeIOException where show (SomeIOException e) = show e@@ -102,7 +101,7 @@ SomeIOException a <- fromException x cast a -#define IOE(e) data e = e IOEInfo deriving (Show, Typeable); \+#define IOE(e) data e = e IOEInfo deriving (Show); \ instance Exception e where \ { toException = ioExceptionToException \ ; fromException = ioExceptionFromException \
Z/IO/FileSystem/FilePath.hsc view
@@ -36,8 +36,9 @@ , getSearchPath ) where -+import Control.Monad hiding (join) import Data.Word+import Data.Bits import qualified Data.List as List import GHC.Generics import Z.Data.CBytes (CBytes(CB), allocCBytesUnsafe, withCBytesUnsafe, withCBytesListUnsafe)@@ -48,6 +49,7 @@ import qualified Z.Data.Vector as V import Z.Foreign import Z.IO.Environment (getEnv')+import Z.IO.Exception import Prelude hiding (concat) #include "hs_cwalk.h"@@ -496,6 +498,9 @@ -- -- This function generates a relative path based on a base path and another path. -- It determines how to get to the submitted path, starting from the base directory.+-- +-- Note the two arguments must be both absolute or both relative, otherwise an 'InvalidArgument' +-- will be thrown. -- -- +---------+--------------------------+--------------------------+-----------------+ -- | Style | Base | Path | Result |@@ -523,15 +528,18 @@ -- | WINDOWS | C:\/path\/same | D:\/path\/same | "" | -- +---------+--------------------------+--------------------------+-----------------+ ---relative :: CBytes -- ^ The base path from which the relative path will start.+relative :: HasCallStack+ => CBytes -- ^ The base path from which the relative path will start. -> CBytes -- ^ The target path where the relative path will point to. -> IO CBytes relative p p2 = do- let l = CB.length p + CB.length p2 + (#const BUF_EXT_SIZ)- (p', _) <- withCBytesUnsafe p $ \ pp ->+ let l = (CB.length p `unsafeShiftL` 1) + CB.length p2 + (#const BUF_EXT_SIZ)+ (p', r) <- withCBytesUnsafe p $ \ pp -> withCBytesUnsafe p2 $ \ pp2 -> allocCBytesUnsafe l $ \ pbuf -> cwk_path_get_relative pp pp2 pbuf (fromIntegral l)+ when (r == 0) $+ throwIO (InvalidArgument (IOEInfo "EINVAL" "file path types are different" callStack)) return p' -- | Split the extension of a file path.
Z/IO/FileSystem/Watch.hs view
@@ -12,7 +12,7 @@ @ -- start watching threads, use returned close function to cleanup watching threads.-(close, srcf) <- watchDir "fold_to_be_watch"+(close, srcf) <- watchDirs ["fold_to_be_watch"] -- dup a file event source src <- srcf -- print event to stdout
Z/IO/Logger.hs view
@@ -184,7 +184,7 @@ -> B.Builder () -- ^ formatted log -> IO () pushLogIORef logsRef loggerLineBufSize b = do- let !bs = B.buildBytesWith loggerLineBufSize b+ let !bs = B.buildWith loggerLineBufSize b unless (V.null bs) $ atomicModifyIORef' logsRef (\ bss -> (bs:bss, ())) flushLogIORef :: HasCallStack => MVar BufferedOutput -> IORef [V.Bytes] -> IO ()
Z/IO/LowResTimer.hs view
@@ -1,21 +1,17 @@ {-| Module : Z.IO.LowResTimer-Description : Low resolution (decisecond) timing wheel+Description : Low resolution (0.1s) timing wheel Copyright : (c) Dong Han, 2017-2018 License : BSD Maintainer : winterland1989@gmail.com Stability : experimental Portability : non-portable--This module provide low resolution (decisecond, i.e. 0.1s) timers using a timing wheel of size 128 per capability,+This module provide low resolution (0.1s) timers using a timing wheel of size 128 per capability, each timer thread will automatically started or stopped based on demannd. register or cancel a timeout is O(1),-and each step only need scan n\/128 items given timers are registered in an even fashion.-+and each step only need scan n/128 items given timers are registered in an even fashion. This timer is particularly suitable for high concurrent approximated IO timeout scheduling. You should not rely on it to provide timing information since it's very inaccurate.- Reference:- * <https://github.com/netty/netty/blob/4.1/common/src/main/java/io/netty/util/HashedWheelTimer.java> * <http://www.cse.wustl.edu/~cdgill/courses/cs6874/TimingWheels.ppt> -}@@ -35,7 +31,6 @@ , throttle , throttle_ , throttleTrailing_- , TimeOutException(..) -- * low resolution timer manager , LowResTimerManager , getLowResTimerManager@@ -44,6 +39,7 @@ ) where import Z.Data.Array+import Data.Word #ifndef mingw32_HOST_OS import GHC.Event #endif@@ -54,6 +50,7 @@ import System.IO.Unsafe import Z.Data.PrimRef.PrimIORef import Z.IO.Exception+import Z.IO.UV.FFI (uv_hrtime) -- queueSize :: Int@@ -64,11 +61,14 @@ data TimerList = TimerItem {-# UNPACK #-} !Counter (IO ()) TimerList | TimerNil data LowResTimerManager = LowResTimerManager- { lrTimerQueue :: Array (IORef TimerList)- , lrIndexLock :: MVar Int- , lrRegisterCount :: Counter- , lrRunningLock :: MVar Bool- }+ (Array (IORef TimerList))+ -- timer queue+ (MVar Int)+ -- current time wheel's index+ Counter+ -- registered counter, stop timer thread if go downs to zero+ (MVar Bool)+ -- running lock newLowResTimerManager :: IO LowResTimerManager newLowResTimerManager = do@@ -141,7 +141,7 @@ -- registerLowResTimer 100 (forkIO $ killThread tid) -- @ ---registerLowResTimer :: Int -- ^ timeout in unit of decisecond(0.1s)+registerLowResTimer :: Int -- ^ timeout in unit of 0.1s -> IO () -- ^ the action you want to perform, it should not block -> IO LowResTimer registerLowResTimer t action = do@@ -149,7 +149,7 @@ registerLowResTimerOn lrtm t action -- | 'void' ('registerLowResTimer' t action)-registerLowResTimer_ :: Int -- ^ timeout in unit of decisecond(0.1s)+registerLowResTimer_ :: Int -- ^ timeout in unit of 0.1s -> IO () -- ^ the action you want to perform, it should not block -> IO () registerLowResTimer_ t action = void (registerLowResTimer t action)@@ -157,7 +157,7 @@ -- | Same as 'registerLowResTimer', but allow you choose timer manager. -- registerLowResTimerOn :: LowResTimerManager -- ^ a low resolution timer manager- -> Int -- ^ timeout in unit of decisecond(0.1s)+ -> Int -- ^ timeout in unit of 0.1s -> IO () -- ^ the action you want to perform, it should not block -> IO LowResTimer registerLowResTimerOn lrtm@(LowResTimerManager queue indexLock regCounter _) t action = do@@ -205,38 +205,37 @@ -- Note timeoutLowRes is also implemented with 'Exception' underhood, which can have some surprising -- effects on some devices, e.g. use 'timeoutLowRes' with reading or writing on 'UVStream's may close -- the 'UVStream' once a reading or writing is not able to be done in time.-timeoutLowRes :: Int -- ^ timeout in unit of decisecond(0.1s)+timeoutLowRes :: Int -- ^ timeout in unit of 0.1s -> IO a -> IO (Maybe a) timeoutLowRes timeo io = do mid <- myThreadId- bracket- (registerLowResTimer timeo (timeoutAThread mid))- (void . cancelLowResTimer)- (\ _ -> catch (Just <$> io) (\ (_ :: TimeOutException) -> return Nothing))+ catch+ (do timer <- registerLowResTimer timeo (timeoutAThread mid)+ r <- io+ _ <- cancelLowResTimer timer+ return (Just r))+ ( \ (_ :: TimeOutException) -> return Nothing ) where timeoutAThread tid = void . forkIO $ throwTo tid (TimeOutException tid undefined) -- | Similar to 'timeoutLowRes', but raise a 'TimeOutException' to current thread -- instead of return 'Nothing' if timeout. timeoutLowResEx :: HasCallStack- => Int -- ^ timeout in unit of decisecond(0.1s)+ => Int -- ^ timeout in unit of 0.1s -> IO a -> IO a timeoutLowResEx timeo io = do mid <- myThreadId- bracket- (registerLowResTimer timeo (timeoutAThread mid))- (void . cancelLowResTimer)- (\ _ -> io)+ timer <- registerLowResTimer timeo (timeoutAThread mid)+ r <- io+ _ <- cancelLowResTimer timer+ return r where timeoutAThread tid = void . forkIO $ throwTo tid (TimeOutException tid callStack) --- | Exception used to stop a haskell thread when time out, a sub exception type to 'SomeIOException'. data TimeOutException = TimeOutException ThreadId CallStack deriving Show-instance Exception TimeOutException where- toException = ioExceptionToException- fromException = ioExceptionFromException+instance Exception TimeOutException -------------------------------------------------------------------------------- -- | Check if low resolution timer manager loop is running, start loop if not.@@ -245,18 +244,24 @@ ensureLowResTimerManager lrtm@(LowResTimerManager _ _ _ runningLock) = do modifyMVar_ runningLock $ \ running -> do unless running $ do- tid <- forkIO (startLowResTimerManager lrtm)+ t <- uv_hrtime+ tid <- forkIO (startLowResTimerManager lrtm t) labelThread tid "Z-IO: low resolution time manager" -- make sure we can see it in GHC event log return True -- | Start low resolution timer loop, the loop is automatically stopped if there's no more new registrations. ---startLowResTimerManager :: LowResTimerManager ->IO ()-startLowResTimerManager lrtm@(LowResTimerManager _ _ regCounter runningLock) = do+startLowResTimerManager :: LowResTimerManager -> Word64 -> IO ()+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 if c > 0 then do+ t <- uv_hrtime + -- we can't use 100000 as maximum, because that will produce a 0us thread delay+ -- and GHC's registerTimeout will run next startLowResTimerManager directly(on current thread)+ -- but we're still holding runningLock, which cause an deadlock.+ let !deltaT = min (fromIntegral ((t - stdT) `quot` 1000)) 99999 _ <- forkIO (fireLowResTimerQueue lrtm) -- we offload the scanning to another thread to minimize -- the time we holding runningLock case () of@@ -264,11 +269,11 @@ #ifndef mingw32_HOST_OS | rtsSupportsBoundThreads -> do htm <- getSystemTimerManager- void $ registerTimeout htm 100000 (startLowResTimerManager lrtm)+ void $ registerTimeout htm (100000 - deltaT) (startLowResTimerManager lrtm (stdT + 100000000)) #endif | otherwise -> void . forkIO $ do -- we have to fork another thread since we're holding runningLock,- threadDelay 100000 -- this may affect accuracy, but on windows there're no other choices.- startLowResTimerManager lrtm+ threadDelay (100000 - deltaT) -- this may affect accuracy, but on windows there're no other choices.+ startLowResTimerManager lrtm (stdT + 100000000) return True else do return False -- if we haven't got any registered timeout, we stop the time manager@@ -312,7 +317,7 @@ -- One common way to get a shared periodical updated value is to start a seperate thread and do calculation -- periodically, but doing that will stop system from being idle, which stop idle GC from running, -- and in turn disable deadlock detection, which is too bad. This function solves that.-throttle :: Int -- ^ cache time in unit of decisecond(0.1s)+throttle :: Int -- ^ cache time in unit of 0.1s -> IO a -- ^ the original IO action -> IO (IO a) -- ^ throttled IO action throttle t action = do@@ -334,7 +339,7 @@ -- no-ops. -- -- Note the action will run in the calling thread.-throttle_ :: Int -- ^ cache time in unit of decisecond(0.1s)+throttle_ :: Int -- ^ cache time in unit of 0.1s -> IO () -- ^ the original IO action -> IO (IO ()) -- ^ throttled IO action throttle_ t action = do
Z/IO/Network/TCP.hs view
@@ -98,7 +98,7 @@ } deriving (Eq, Ord, Show, Generic) deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) --- | A default hello world server on localhost:8888+-- | A default hello world server on 0.0.0.0:8888 -- -- Test it with @main = startTCPServer defaultTCPServerConfig helloWorldWorker@ or -- @main = startTCPServer defaultTCPServerConfig echoWorker@, now try @nc -v 127.0.0.1 8888@
Z/IO/Process.hsc view
@@ -21,7 +21,7 @@ module Z.IO.Process ( initProcess- , readProcess + , readProcess , readProcessText , ProcessOptions(..) , defaultProcessOptions@@ -32,7 +32,7 @@ , getProcessPID , killPID , getPriority, setPriority- -- * internal + -- * internal , spawn -- * Constant -- ** ProcessFlag@@ -45,10 +45,10 @@ , pattern PROCESS_WINDOWS_HIDE_GUI -- ** Signal , Signal- , pattern SIGTERM - , pattern SIGINT + , pattern SIGTERM+ , pattern SIGINT , pattern SIGKILL- , pattern SIGHUP + , pattern SIGHUP -- ** Priority , Priority , pattern PRIORITY_LOW@@ -94,7 +94,7 @@ , processCWD = "." , processFlags = 0 , processUID = UID 0- , processGID = GID 0 + , processGID = GID 0 , processStdStreams = (ProcessIgnore, ProcessIgnore, ProcessIgnore) } @@ -132,16 +132,16 @@ -- | Resource spawn processes. ----- Return a resource spawn processes, when initiated return the @(stdin, stdout, stderr, pstate)@ tuple, +-- Return a resource spawn processes, when initiated return the @(stdin, stdout, stderr, pstate)@ tuple, -- std streams are created when pass 'ProcessCreate' option, otherwise will be 'Nothing', -- @pstate@ will be updated to `ProcessExited` automatically when the process exits.--- --- A cleanup thread will be started when you finish using the process resource, to close any std stream +--+-- A cleanup thread will be started when you finish using the process resource, to close any std stream -- created during spawn. -- -- @ -- initProcess defaultProcessOptions{--- processFile="your program" +-- processFile="your program" -- , processStdStreams = (ProcessCreate, ProcessCreate, ProcessCreate) -- } $ (stdin, stdout, stderr, pstate) -> do -- ... -- read or write from child process's std stream, will clean up automatically@@ -157,15 +157,15 @@ -- | Spawn a processe with given input. -- -- Child process's stdout and stderr output are collected, return with exit code.-readProcess :: HasCallStack +readProcess :: HasCallStack => ProcessOptions -- ^ processStdStreams options are ignored -> V.Bytes -- ^ stdin -> IO (V.Bytes, V.Bytes, ExitCode) -- ^ stdout, stderr, exit code readProcess opts inp = do- withResource (initProcess opts{processStdStreams=(ProcessCreate, ProcessCreate, ProcessCreate)}) + withResource (initProcess opts{processStdStreams=(ProcessCreate, ProcessCreate, ProcessCreate)}) $ \ (Just s0, Just s1, Just s2, pstate) -> do- r1 <- newEmptyMVar - r2 <- newEmptyMVar + r1 <- newEmptyMVar+ r2 <- newEmptyMVar _ <- forkIO $ do withPrimVectorSafe inp (writeOutput s0) closeUVStream s0@@ -174,13 +174,13 @@ readAll' b1 >>= putMVar r1 _ <- forkIO $ do b2 <- newBufferedInput s2- readAll' b2 >>= putMVar r2 + readAll' b2 >>= putMVar r2 (,,) <$> takeMVar r1 <*> takeMVar r2 <*> waitProcessExit pstate -- | Spawn a processe with given UTF8 textual input. -- -- Child process's stdout and stderr output are collected as UTF8 bytes, return with exit code.-readProcessText :: HasCallStack +readProcessText :: HasCallStack => ProcessOptions -- ^ processStdStreams options are ignored -> T.Text -- ^ stdin -> IO (T.Text, T.Text, ExitCode) -- ^ stdout, stderr, exit code@@ -201,7 +201,7 @@ pokeMBA popts## (#offset uv_process_options_t, uid) processUID pokeMBA popts## (#offset uv_process_options_t, gid) processGID - uvm <- getUVManager + uvm <- getUVManager let (s0, s1, s2) = processStdStreams @@ -215,7 +215,7 @@ pokeMBA pstdio## (#offset uv_stdio_container_t, data) (uvsHandle uvs0) return (Just uvs0) _ -> return Nothing- + pokeMBA pstdio## ((#offset uv_stdio_container_t, flags)+(#size uv_stdio_container_t)) (processStdStreamFlag s1) uvs1' <- case s1 of@@ -244,7 +244,7 @@ let mkEnv (k, v) = CBytes.concat [k, "=", v] allEnv = case processEnv of- Just e -> List.map mkEnv e + Just e -> List.map mkEnv e _ -> [] envLen = case processEnv of Just e -> List.length e@@ -264,9 +264,9 @@ ps <- newTVarIO (ProcessRunning (PID (fromIntegral pid))) _ <- forkFinally (takeMVar exitLock) $ \ r -> do- case r of + case r of Left _ -> atomically (writeTVar ps (ProcessExited (ExitFailure (-1))))- Right e -> + Right e -> let e' = if e == 0 then ExitSuccess else ExitFailure e in atomically (writeTVar ps (ProcessExited e'))
test/Z/IO/LowResTimerSpec.hs view
@@ -34,19 +34,19 @@ it "throttle" $ do c <- newCounter 0 throttledAdd <- throttle 10 (atomicAddCounter_ c 1)- forkIO . replicateM_ 100 $ do+ forkIO . replicateM_ 50 $ do throttledAdd- threadDelay 50000+ threadDelay 100000 threadDelay 10000000 -- wait 10s here c' <- readPrimIORef c- assertBool "throttled add" (6 <= c' && c' <= 8) -- on osx CI time drift too much+ assertBool ("throttled add " ++ show c') (5 <= c' && c' <= 8) -- on osx CI threadDelay drift too much it "throttleTrailing" $ do c <- newCounter 0 throttledAdd <- throttleTrailing_ 10 (atomicAddCounter_ c 1)- forkIO . replicateM_ 100 $ do+ forkIO . replicateM_ 50 $ do throttledAdd- threadDelay 50000+ threadDelay 100000 threadDelay 10000000 -- wait 10s here c' <- readPrimIORef c- assertBool "throttled add" (5 <= c' && c' <= 6)+ assertBool ("throttled add " ++ show c') (5 <= c' && c' <= 8) -- on osx CI threadDelay drift too muc
test/Z/IO/Network/TCPSpec.hs view
@@ -28,7 +28,7 @@ threadDelay 2000000 -- 2s - replicateM_ 512 . forkIO $+ replicateM_ 10 . forkIO $ withResource (initTCPClient defaultTCPClientConfig{tcpRemoteAddr = addr}) $ \ tcp -> do i <- newBufferedInput tcp o <- newBufferedOutput tcp
test/Z/IO/Network/UDPSpec.hs view
@@ -50,7 +50,7 @@ let testMsg = V.replicate 4096 48 addr = SocketAddrIPv4 ipv4Loopback 12348 withResource (initUDP defaultUDPConfig) $ \ c ->- withResource (initUDP defaultUDPConfig) $ \ s -> do+ withResource (initUDP defaultUDPConfig) $ \_s -> do sendUDP c addr testMsg `shouldThrow` anyException it "batch receiving(multiple messages)" $ do@@ -60,7 +60,7 @@ forkIO $ withResource (initUDP defaultUDPConfig{udpLocalAddr = Just (addr,UDP_DEFAULT)}) $ \ s -> do recvUDPLoop defaultUDPRecvConfig s $ \ msgs -> modifyIORef msgList (msgs:)- withResource (initUDP defaultUDPConfig) $ \ c -> replicateM_ 100 $ sendUDP c addr testMsg+ withResource (initUDP defaultUDPConfig) $ \c -> replicateM_ 100 $ sendUDP c addr testMsg msgs <- readIORef msgList- True @=? (List.length msgs > 90) -- ^ udp packet may get lost+ True @=? (List.length msgs > 50) -- udp packet may get lost forM_ msgs $ \ (_,_,msg) -> testMsg @=? msg
test/Z/IO/ResourceSpec.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} module Z.IO.ResourceSpec where@@ -7,12 +6,11 @@ import Control.Exception import Control.Monad import Z.Data.PrimRef.PrimIORef-import Data.Typeable import Z.IO.Resource as R import Test.Hspec import Test.HUnit -data WorkerException = WorkerException deriving (Typeable, Show)+data WorkerException = WorkerException deriving (Show) instance Exception WorkerException @@ -23,25 +21,22 @@ workerCounter <- newCounter 0 let res = initResource (atomicAddCounter_ resCounter 1) (\ _ -> atomicSubCounter_ resCounter 1)- resPool = initPool res 100 5+ resPool = initPool res 100 1 R.withResource resPool $ \ pool -> do let res = initInPool pool forM_ [1..1000] $ \ k -> forkIO. R.withResource res $ \ i -> do atomicAddCounter_ workerCounter 1 r <- readPrimIORef resCounter- threadDelay 1000000+ threadDelay 100000 assertEqual "pool should limit max usage" True (r <= 100) - threadDelay 13000000+ threadDelay 1000000 -- first 100 worker quickly get resources -- then hold for 1s, rest 100 worker have to wait, and so on -- so here we wait for 5s to make sure every worker got a resource -- we used to use replicateConcurrently_ from async, but it's -- not really neccessary - w <- readPrimIORef workerCounter- assertEqual "worker should be able to get resource" 1000 w- r <- readPrimIORef resCounter assertEqual "pool should keep returned resources alive" 100 r @@ -50,11 +45,12 @@ threadDelay 5000000 -- after 5s, 1000 thread should release all resources + w <- readPrimIORef workerCounter+ assertEqual "worker should be able to get resource" 1000 w+ r <- readPrimIORef resCounter assertEqual "pool should reap unused resources" 0 r - threadDelay 5000000 -- another 5s- s <- poolStat pool assertEqual "pool should stop scanning returned resources" PoolEmpty s @@ -65,14 +61,11 @@ forM_ [1..1000] $ \ k -> forkIO. R.withResource res $ \ i -> do atomicAddCounter_ workerCounter 1 r <- readPrimIORef resCounter- threadDelay 1000000+ threadDelay 100000 assertEqual "pool should limit max usage" True (r <= 100) - threadDelay 12000000-- w <- readPrimIORef workerCounter- assertEqual "worker should be able to get resource" 1000 w+ threadDelay 1000000 r <- readPrimIORef resCounter assertEqual "pool should keep returned resources alive" 100 r@@ -80,8 +73,11 @@ s <- poolStat pool assertEqual "pool should be scanning returned resources" PoolScanning s - threadDelay 10000000+ threadDelay 5000000 + w <- readPrimIORef workerCounter+ assertEqual "worker should be able to get resource" 1000 w+ r <- readPrimIORef resCounter assertEqual "pool should reap unused resources" 0 r @@ -92,17 +88,17 @@ resCounter <- newCounter 0 let res = initResource (atomicAddCounter' resCounter 1) (\ _ -> atomicSubCounter_ resCounter 1)- resPool = initPool res 100 5+ resPool = initPool res 100 1 R.withResource resPool $ \ pool -> do let res = initInPool pool forM_ [1..1000] $ \ k -> forkIO. R.withResource res $ \ i -> do r <- readPrimIORef resCounter- threadDelay 1000000+ threadDelay 100000 when (even i) (throwIO WorkerException) assertEqual "pool should limit max usage" True (r <= 100) - threadDelay 12000000+ threadDelay 1000000 r <- readPrimIORef resCounter assertEqual "pool should keep returned resources alive" 100 r@@ -110,7 +106,7 @@ s <- poolStat pool assertEqual "pool should be scanning returned resources" PoolScanning s - threadDelay 10000000+ threadDelay 5000000 r <- readPrimIORef resCounter assertEqual "pool should reap unused resources" 0 r
third_party/cwalk/include/cwalk.h view
@@ -6,8 +6,29 @@ #include <stdbool.h> #include <stddef.h> +#if defined(_WIN32) || defined(__CYGWIN__) +#define CWK_EXPORT __declspec(dllexport) +#define CWK_IMPORT __declspec(dllimport) +#elif __GNUC__ >= 4 +#define CWK_EXPORT __attribute__((visibility("default"))) +#define CWK_IMPORT __attribute__((visibility("default"))) +#else +#define CWK_EXPORT +#define CWK_IMPORT +#endif + +#if defined(CWK_SHARED) +#if defined(CWK_EXPORTS) +#define CWK_PUBLIC CWK_EXPORT +#else +#define CWK_PUBLIC CWK_IMPORT +#endif +#else +#define CWK_PUBLIC +#endif + #ifdef __cplusplus -extern "C" +extern "C" { #endif @@ -55,41 +76,43 @@ * * This function generates an absolute path based on a base path and another * path. It is guaranteed to return an absolute path. If the second submitted - * path is absolute, it will override the base path. The result will be written - * to a buffer, which might be truncated if the buffer is not large enough to - * hold the full path. However, the truncated result will always be + * path is absolute, it will override the base path. The result will be + * written to a buffer, which might be truncated if the buffer is not large + * enough to hold the full path. However, the truncated result will always be * null-terminated. The returned value is the amount of characters which the * resulting path would take if it was not truncated (excluding the * null-terminating character). * - * @param base The absolute base path on which the relative path will be applied. + * @param base The absolute base path on which the relative path will be + * applied. * @param path The relative path which will be applied on the base path. * @param buffer The buffer where the result will be written to. * @param buffer_size The size of the result buffer. * @return Returns the total amount of characters of the new absolute path. */ -size_t cwk_path_get_absolute(const char *base, const char *path, char *buffer, - size_t buffer_size); +CWK_PUBLIC size_t cwk_path_get_absolute(const char *base, const char *path, + char *buffer, size_t buffer_size); /** * @brief Generates a relative path based on a base. * * This function generates a relative path based on a base path and another - * path. It determines how to get to the submitted path, starting from the base - * directory. The result will be written to a buffer, which might be truncated - * if the buffer is not large enough to hold the full path. However, the - * truncated result will always be null-terminated. The returned value is the - * amount of characters which the resulting path would take if it was not + * path. It determines how to get to the submitted path, starting from the + * base directory. The result will be written to a buffer, which might be + * truncated if the buffer is not large enough to hold the full path. However, + * the truncated result will always be null-terminated. The returned value is + * the amount of characters which the resulting path would take if it was not * truncated (excluding the null-terminating character). * - * @param base_directory The base path from which the relative path will start. + * @param base_directory The base path from which the relative path will + * start. * @param path The target path where the relative path will point to. * @param buffer The buffer where the result will be written to. * @param buffer_size The size of the result buffer. * @return Returns the total amount of characters of the full path. */ -size_t cwk_path_get_relative(const char *base_directory, const char *path, - char *buffer, size_t buffer_size); +CWK_PUBLIC size_t cwk_path_get_relative(const char *base_directory, + const char *path, char *buffer, size_t buffer_size); /** * @brief Joins two paths together. @@ -98,9 +121,10 @@ * will remove double separators, and unlike cwk_path_get_absolute it permits * the use of two relative paths to combine. The result will be written to a * buffer, which might be truncated if the buffer is not large enough to hold - * the full path. However, the truncated result will always be null-terminated. - * The returned value is the amount of characters which the resulting path would - * take if it was not truncated (excluding the null-terminating character). + * the full path. However, the truncated result will always be + * null-terminated. The returned value is the amount of characters which the + * resulting path would take if it was not truncated (excluding the + * null-terminating character). * * @param path_a The first path which comes first. * @param path_b The second path which comes after the first. @@ -108,40 +132,41 @@ * @param buffer_size The size of the result buffer. * @return Returns the total amount of characters of the full, combined path. */ -size_t cwk_path_join(const char *path_a, const char *path_b, char *buffer, - size_t buffer_size); +CWK_PUBLIC size_t cwk_path_join(const char *path_a, const char *path_b, + char *buffer, size_t buffer_size); /** * @brief Joins multiple paths together. * * This function generates a new path by joining multiple paths together. It * will remove double separators, and unlike cwk_path_get_absolute it permits - * the use of multiple relative paths to combine. The last path of the submitted - * string array must be set to NULL. The result will be written to a buffer, - * which might be truncated if the buffer is not large enough to hold the full - * path. However, the truncated result will always be null-terminated. The - * returned value is the amount of characters which the resulting path would - * take if it was not truncated (excluding the null-terminating character). + * the use of multiple relative paths to combine. The last path of the + * submitted string array must be set to NULL. The result will be written to a + * buffer, which might be truncated if the buffer is not large enough to hold + * the full path. However, the truncated result will always be + * null-terminated. The returned value is the amount of characters which the + * resulting path would take if it was not truncated (excluding the + * null-terminating character). * * @param paths An array of paths which will be joined. * @param buffer The buffer where the result will be written to. * @param buffer_size The size of the result buffer. * @return Returns the total amount of characters of the full, combined path. */ -size_t cwk_path_join_multiple(const char **paths, char *buffer, +CWK_PUBLIC size_t cwk_path_join_multiple(const char **paths, char *buffer, size_t buffer_size); /** * @brief Determines the root of a path. * - * This function determines the root of a path by finding it's length. The root - * always starts at the submitted path. If the path has no root, the length will - * be set to zero. + * This function determines the root of a path by finding it's length. The + * root always starts at the submitted path. If the path has no root, the + * length will be set to zero. * * @param path The path which will be inspected. * @param length The output of the root length. */ -void cwk_path_get_root(const char *path, size_t *length); +CWK_PUBLIC void cwk_path_get_root(const char *path, size_t *length); /** * @brief Changes the root of a path. @@ -156,11 +181,11 @@ * @param path The original path which will get a new root. * @param new_root The new root which will be placed in the path. * @param buffer The output buffer where the result is written to. - * @param buffer_size The size of the output buffer where the result is written - * to. + * @param buffer_size The size of the output buffer where the result is + * written to. * @return Returns the total amount of characters of the new path. */ -size_t cwk_path_change_root(const char *path, const char *new_root, +CWK_PUBLIC size_t cwk_path_change_root(const char *path, const char *new_root, char *buffer, size_t buffer_size); /** @@ -172,7 +197,7 @@ * @param path The path which will be checked. * @return Returns true if the path is absolute or false otherwise. */ -bool cwk_path_is_absolute(const char *path); +CWK_PUBLIC bool cwk_path_is_absolute(const char *path); /** * @brief Determine whether the path is relative or not. @@ -183,74 +208,75 @@ * @param path The path which will be checked. * @return Returns true if the path is relative or false otherwise. */ -bool cwk_path_is_relative(const char *path); +CWK_PUBLIC bool cwk_path_is_relative(const char *path); /** * @brief Gets the basename of a file path. * - * This function gets the basename of a file path. A pointer to the beginning of - * the basename will be returned through the basename parameter. This pointer - * will be positioned on the first letter after the separator. The length of the - * file path will be returned through the length parameter. The length will be - * set to zero and the basename to NULL if there is no basename available. + * This function gets the basename of a file path. A pointer to the beginning + * of the basename will be returned through the basename parameter. This + * pointer will be positioned on the first letter after the separator. The + * length of the file path will be returned through the length parameter. The + * length will be set to zero and the basename to NULL if there is no basename + * available. * * @param path The path which will be inspected. * @param basename The output of the basename pointer. * @param length The output of the length of the basename. */ -void cwk_path_get_basename(const char *path, const char **basename, +CWK_PUBLIC void cwk_path_get_basename(const char *path, const char **basename, size_t *length); /** * @brief Changes the basename of a file path. * * This function changes the basename of a file path. This function will not - * write out more than the specified buffer can contain. However, the generated - * string is always null-terminated - even if not the whole path is written out. - * The function returns the total number of characters the complete buffer would - * have, even if it was not written out completely. The path may be the same - * memory address as the buffer. + * write out more than the specified buffer can contain. However, the + * generated string is always null-terminated - even if not the whole path is + * written out. The function returns the total number of characters the + * complete buffer would have, even if it was not written out completely. The + * path may be the same memory address as the buffer. * * @param path The original path which will be used for the modified path. * @param new_basename The new basename which will replace the old one. * @param buffer The buffer where the changed path will be written to. * @param buffer_size The size of the result buffer where the changed path is * written to. - * @return Returns the size which the complete new path would have if it was not - * truncated. + * @return Returns the size which the complete new path would have if it was + * not truncated. */ -size_t cwk_path_change_basename(const char *path, const char *new_basename, - char *buffer, size_t buffer_size); +CWK_PUBLIC size_t cwk_path_change_basename(const char *path, + const char *new_basename, char *buffer, size_t buffer_size); /** * @brief Gets the dirname of a file path. * - * This function determines the dirname of a file path and returns the length up - * to which character is considered to be part of it. If no dirname is found, - * the length will be set to zero. The beginning of the dirname is always equal - * to the submitted path pointer. + * This function determines the dirname of a file path and returns the length + * up to which character is considered to be part of it. If no dirname is + * found, the length will be set to zero. The beginning of the dirname is + * always equal to the submitted path pointer. * * @param path The path which will be inspected. * @param length The length of the dirname. */ -void cwk_path_get_dirname(const char *path, size_t *length); +CWK_PUBLIC void cwk_path_get_dirname(const char *path, size_t *length); /** * @brief Gets the extension of a file path. * * This function extracts the extension portion of a file path. A pointer to * the beginning of the extension will be returned through the extension - * parameter if an extension is found and true is returned. This pointer will be - * positioned on the dot. The length of the extension name will be returned - * through the length parameter. If no extension is found both parameters won't - * be touched and false will be returned. + * parameter if an extension is found and true is returned. This pointer will + * be positioned on the dot. The length of the extension name will be returned + * through the length parameter. If no extension is found both parameters + * won't be touched and false will be returned. * * @param path The path which will be inspected. * @param extension The output of the extension pointer. * @param length The output of the length of the extension. * @return Returns true if an extension is found or false otherwise. */ -bool cwk_path_get_extension(const char *path, const char **extension, +CWK_PUBLIC bool cwk_path_get_extension(const char *path, const char **extension, size_t *length); /** @@ -262,30 +288,31 @@ * @param path The path which will be inspected. * @return Returns true if the path has an extension or false otherwise. */ -bool cwk_path_has_extension(const char *path); +CWK_PUBLIC bool cwk_path_has_extension(const char *path); /** * @brief Changes the extension of a file path. * - * This function changes the extension of a file name. The function will append - * an extension if the basename does not have an extension, or use the extension - * as a basename if the path does not have a basename. This function will not - * write out more than the specified buffer can contain. However, the generated - * string is always null-terminated - even if not the whole path is written out. - * The function returns the total number of characters the complete buffer would - * have, even if it was not written out completely. The path may be the same - * memory address as the buffer. + * This function changes the extension of a file name. The function will + * append an extension if the basename does not have an extension, or use the + * extension as a basename if the path does not have a basename. This function + * will not write out more than the specified buffer can contain. However, the + * generated string is always null-terminated - even if not the whole path is + * written out. The function returns the total number of characters the + * complete buffer would have, even if it was not written out completely. The + * path may be the same memory address as the buffer. * * @param path The path which will be used to make the change. - * @param new_extension The extension which will be placed within the new path. + * @param new_extension The extension which will be placed within the new + * path. * @param buffer The output buffer where the result will be written to. * @param buffer_size The size of the output buffer where the result will be * written to. * @return Returns the total size which the output would have if it was not * truncated. */ -size_t cwk_path_change_extension(const char *path, const char *new_extension, - char *buffer, size_t buffer_size); +CWK_PUBLIC size_t cwk_path_change_extension(const char *path, + const char *new_extension, char *buffer, size_t buffer_size); /** * @brief Creates a normalized version of the path. @@ -309,7 +336,8 @@ * @return The size which the complete normalized path has if it was not * truncated. */ -size_t cwk_path_normalize(const char *path, char *buffer, size_t buffer_size); +CWK_PUBLIC size_t cwk_path_normalize(const char *path, char *buffer, + size_t buffer_size); /** * @brief Finds common portions in two paths. @@ -322,47 +350,50 @@ * @param path_other The other path which will compared with the base path. * @return Returns the number of characters which are common in the base path. */ -size_t cwk_path_get_intersection(const char *path_base, const char *path_other); +CWK_PUBLIC size_t cwk_path_get_intersection(const char *path_base, + const char *path_other); /** * @brief Gets the first segment of a path. * - * This function finds the first segment of a path. The position of the segment - * is set to the first character after the separator, and the length counts all - * characters until the next separator (excluding the separator). + * This function finds the first segment of a path. The position of the + * segment is set to the first character after the separator, and the length + * counts all characters until the next separator (excluding the separator). * * @param path The path which will be inspected. * @param segment The segment which will be extracted. * @return Returns true if there is a segment or false if there is none. */ -bool cwk_path_get_first_segment(const char *path, struct cwk_segment *segment); +CWK_PUBLIC bool cwk_path_get_first_segment(const char *path, + struct cwk_segment *segment); /** * @brief Gets the last segment of the path. * - * This function gets the last segment of a path. This function may return false - * if the path doesn't contain any segments, in which case the submitted segment - * parameter is not modified. The position of the segment is set to the first - * character after the separator, and the length counts all characters until the - * end of the path (excluding the separator). + * This function gets the last segment of a path. This function may return + * false if the path doesn't contain any segments, in which case the submitted + * segment parameter is not modified. The position of the segment is set to + * the first character after the separator, and the length counts all + * characters until the end of the path (excluding the separator). * * @param path The path which will be inspected. * @param segment The segment which will be extracted. * @return Returns true if there is a segment or false if there is none. */ -bool cwk_path_get_last_segment(const char *path, struct cwk_segment *segment); +CWK_PUBLIC bool cwk_path_get_last_segment(const char *path, + struct cwk_segment *segment); /** * @brief Advances to the next segment. * - * This function advances the current segment to the next segment. If there are - * no more segments left, the submitted segment structure will stay unchanged - * and false is returned. + * This function advances the current segment to the next segment. If there + * are no more segments left, the submitted segment structure will stay + * unchanged and false is returned. * * @param segment The current segment which will be advanced to the next one. * @return Returns true if another segment was found or false otherwise. */ -bool cwk_path_get_next_segment(struct cwk_segment *segment); +CWK_PUBLIC bool cwk_path_get_next_segment(struct cwk_segment *segment); /** * @brief Moves to the previous segment. @@ -375,31 +406,31 @@ * @return Returns true if there is a segment before this one or false * otherwise. */ -bool cwk_path_get_previous_segment(struct cwk_segment *segment); +CWK_PUBLIC bool cwk_path_get_previous_segment(struct cwk_segment *segment); /** * @brief Gets the type of the submitted path segment. * - * This function inspects the contents of the segment and determines the type of - * it. Currently, there are three types CWK_NORMAL, CWK_CURRENT and CWK_BACK. A - * CWK_NORMAL segment is a normal folder or file entry. A CWK_CURRENT is a "./" - * and a CWK_BACK a "../" segment. + * This function inspects the contents of the segment and determines the type + * of it. Currently, there are three types CWK_NORMAL, CWK_CURRENT and + * CWK_BACK. A CWK_NORMAL segment is a normal folder or file entry. A + * CWK_CURRENT is a "./" and a CWK_BACK a "../" segment. * * @param segment The segment which will be inspected. * @return Returns the type of the segment. */ -enum cwk_segment_type cwk_path_get_segment_type( +CWK_PUBLIC enum cwk_segment_type cwk_path_get_segment_type( const struct cwk_segment *segment); /** * @brief Changes the content of a segment. * * This function overrides the content of a segment to the submitted value and - * outputs the whole new path to the submitted buffer. The result might require - * less or more space than before if the new value length differs from the - * original length. The output is truncated if the new path is larger than the - * submitted buffer size, but it is always null-terminated. The source of the - * segment and the submitted buffer may be the same. + * outputs the whole new path to the submitted buffer. The result might + * require less or more space than before if the new value length differs from + * the original length. The output is truncated if the new path is larger than + * the submitted buffer size, but it is always null-terminated. The source of + * the segment and the submitted buffer may be the same. * * @param segment The segment which will be modifier. * @param value The new content of the segment. @@ -408,8 +439,8 @@ * @return Returns the total size which would have been written if the output * was not truncated. */ -size_t cwk_path_change_segment(struct cwk_segment *segment, const char *value, - char *buffer, size_t buffer_size); +CWK_PUBLIC size_t cwk_path_change_segment(struct cwk_segment *segment, + const char *value, char *buffer, size_t buffer_size); /** * @brief Checks whether the submitted pointer points to a separator. @@ -422,19 +453,19 @@ * @param symbol A pointer to a string. * @return Returns true if it is a separator, or false otherwise. */ -bool cwk_path_is_separator(const char *str); +CWK_PUBLIC bool cwk_path_is_separator(const char *str); /** * @brief Guesses the path style. * * This function guesses the path style based on a submitted path-string. The - * guessing will look at the root and the type of slashes contained in the path - * and return the style which is more likely used in the path. + * guessing will look at the root and the type of slashes contained in the + * path and return the style which is more likely used in the path. * * @param path The path which will be inspected. * @return Returns the style which is most likely used for the path. */ -enum cwk_path_style cwk_path_guess_style(const char *path); +CWK_PUBLIC enum cwk_path_style cwk_path_guess_style(const char *path); /** * @brief Configures which path style is used. @@ -447,7 +478,7 @@ * * @param style The style which will be used from now on. */ -void cwk_path_set_style(enum cwk_path_style style); +CWK_PUBLIC void cwk_path_set_style(enum cwk_path_style style); /** * @brief Gets the path style configuration. @@ -457,7 +488,7 @@ * * @return Returns the current path style configuration. */ -enum cwk_path_style cwk_path_get_style(void); +CWK_PUBLIC enum cwk_path_style cwk_path_get_style(void); #ifdef __cplusplus } // extern "C"
third_party/cwalk/src/cwalk.c view
@@ -184,6 +184,9 @@ // why this has to be done first. segment->path = path; segment->segments = segments; + segment->begin = segments; + segment->end = segments; + segment->size = 0; // Now let's check whether this is an empty string. An empty string has no // segment it could use. @@ -726,7 +729,9 @@ // different roots. cwk_path_get_root(base_directory, &base_root_length); cwk_path_get_root(path, &path_root_length); - if (!cwk_path_is_string_equal(base_directory, path, base_root_length)) { + if (base_root_length != path_root_length || + !cwk_path_is_string_equal(base_directory, path, base_root_length)) { + cwk_path_terminate_output(buffer, buffer_size, pos); return pos; }