Z-IO 0.8.0.0 → 0.8.1.0

raw patch · 9 files changed

+269/−51 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• README.md +3/−0
• Z-IO.cabal +1/−1
• Z/IO/BIO.hs +28/−1
• Z/IO/FileSystem/Base.hs +27/−9
• Z/IO/FileSystem/FilePath.hsc +88/−20
• Z/IO/FileSystem/Threaded.hs +26/−8
• Z/IO/Network/SocketAddr.hsc +76/−0
• include/fs_shared.hs +14/−12

@@ -1,5 +1,11 @@ # Revision history for Z-IO +## 0.8.1.0  -- 2020-04-25++* Add `getInterface` to `Z.IO.Network`.+* `mkstemp` now return opend file, the type changed to `mkstemp :: CBytes -> CBytes -> Bool -> Resource (CBytes, File)`, which has an option for keep file or not.+* `initTempFile` and `initTempDir` now do not need a prefix argument, the prefix is hardcoded as `Z-IO-`.+ ## 0.8.0.0  -- 2020-04-25  This is an experimental version to test new 'BIO' module.

@@ -6,6 +6,9 @@ [![Windows Build Status](https://github.com/ZHaskell/z-io/workflows/win-ci/badge.svg)](https://github.com/ZHaskell/z-io/actions) [![Docker Build Status](https://github.com/ZHaskell/z-io/workflows/docker-ci/badge.svg)](https://github.com/ZHaskell/z-io/actions) [![Gitter chat](https://badges.gitter.im/gitterHQ/gitter.svg)](https://gitter.im/Z-Haskell/community)+<a href="https://opencollective.com/zhaskell/donate" target="_blank">+  <img src="https://opencollective.com/zhaskell/donate/button@2x.png?color=blue" width=128 />+</a>  This package is part of [Z.Haskell](https://z.haskell.world) project, provides basic IO operations: 

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               Z-IO-version:            0.8.0.0+version:            0.8.1.0 synopsis:           Simple and high performance IO toolkit for Haskell description:   Simple and high performance IO toolkit for Haskell, including

@@ -42,6 +42,11 @@ -- run 'zcat "test.gz" | base64 -d' will give you original file @ +This module is intended to be imported qualified:+@+import           Z.IO.BIO (BIO, Source, Sink)+import qualified Z.IO.BIO as BIO+@ -} module Z.IO.BIO (   -- * The BIO type@@ -57,6 +62,7 @@   , runBlocks, runBlocks_, unsafeRunBlocks   -- * Make new BIO   , pureBIO, ioBIO+  , filter, filterM   -- ** Source   , initSourceFromFile   , initSourceFromFile'@@ -87,8 +93,9 @@   , consumedNode   ) where +import           Prelude                hiding (filter) import           Control.Concurrent.MVar-import           Control.Monad+import           Control.Monad          hiding  (filterM) import           Control.Monad.IO.Class import           Data.Bits              ((.|.)) import           Data.IORef@@ -476,6 +483,26 @@ 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. --

@@ -297,7 +297,7 @@ unlink path = throwUVIfMinus_ (withCBytesUnsafe path hs_uv_fs_unlink)  --- | Equivalent to <mkdtemp http://linux.die.net/man/3/mkdtemp>+-- | Equivalent to <http://linux.die.net/man/3/mkdtemp mkdtemp> -- -- Creates a temporary directory in the most secure manner possible. -- There are no race conditions in the directory’s creation.@@ -316,14 +316,32 @@             throwUVIfMinus_ (hs_uv_fs_mkdtemp p size p')         return p' --- | Equivalent to <mkstemp https://man7.org/linux/man-pages/man3/mkstemp.3.html>-mkstemp :: HasCallStack => CBytes -> IO CBytes-mkstemp template = do-    let size = CBytes.length template-    CBytes.withCBytesUnsafe template $ \p -> do-        (p', _) <- CBytes.allocCBytesUnsafe (size + 7) $ \ p' -> do  -- we append "XXXXXX\NUL" in C-            throwUVIfMinus_ (hs_uv_fs_mkstemp p size p')-        return p'+-- | Equivalent to <https://man7.org/linux/man-pages/man3/mkstemp.3.html mkstemp>+--+--  The file is created with permissions 0600, that is, read plus+--  write for owner only.  The returned 'File' provides both+--  read and write access to the file.  The file is opened with the+--  'O_EXCL' flag, guaranteeing that the caller is the process that creates the file.+--+--  After resource is used, the file will be closed, and removed if keep param is 'False'.+mkstemp :: HasCallStack+        => CBytes       -- ^ directory where temp file are created.+        -> CBytes       -- ^ A file path prefix template, no "XXXXXX" needed.+        -> Bool         -- ^ Keep file after used?+        -> Resource (CBytes, File)+mkstemp dir template keep = do+    initResource+        (do template' <- dir `P.join` template+            let !size = CBytes.length template'+            CBytes.withCBytesUnsafe template' $ \p -> do+                (p', r) <- CBytes.allocCBytesUnsafe (size + 7) $ \ p' -> do  -- we append "XXXXXX\NUL" in C+                    throwUVIfMinus (hs_uv_fs_mkstemp p size p')+                closed <- newIORef False+                return (p', File (fromIntegral r) closed))+        (\ (p, File r closed) -> do+            unless keep (unlink p)+            throwUVIfMinus_ (hs_uv_fs_close r)+            writeIORef closed True)  ------------------------------------------------------------------------------- 

@@ -26,13 +26,13 @@   , absolute   , relative   -- * Extensions-  , splitExtension, changeExtension+  , splitExtension, changeExtension, dropExtension, takeExtension, hasExtension   -- * Path Style   , PathStyle(..)   , pathStyle   , getPathStyle, setPathStyle-  , pathSeparator, pathSeparators-  , searchPathSeparator, extensionSeparator+  , pathSeparator, pathSeparators, isPathSeparator, isExtensionSeparator+  , searchPathSeparator, extensionSeparator, isSearchPathSeparator   -- * Search path   , getSearchPath  ) where@@ -105,25 +105,32 @@ -- | Configures which path style is used afterwards. -- -- This function configures which path style is used.--- call to this function is only required if a non-native behaviour is required. +-- 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 () setPathStyle = cwk_path_set_style . pathStyleToEnum_ --- | Get the default character that separates directories. +-- | Get the default character that separates directories. pathSeparator :: IO Word8 pathSeparator = do     s <- getPathStyle     case s of UnixStyle -> return (#const SLASH)               _         -> return (#const BACKSLASH) --- | Get characters that separates directories. +-- | Get characters that separates directories. pathSeparators :: IO [Word8] pathSeparators = do     s <- getPathStyle     case s of UnixStyle -> return [(#const SLASH)]               _         -> return [(#const SLASH), (#const BACKSLASH)] +-- | Test if a character is a path separator.+isPathSeparator :: Word8 -> IO Bool+isPathSeparator w = do+    s <- getPathStyle+    case s of UnixStyle -> return (w == #const SLASH)+              _         -> return (w == #const BACKSLASH)+ -- | The character that is used to separate the entries in the $PATH environment variable. -- -- * Windows: searchPathSeparator is ASCII @;@@@ -135,12 +142,22 @@     case s of UnixStyle -> return (#const COLON)               _         -> return (#const SEMICOLON) +-- | Test if a character is a file separator.+isSearchPathSeparator :: Word8 -> IO Bool+isSearchPathSeparator w = do+    w' <- searchPathSeparator+    return (w == w')+ -- | File extension character -- -- ExtSeparator is ASCII @.@ extensionSeparator :: Word8 extensionSeparator = #const DOT +-- | Test if a character is a file extension separator.+isExtensionSeparator :: Word8 -> Bool+isExtensionSeparator = (== #const DOT)+ -- | Get the basename of a file path. -- -- The basename is the last segment of a path. For instance, @logs@ is the basename of the path @\/var\/logs@.@@ -231,7 +248,7 @@ -- | WINDOWS | ..\\hello\\world.txt     | ""                   | -- +---------+--------------------------+----------------------+ ---splitRoot :: CBytes +splitRoot :: CBytes           -> IO (CBytes, CBytes) -- ^ return (root, rest path) {-# INLINABLE splitRoot #-} splitRoot p = do@@ -506,8 +523,8 @@ -- -- 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' +--+-- Note the two arguments must be both absolute or both relative, otherwise an 'InvalidArgument' -- will be thrown. -- -- +---------+--------------------------+--------------------------+-----------------+@@ -554,6 +571,56 @@ -- -- This function extracts the extension portion of a file path. --+-- +----------------------------+------------------------------------++-- | Path                       | Result                             |+-- +----------------------------+------------------------------------++-- | \/my\/path.txt             | (\/my\/path, .txt)                 |+-- +----------------------------+------------------------------------++-- | \/my\/path                 | (\/my\/path, "")                   |+-- +----------------------------+------------------------------------++-- | \/my\/.ext                 | (\/my\/, .ext)                     |+-- +----------------------------+------------------------------------++-- | \/my\/path.                | (\/my\/path, .)                    |+-- +----------------------------+------------------------------------++-- | \/my\/path.abc.txt.tests   | (\/my\/path.abc.txt, .tests)       |+-- +----------------------------+------------------------------------++--+splitExtension :: CBytes              -- ^ file path+               -> IO (CBytes, CBytes) -- ^ return (file, ext)+{-# INLINABLE splitExtension #-}+splitExtension p = do+    (len ,off) <- withCBytesUnsafe p $ \ pp ->+        allocPrimUnsafe $ \ plen ->+            hs_cwk_path_get_extension pp plen+    if off == -1+    then return (p, CB.empty)+    else return ( CB (V.PrimVector (CB.rawPrimArray p) 0 off)+                , CB (V.PrimVector (CB.rawPrimArray p) off len))++-- | Remove the last extension and its correspondence \".\" of a file path.+--+-- +----------------------------+--------------------++-- | Path                       | Result             |+-- +----------------------------+--------------------++-- | \/my\/path.txt             | \/my\/path         |+-- +----------------------------+--------------------++-- | \/my\/path                 | \/my\/path         |+-- +----------------------------+------- ------------++-- | \/my\/.ext                 | \/my\/             |+-- +----------------------------+--------------------++-- | \/my\/path.                | \/my\/path         |+-- +----------------------------+--------------------++-- | \/my\/path.abc.txt.tests   | \/my\/path.abc.txt |+-- +----------------------------+--------------------++--+dropExtension :: CBytes -- ^ file path+              -> IO CBytes+{-# INLINE dropExtension #-}+dropExtension p = fst <$> splitExtension p++-- | Get the extension of a file from a file path, returns @\"\"@ for no+--   extension, @.ext@ otherwise.+-- -- +----------------------------+------------+ -- | Path                       | Result     | -- +----------------------------+------------+@@ -568,18 +635,18 @@ -- | \/my\/path.abc.txt.tests   | .tests     | -- +----------------------------+------------+ ---splitExtension :: CBytes-               -> IO (CBytes, CBytes) -- ^ return (file, ext)-{-# INLINABLE splitExtension #-}-splitExtension p = do-    (len ,off) <- withCBytesUnsafe p $ \ pp ->-        allocPrimUnsafe $ \ plen ->-            hs_cwk_path_get_extension pp plen-    if off == -1-    then return (p, CB.empty)-    else return ( CB (V.PrimVector (CB.rawPrimArray p) 0 off)-                , CB (V.PrimVector (CB.rawPrimArray p) off len))+takeExtension :: CBytes -- ^ file path+              -> IO CBytes+{-# INLINE takeExtension #-}+takeExtension p = snd <$> splitExtension p +-- | Test if a file from a file path has an extension.+hasExtension :: CBytes -- ^ file path+             -> IO Bool+hasExtension p = do+    withCBytesUnsafe p $ \ p' ->+        cwk_path_has_extension p'+ -- | Changes the extension of a file path. -- -- This function changes the extension of a file name.@@ -640,6 +707,7 @@ foreign import ccall unsafe cwk_path_get_absolute :: BA## Word8 -> BA## Word8 -> MBA## Word8 -> CSize -> IO CSize foreign import ccall unsafe cwk_path_get_relative :: BA## Word8 -> BA## Word8 -> MBA## Word8 -> CSize -> IO CSize foreign import ccall unsafe hs_cwk_path_get_extension :: BA## Word8 -> MBA## CSize -> IO Int+foreign import ccall unsafe cwk_path_has_extension :: BA## Word8 -> IO Bool foreign import ccall unsafe cwk_path_change_extension :: BA## Word8 -> BA## Word8 -> MBA## Word8 -> CSize -> IO CSize foreign import ccall unsafe cwk_path_guess_style :: BA## Word8 -> IO CInt foreign import ccall unsafe cwk_path_get_style :: IO CInt

@@ -346,14 +346,32 @@         return p''  -- | Equivalent to <mkstemp https://man7.org/linux/man-pages/man3/mkstemp.3.html>-mkstemp :: HasCallStack => CBytes -> IO CBytes-mkstemp template = do-    let size = CBytes.length template-    CBytes.withCBytesUnsafe template $ \ p -> do-        (p'', _) <- CBytes.allocCBytesUnsafe (size+7) $ \ p' -> do  -- we append "XXXXXX\NUL" in C-            uvm <- getUVManager-            withUVRequest_ uvm (hs_uv_fs_mkstemp_threaded p size p')-        return p''+--+--  The file is created with permissions 0600, that is, read plus+--  write for owner only.  The returned 'File' provides both+--  read and write access to the file.  The file is opened with the+--  'O_EXCL' flag, guaranteeing that the caller is the process that creates the file.+--+--  After resource is used, the file will be closed, and removed if keep param is 'False'.+mkstemp :: HasCallStack+        => CBytes       -- ^ directory where temp file are created.+        -> CBytes       -- ^ A file path prefix template, no "XXXXXX" needed.+        -> Bool         -- ^ Keep file after used?+        -> Resource (CBytes, File)+mkstemp dir template keep = do+    initResource+        (do template' <- dir `P.join` template+            let !size = CBytes.length template'+            CBytes.withCBytesUnsafe template' $ \ p -> do+                (p'', r) <- CBytes.allocCBytesUnsafe (size+7) $ \ p' -> do  -- we append "XXXXXX\NUL" in C+                    uvm <- getUVManager+                    withUVRequest uvm (hs_uv_fs_mkstemp_threaded p size p')+                closed <- newIORef False+                return (p'', File (fromIntegral r) closed))+        (\ (p, File r closed) -> do+            unless keep (unlink p)+            throwUVIfMinus_ (hs_uv_fs_close r)+            writeIORef closed True)  -- | Equivalent to <http://linux.die.net/man/2/rmdir rmdir(2)>. --

@@ -41,6 +41,9 @@   , tupleToIPv6Addr   , FlowInfo   , ScopeID+  -- * Interface+  , Interface(..)+  , getInterface   -- * port numbber   , PortNumber(..)   , portAny@@ -73,12 +76,14 @@   , pokeSocketAddr   , peekSocketAddrMBA   , pokeSocketAddrMBA+  , peekInterface   , htons   , ntohs   , ntohl   , htonl   ) where +import           Control.Monad import           Data.Bits import           Foreign import           Foreign.C@@ -93,6 +98,7 @@ import qualified Z.Data.JSON.Builder    as B import qualified Z.Data.Vector          as V import qualified Z.Data.Vector.Extra    as V+import qualified Z.Data.Vector.Hex      as V import           Z.IO.Exception import           Z.Foreign @@ -579,6 +585,76 @@     pokeMBA p (#offset struct sockaddr_in6, sin6_flowinfo) flow     pokeMBA p (#offset struct sockaddr_in6, sin6_addr) (addr)     pokeMBA p (#offset struct sockaddr_in6, sin6_scope_id) scope++--------------------------------------------------------------------------------++-- | Data type for interface addresses.+--+data Interface = Interface+    { interfaceName       :: {-# UNPACK #-} !CBytes+    , interfacePhysAddr   :: !V.HexBytes+    , interfaceIsInternal :: !Bool+    , interfaceAddr       :: !SocketAddr+    , interfaceMask       :: !SocketAddr+    } deriving (Eq, Ord, Generic)+      deriving anyclass (Print, JSON)++instance Show Interface where show = T.toString++peekInterface :: HasCallStack => Ptr Interface -> IO Interface+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+    is_internal <- (#peek struct uv_interface_address_s, is_internal) p++    family <- (#peek struct uv_interface_address_s, address.address4.sin_family) p+    addr' <- case family :: CSaFamily of+        (#const AF_INET) -> do+            addr <- (#peek struct uv_interface_address_s, address.address4.sin_addr) p+            port <- (#peek struct uv_interface_address_s, address.address4.sin_port) p+            return (SocketAddrIPv4 addr port)+        (#const AF_INET6) -> do+            port <- (#peek struct uv_interface_address_s, address.address6.sin6_port) p+            flow <- (#peek struct uv_interface_address_s, address.address6.sin6_flowinfo) p+            addr <- (#peek struct uv_interface_address_s, address.address6.sin6_addr) p+            scope <- (#peek struct uv_interface_address_s, address.address6.sin6_scope_id) p+            return (SocketAddrIPv6 addr port flow scope)+        _ -> do let errno = UV_EAI_ADDRFAMILY+                name <- uvErrName errno+                desc <- uvStdError errno+                throwUVError errno (IOEInfo name desc callStack)++    family' <- (#peek struct uv_interface_address_s, netmask.netmask4.sin_family) p+    mask' <- case family' :: CSaFamily of+        (#const AF_INET) -> do+            addr <- (#peek struct uv_interface_address_s, netmask.netmask4.sin_addr) p+            port <- (#peek struct uv_interface_address_s, netmask.netmask4.sin_port) p+            return (SocketAddrIPv4 addr port)+        (#const AF_INET6) -> do+            port <- (#peek struct uv_interface_address_s, netmask.netmask6.sin6_port) p+            flow <- (#peek struct uv_interface_address_s, netmask.netmask6.sin6_flowinfo) p+            addr <- (#peek struct uv_interface_address_s, netmask.netmask6.sin6_addr) p+            scope <- (#peek struct uv_interface_address_s, netmask.netmask6.sin6_scope_id) p+            return (SocketAddrIPv6 addr port flow scope)+        _ -> do let errno = UV_EAI_ADDRFAMILY+                name <- uvErrName errno+                desc <- uvStdError errno+                throwUVError errno (IOEInfo name desc callStack)+    +    return (Interface name' (V.HexBytes phy) (is_internal == (1 :: CInt)) addr' mask')+++foreign import ccall unsafe uv_interface_addresses :: MBA## (Ptr Interface) -> MBA## CInt -> IO CInt+foreign import ccall unsafe uv_free_interface_addresses :: Ptr Interface -> CInt -> IO ()++-- | Gets address information about the network interfaces on the system. +getInterface :: IO [Interface]+getInterface = bracket+    (allocPrimUnsafe @(Ptr Interface) $ \ ppiface ->+        fst <$> allocPrimUnsafe @CInt (uv_interface_addresses ppiface))+    (\ (piface, n) -> uv_free_interface_addresses piface n)+    (\ (piface, n) -> forM [0..n-1] $ \ i ->+        peekInterface (piface `plusPtr` (fromIntegral i * (#size struct uv_interface_address_s))))  -------------------------------------------------------------------------------- -- Port Numbers

@@ -137,20 +137,22 @@  -- | Make a temporary file under system 'Env.getTempDir' and automatically clean after used. ----- >>> withResource (initTempFile "foo") $ printStd--- File 13+-- This is a shortcut to 'mkstemp', the file name use @Z-IO-@ as prefix, and will be removed after use. ---initTempFile :: CBytes -> Resource File-initTempFile prefix =-    initResource initAction unlink >>= (\f -> initFile f O_RDWR DEFAULT_FILE_MODE)-    where-        initAction = Env.getTempDir >>= (`P.join` prefix) >>= mkstemp+-- >>> withResource initTempFile $ printStd+-- ("/var/folders/3l/cfdy03vd1gvd1x75gg_js7280000gn/T/Z-IO-bYgZDX",File 13)+--+initTempFile :: HasCallStack => Resource (CBytes, File)+initTempFile = do+    d <- liftIO $ Env.getTempDir+    mkstemp d "Z-IO-" False  -- | Make a temporary directory under system 'Env.getTempDir' and automatically clean after used. ----- >>> withResource (initTempDir "foo") $ printStd--- "/tmp/fooxfWR0L"+-- This is a shortcut to 'mkdtemp', the directory name use @Z-IO-@ as prefix, and will be removed(with files within it) after use. ---initTempDir :: CBytes -> Resource CBytes-initTempDir prefix =-    initResource (Env.getTempDir >>= (`P.join` prefix) >>= mkdtemp) rmrf+-- >>> withResource initTempDir $ printStd+-- "/tmp/Z-IO-xfWR0L"+--+initTempDir :: HasCallStack => Resource CBytes+initTempDir = initResource (Env.getTempDir >>= (`P.join` "Z-IO-") >>= mkdtemp) rmrf