diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,11 +1,20 @@ # Revision history for Z-IO +## 0.6.0.0 -- 2020-02-04 + +* FileSystem: replace `DEFAULT_MODE` with `DEFAULT_FILE_MODE` & `DEFAULT_DIR_MODE`. +* Ignore exception while `mkdirp` on an exist directory. +* Make `rmrf` more like `rm -rf`, which can be used on files. +* Add `doesPathExist/doesFileExist/doesDirExist` to file system module. +* Add `Z.IO.FileSystem` re-export `Z.IO.FileSystem.Watch` and `Z.IO.FileSystem.FilePath`. +* Add `mkstemp`, `initTempFile/initTempDir` to file system module. + ## 0.5.0.0 -- 2020-01-28 * Add `unwrap/unwrap'` to `Z.IO.Exception`. * Add `readParseChunks` to `Z.IO.Buffered`, Change `readParser`'s type to match `readParseChunks`. * Add `sourceParseChunksBufferedInput`, `sourceParseChunksInput` to `Z.IO.BIO`. -* Add `newJSONLogger/defaultJSONFmt` to `Z.IO.Logger`, provide simple JSON structured logging. +* Add `newJSONLogger/defaultJSONFmt` to `Z.IO.Logger`, provide simple JSON structured logging. ## 0.3.0.0 -- 2020-12-29 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) Project Z Contributors, 2017-2020 +Copyright (c) Z.Haskell Contributors, 2017-2020 All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,12 +1,12 @@ ## Z-IO [![Hackage](https://img.shields.io/hackage/v/Z-IO.svg?style=flat)](https://hackage.haskell.org/package/Z-IO) -[![Linux Build Status](https://github.com/haskell-Z/z-io/workflows/ubuntu-ci/badge.svg)](https://github.com/haskell-Z/z-io/actions) -[![MacOS Build Status](https://github.com/haskell-Z/z-io/workflows/osx-ci/badge.svg)](https://github.com/haskell-Z/z-io/actions) -[![Windows Build Status](https://github.com/haskell-Z/z-io/workflows/win-ci/badge.svg)](https://github.com/haskell-Z/z-io/actions) -[![Docker Build Status](https://github.com/haskell-Z/z-io/workflows/docker-ci/badge.svg)](https://github.com/haskell-Z/z-io/actions) +[![Linux Build Status](https://github.com/ZHaskell/z-io/workflows/ubuntu-ci/badge.svg)](https://github.com/ZHaskell/z-io/actions) +[![MacOS Build Status](https://github.com/ZHaskell/z-io/workflows/osx-ci/badge.svg)](https://github.com/ZHaskell/z-io/actions) +[![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) -This package is part of [Z](https://github.com/haskell-Z/Z) project, provides basic IO operations: +This package is part of [Z.Haskell](https://github.com/ZHaskell/Z) project, provides basic IO operations: * IO resource management, resource pool * File system operations @@ -62,7 +62,7 @@ ```bash # get code -git clone --recursive git@github.com:haskell-Z/z-io.git +git clone --recursive git@github.com:ZHaskell/z-io.git cd z-io # build cabal build diff --git a/Z-IO.cabal b/Z-IO.cabal --- a/Z-IO.cabal +++ b/Z-IO.cabal @@ -1,23 +1,26 @@ cabal-version: 2.4 name: Z-IO -version: 0.5.0.0 +version: 0.6.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! license: BSD-3-Clause license-file: LICENSE -author: Dong Han, Tao He +author: Z.Haskell Contributors maintainer: winterland1989@gmail.com -copyright: (c) Project Z Contributors +copyright: (c) Z.Haskell Contributors category: Data build-type: Simple -homepage: https://github.com/haskell-Z/Z-IO -bug-reports: https://github.com/haskell-Z/Z-IO/issues +homepage: https://github.com/ZHaskell/Z-IO +bug-reports: https://github.com/ZHaskell/Z-IO/issues extra-source-files: ChangeLog.md README.md LICENSE + -- shared Haskell soruce + Z/IO/FileSystem/_Shared.hs + -- zlib C sources third_party/zlib/crc32.h third_party/zlib/inffast.h @@ -75,7 +78,7 @@ source-repository head type: git - location: git://github.com/haskell-Z/Z-IO.git + location: git://github.com/ZHaskell/Z-IO.git flag no-pkg-config description: Don't use pkg-config to check for library dependences(on platforms other than linux, win and osx) @@ -89,8 +92,9 @@ Z.IO.BIO.Concurrent Z.IO.FileSystem - Z.IO.FileSystem.FilePath + Z.IO.FileSystem.Base Z.IO.FileSystem.Threaded + Z.IO.FileSystem.FilePath Z.IO.FileSystem.Watch Z.IO.Network.SocketAddr @@ -125,7 +129,7 @@ , stm == 2.5.* , unordered-containers == 0.2.* , containers == 0.6.* - , Z-Data == 0.5.* + , Z-Data == 0.6.* , time >= 1.9 && <= 2.0 , unix-time >= 0.4.7 && <= 0.5 diff --git a/Z/IO/BIO.hs b/Z/IO/BIO.hs --- a/Z/IO/BIO.hs +++ b/Z/IO/BIO.hs @@ -108,7 +108,7 @@ 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.Base as FS import Z.IO.Resource -- | A 'BIO'(blocked IO) node. @@ -496,7 +496,7 @@ initSourceFromFile :: HasCallStack => CBytes -> Resource (Source V.Bytes) {-# INLINABLE initSourceFromFile #-} initSourceFromFile p = do - f <- FS.initFile p FS.O_RDONLY FS.DEFAULT_MODE + f <- FS.initFile p FS.O_RDONLY FS.DEFAULT_FILE_MODE liftIO (sourceFromInput f) -- | Turn input device into a packet source. @@ -547,7 +547,7 @@ 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_MODE + f <- FS.initFile p (FS.O_APPEND .|. FS.O_CREAT .|. FS.O_WRONLY) FS.DEFAULT_FILE_MODE liftIO (sinkToOutput f) -- | Turn an 'Output' into 'B.Builder' sink. diff --git a/Z/IO/BIO/Concurrent.hs b/Z/IO/BIO/Concurrent.hs --- a/Z/IO/BIO/Concurrent.hs +++ b/Z/IO/BIO/Concurrent.hs @@ -25,6 +25,9 @@ @ (sink, src) <- newTQueueNode 2 -- it's important to correctly set the numebr of producers +-------------------------------------------------------------------------------- +-- producers + forkIO $ do ... push x sink -- producer using push @@ -35,6 +38,10 @@ ... (runBIO $ ... >|> sink) -- producer using BIO `onException` (pull sink) + +-------------------------------------------------------------------------------- +-- consumers + forkIO $ do ... r <- pull src -- consumer using pull diff --git a/Z/IO/BIO/Zlib.hsc b/Z/IO/BIO/Zlib.hsc --- a/Z/IO/BIO/Zlib.hsc +++ b/Z/IO/BIO/Zlib.hsc @@ -7,7 +7,14 @@ Stability : experimental Portability : non-portable -This module provides bindings, with 'BIO' streaming interface. +This module provides bindings, with 'BIO' streaming interface, e.g. + +@ +-- add compressor to your BIO chain to compress streaming blocks of 'V.Bytes'. +(_, zlibCompressor) <- newCompress defaultCompressConfig{compressWindowBits = 31} +runBIO $ src >|> zlibCompressor >|> sink +@ + -} module Z.IO.BIO.Zlib( diff --git a/Z/IO/Exception.hs b/Z/IO/Exception.hs --- a/Z/IO/Exception.hs +++ b/Z/IO/Exception.hs @@ -61,6 +61,9 @@ , throwOOMIfNull , throwUVIfMinus , throwUVIfMinus_ + , throwUVIf + , throwUVIf_ + , throwUV , throwECLOSED , throwECLOSEDSTM , throwUVError @@ -78,7 +81,7 @@ import Control.Concurrent.STM import Control.Exception hiding (IOException) import Control.Monad -import Data.Typeable (Typeable, cast) +import Data.Typeable (cast) import Foreign.C.Types import Foreign.Ptr import GHC.Stack @@ -143,37 +146,35 @@ else return addr -- | Throw appropriate IO exception if return value < 0 (libuv's convention). --- +{-# INLINABLE throwUVIfMinus #-} throwUVIfMinus :: (HasCallStack, Integral a) => IO a -- ^ the IO action -> IO a -{-# INLINABLE throwUVIfMinus #-} -throwUVIfMinus f = do - errno <- f - let errno' = fromIntegral errno - if errno' < 0 - then do - name <- uvErrName errno' - desc <- uvStdError errno' - throwUVError errno' (IOEInfo name desc callStack) - else return errno +throwUVIfMinus f = throwUVIf f (< 0) -- | Throw appropriate IO exception if return value < 0, otherwise ignore the result. --- +{-# INLINABLE throwUVIfMinus_ #-} throwUVIfMinus_ :: (HasCallStack, Integral a) => IO a -- ^ the IO action -> IO () -{-# INLINABLE throwUVIfMinus_ #-} -throwUVIfMinus_ f = do +throwUVIfMinus_ f = throwUVIf_ f (< 0) + +-- | Throw appropriate IO exception if condition is true. +throwUVIf :: (HasCallStack, Integral a) => IO a -> (a -> Bool) -> IO a +{-# INLINABLE throwUVIf #-} +throwUVIf f cond = do errno <- f - let errno' = fromIntegral errno - when (errno' < 0) $ do - name <- uvErrName errno' - desc <- uvStdError errno' - throwUVError errno' (IOEInfo name desc callStack) + if cond errno + then throwUV errno + else return errno +-- | Throw appropriate IO exception if condition is true, otherwise ignore the +-- result. +throwUVIf_ :: (HasCallStack, Integral a) => IO a -> (a -> Bool) -> IO () +{-# INLINABLE throwUVIf_ #-} +throwUVIf_ f cond = void $ throwUVIf f cond + -- | Throw 'ResourceVanished' with name 'ECLOSED' and description 'resource is closed'. --- throwECLOSED :: HasCallStack => IO a {-# INLINABLE throwECLOSED #-} throwECLOSED = throwIO (ResourceVanished @@ -202,7 +203,7 @@ unwrap' :: HasCallStack => T.Text -> T.Text -> Maybe a -> IO a {-# INLINABLE unwrap' #-} unwrap' _ _ (Just x) = return x -unwrap' n d Nothing = throwOtherError n d +unwrap' n d Nothing = throwOtherError n d -------------------------------------------------------------------------------- @@ -226,7 +227,17 @@ T.stringUTF8 (prettyCallStack cstack) "}" +-- | Throw a UV Exception with given libuv's errno. +throwUV :: (Integral a, HasCallStack) => a -> IO b +{-# INLINABLE throwUV #-} +throwUV e = do + let e' = fromIntegral e + name <- uvErrName e' + desc <- uvStdError e' + throwUVError e' (IOEInfo name desc callStack) + throwUVError :: CInt -> IOEInfo -> IO a +{-# INLINABLE throwUVError #-} throwUVError e info = case e of UV_EOF -> throwIO (EOF info) UV_E2BIG -> throwIO (ResourceExhausted info) diff --git a/Z/IO/FileSystem.hs b/Z/IO/FileSystem.hs --- a/Z/IO/FileSystem.hs +++ b/Z/IO/FileSystem.hs @@ -1,601 +1,27 @@ {-| -Module : Z.IO.FileSystem -Description : Filesystem IO -Copyright : (c) Dong Han, 2017-2020 +Module : Z.IO.Network +Description : FileSystem Umbrella module +Copyright : (c) Song Xue, Dong Han, 2020 License : BSD Maintainer : winterland1989@gmail.com Stability : experimental Portability : non-portable -This module provide IO operations related to filesystem, operations are implemented using unsafe FFIs, which should be prefered when the operations' estimated time is short(<1ms), which is much common on modern SSDs. +Umbrella module to export everything you need to start using file. -} module Z.IO.FileSystem - ( -- * regular file devices - File, initFile, readFileP, writeFileP, getFileFD, seek - , readFile, readTextFile, writeFile, writeTextFile - , readJSONFile, writeJSONFile - -- * file offset bundle - , FilePtr, newFilePtr, getFilePtrOffset, setFilePtrOffset - -- * filesystem operations - , mkdir, mkdirp - , unlink - , mkdtemp - , rmdir, rmdirrf - , DirEntType(..) - , scandir - , scandirRecursively - , FStat(..), UVTimeSpec(..) - , stat, lstat, fstat - , isLink, isDir, isFile - , rename - , fsync, fdatasync - , ftruncate - , copyfile - , AccessResult(..) - , access - , chmod, fchmod - , utime, futime, lutime - , link, symlink - , readlink, realpath - , chown, fchown, lchown - -- * opening constant - -- ** AccessMode - , AccessMode - , pattern F_OK - , pattern R_OK - , pattern W_OK - , pattern X_OK - -- ** FileMode - , FileMode - , pattern DEFAULT_MODE - , pattern S_IRWXU - , pattern S_IRUSR - , pattern S_IWUSR - , pattern S_IXUSR - , pattern S_IRWXG - , pattern S_IRGRP - , pattern S_IWGRP - , pattern S_IXGRP - , pattern S_IRWXO - , pattern S_IROTH - -- ** file type constant - , pattern S_IFMT - , pattern S_IFLNK - , pattern S_IFDIR - , pattern S_IFREG - -- ** FileFlag - , FileFlag - , pattern O_APPEND - , pattern O_CREAT - , pattern O_DIRECT - , pattern O_DSYNC - , pattern O_EXCL - , pattern O_EXLOCK - , pattern O_NOATIME - , pattern O_NOFOLLOW - , pattern O_RDONLY - , pattern O_RDWR - , pattern O_SYMLINK - , pattern O_SYNC - , pattern O_TRUNC - , pattern O_WRONLY - , pattern O_RANDOM - , pattern O_SHORT_LIVED - , pattern O_SEQUENTIAL - , pattern O_TEMPORARY - -- ** CopyFileFlag - , CopyFileFlag - , pattern COPYFILE_DEFAULT - , pattern COPYFILE_EXCL - , pattern COPYFILE_FICLONE - , pattern COPYFILE_FICLONE_FORCE - -- ** SymlinkFlag - , SymlinkFlag - , pattern SYMLINK_DEFAULT - , pattern SYMLINK_DIR - , pattern SYMLINK_JUNCTION - -- ** Whence - , Whence - , pattern SEEK_SET - , pattern SEEK_CUR - , pattern SEEK_END - ) where - -import Control.Monad -import Data.Bits -import Data.Int -import Data.IORef -import Data.Word -import Foreign.Ptr -import Foreign.Storable (peekElemOff) -import Foreign.Marshal.Alloc (allocaBytes) -import Z.Data.CBytes as CBytes -import Z.Data.PrimRef.PrimIORef -import qualified Z.Data.Text as T -import qualified Z.Data.Text.Print as T -import qualified Z.Data.Vector as V -import qualified Z.Data.JSON as JSON -import Z.Foreign -import Z.IO.Buffered -import Z.IO.Exception -import qualified Z.IO.FileSystem.FilePath as P -import Z.IO.Resource -import Z.IO.UV.FFI -import Prelude hiding (writeFile, readFile) - --------------------------------------------------------------------------------- --- File - --- | 'File' and its operations are NOT thread safe, use 'MVar' 'File' in multiple threads --- --- libuv implements read and write method with both implict and explict offset capable. --- Implict offset interface is provided by 'Input' \/ 'Output' instances. --- Explict offset interface is provided by 'readFileP' \/ 'writeFileP'. --- -data File = File {-# UNPACK #-} !FD -- ^ the file - {-# UNPACK #-} !(IORef Bool) -- ^ closed flag - -instance Show File where show = T.toString - -instance T.Print File where - toUTF8BuilderP _ (File fd _) = "File " >> T.int fd - --- | Return File fd. -getFileFD :: File -> IO FD -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 -checkFileClosed (File fd closedRef) f = do - closed <- readIORef closedRef - if closed then throwECLOSED else f fd - --- | Set file's system offset. --- --- Equivalent to . -seek :: HasCallStack => File -> Int64 -> Whence -> IO Int64 -seek uvf off w = checkFileClosed uvf $ \ fd -> throwUVIfMinus $ hs_seek fd off w - -instance Input File where - -- readInput :: HasCallStack => File -> Ptr Word8 -> Int -> IO Int - -- use -1 offset to use fd's default offset - readInput f buf bufSiz = readFileP f buf bufSiz (-1) - --- | Read file with given offset --- --- Read length may be smaller than buffer size. -readFileP :: HasCallStack - => File - -> Ptr Word8 -- ^ buffer - -> Int -- ^ buffer size - -> Int64 -- ^ file offset, pass -1 to use default(system) offset - -> IO Int -- ^ read length -readFileP uvf buf bufSiz off = - checkFileClosed uvf $ \ fd -> throwUVIfMinus $ hs_uv_fs_read fd buf bufSiz off - -instance Output File where - writeOutput f buf bufSiz = writeFileP f buf bufSiz (-1) - --- | Write buffer to file --- --- This function will loop until all bytes are written. --- --- Note on linux files opened with 'O_APPEND' behave differently since this function use @pwrite@: --- --- @ --- POSIX requires that opening a file with the O_APPEND flag should have no effect --- on the location at which pwrite() writes data. However, on Linux, --- if a file is opened with O_APPEND, pwrite() appends data to the end of the file, --- regardless of the value of offset. --- @ -writeFileP :: HasCallStack - => File - -> Ptr Word8 -- ^ buffer - -> Int -- ^ buffer size - -> Int64 -- ^ file offset, pass -1 to use default(system) offset - -> IO () -writeFileP uvf buf0 bufSiz0 off0 = - checkFileClosed uvf $ \fd -> if off0 == -1 then go fd buf0 bufSiz0 - else go' fd buf0 bufSiz0 off0 - where - go fd !buf !bufSiz = do - written <- throwUVIfMinus (hs_uv_fs_write fd buf bufSiz (-1)) - when (written < bufSiz) - (go fd (buf `plusPtr` written) (bufSiz-written)) - - go' fd !buf !bufSiz !off = do - written <- throwUVIfMinus (hs_uv_fs_write fd buf bufSiz off) - when (written < bufSiz) $ - go' fd (buf `plusPtr` written) - (bufSiz-written) - (off+fromIntegral written) - --- | File bundled with offset. --- --- Reading or writing using 'Input' \/ 'Output' instance will automatically increase offset. --- 'FilePtr' and its operations are NOT thread safe, use 'MVar' 'FilePtr' in multiple threads. --- --- The notes on linux 'writeFileP' applied to 'FilePtr' too. -data FilePtr = FilePtr {-# UNPACK #-} !File - {-# UNPACK #-} !(PrimIORef 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 - --- | Get current offset. -getFilePtrOffset :: FilePtr -> IO Int64 -getFilePtrOffset (FilePtr _ offsetRef) = readPrimIORef offsetRef - --- | Change current offset. -setFilePtrOffset :: FilePtr -> Int64 -> IO () -setFilePtrOffset (FilePtr _ offsetRef) = writePrimIORef offsetRef - -instance Input FilePtr where - readInput (FilePtr file offsetRef) buf bufSiz = - readPrimIORef offsetRef >>= \ off -> do - l <- readFileP file buf bufSiz off - writePrimIORef offsetRef (off + fromIntegral l) - return l - -instance Output FilePtr where - writeOutput (FilePtr file offsetRef) buf bufSiz = - readPrimIORef offsetRef >>= \ off -> do - writeFileP file buf bufSiz off - writePrimIORef offsetRef (off + fromIntegral bufSiz) - --------------------------------------------------------------------------------- - --- | init a file 'Resource', which open a file when used. --- --- Resource closing is thread safe, on some versions of OSX, repeatly open and close same file 'Resource' may --- result in shared memory object error, use 'O_CREAT' to avoid that. -initFile :: HasCallStack - => CBytes - -> FileFlag -- ^ Opening flags, e.g. 'O_CREAT' @.|.@ 'O_RDWR' - -> FileMode -- ^ Sets the file mode (permission and sticky bits), - -- but only if the file was created, see 'DEFAULT_MODE'. - -> Resource File -initFile path flags mode = - initResource - (do !fd <- withCBytesUnsafe path $ \ p -> - throwUVIfMinus $ hs_uv_fs_open p flags mode - File fd <$> newIORef False) - (\ (File fd closedRef) -> do - closed <- readIORef closedRef - unless closed $ do - throwUVIfMinus_ (hs_uv_fs_close fd) - writeIORef closedRef True) - --- | Quickly open a file and read its content. -readFile :: HasCallStack => CBytes -> IO V.Bytes -readFile filename = do - withResource (initFile filename O_RDONLY DEFAULT_MODE) $ \ file -> do - readAll' =<< newBufferedInput file - --- | Quickly open a file and read its content as UTF8 text. -readTextFile :: HasCallStack => CBytes -> IO T.Text -readTextFile filename = T.validate <$> readFile filename - --- | Quickly open a file and write some content. -writeFile :: HasCallStack => CBytes -> V.Bytes -> IO () -writeFile filename content = do - withResource (initFile filename (O_WRONLY .|. O_CREAT) DEFAULT_MODE) $ \ file -> do - withPrimVectorSafe content (writeOutput file) - --- | Quickly open a file and write some content as UTF8 text. -writeTextFile :: HasCallStack => CBytes -> T.Text -> IO () -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 -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 () -writeJSONFile filename x = writeFile filename (JSON.encode x) - --------------------------------------------------------------------------------- - --- | Equivalent to . --- --- 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 () -mkdir path mode = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> - hs_uv_fs_mkdir p mode - --- | Equivalent to @mkdir -p@ --- --- Note mode is currently not implemented on Windows. On unix you should set execute bit --- if you want the directory is accessable(so that child folder can be created), e.g. 0o777. -mkdirp :: HasCallStack => CBytes -> FileMode -> IO () -mkdirp path mode = do - r <- withCBytesUnsafe path $ \ p -> hs_uv_fs_mkdir p mode - if fromIntegral r == UV_ENOENT - then do - (root, segs) <- P.splitSegments path - case segs of - seg:segs' -> loop segs' =<< P.join root seg - _ -> throwUVIfMinus_ (return r) - else throwUVIfMinus_ (return r) - where - loop segs p = do - a <- access p F_OK - case a of - AccessOK -> return () - NoExistence -> mkdir p mode - NoPermission -> throwUVIfMinus_ (return UV_EACCES) - case segs of - (nextp:ps) -> P.join p nextp >>= loop ps - _ -> return () - --- | Equivalent to . -unlink :: HasCallStack => CBytes -> IO () -unlink path = throwUVIfMinus_ (withCBytesUnsafe path hs_uv_fs_unlink) - --- | Equivalent to --- --- Creates a temporary directory in the most secure manner possible. --- There are no race conditions in the directory’s creation. --- The directory is readable, writable, and searchable only by the creating user ID. --- The user of mkdtemp() is responsible for deleting the temporary directory and --- its contents when done with it. --- --- Note: the argument is the prefix of the temporary directory, --- so no need to add XXXXXX ending. --- -mkdtemp :: HasCallStack => CBytes -> IO CBytes -mkdtemp path = do - let size = CBytes.length path - withCBytesUnsafe path $ \ p -> do - (p',_) <- CBytes.allocCBytesUnsafe (size+7) $ \ p' -> do -- we append "XXXXXX\NUL" in C - throwUVIfMinus_ (hs_uv_fs_mkdtemp p size p') - return p' - --- | Equivalent to . --- --- Note this function may inherent OS limitations such as argument must be an empty folder. -rmdir :: HasCallStack => CBytes -> IO () -rmdir path = throwUVIfMinus_ (withCBytesUnsafe path hs_uv_fs_rmdir) - --- | Equivalent to @rmdir -rf@ --- --- This function will try to remove folder and files contained by it. -rmdirrf :: HasCallStack => CBytes -> IO () -rmdirrf path = do - ds <- scandir path - forM_ ds $ \ (d, t) -> do - if t /= DirEntDir - then unlink d - else rmdirrf =<< path `P.join` d - rmdir path - --- | Equivalent to . --- --- Note Unlike scandir(3), this function does not return the “.” and “..” entries. --- --- 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 man page. -scandir :: HasCallStack => CBytes -> IO [(CBytes, DirEntType)] -scandir path = do - bracket - (withCBytesUnsafe path $ \ p -> - allocPrimUnsafe $ \ dents -> - throwUVIfMinus (hs_uv_fs_scandir p dents)) - (\ (dents, n) -> hs_uv_fs_scandir_cleanup dents n) - (\ (dents, n) -> forM [0..n-1] $ \ i -> do - dent <- peekElemOff dents i - (p, typ) <- peekUVDirEnt dent - let !typ' = fromUVDirEntType typ - !p' <- fromCString p - return (p', typ')) - --- | Find all files and directories within a given directory with a predicator. --- --- @ --- import Z.IO.FileSystem.FilePath (splitExtension) --- -- find all haskell source file within current dir --- scandirRecursively "." (\\ p _ -> (== ".hs") . snd \<$\> splitExtension p) --- @ -scandirRecursively :: HasCallStack => CBytes -> (CBytes -> DirEntType -> IO Bool) -> IO [CBytes] -scandirRecursively dir p = loop [] =<< P.normalize dir - where - loop acc0 pdir = - foldM (\ acc (d,t) -> do - d' <- pdir `P.join` d - r <- p d' t - let acc' = if r then (d':acc) else acc - if (t == DirEntDir) - then loop acc' d' - else return acc' - ) acc0 =<< scandir pdir - --------------------------------------------------------------------------------- - --- | Equivalent to -stat :: HasCallStack => CBytes -> IO FStat -stat path = withCBytesUnsafe path $ \ p -> - allocaBytes uvStatSize $ \ s -> do - throwUVIfMinus_ (hs_uv_fs_stat p s) - peekUVStat s - --- | Equivalent to -lstat :: HasCallStack => CBytes -> IO FStat -lstat path = withCBytesUnsafe path $ \ p -> - allocaBytes uvStatSize $ \ s -> do - throwUVIfMinus_ (hs_uv_fs_lstat p s) - peekUVStat s - --- | Equivalent to -fstat :: HasCallStack => File -> IO FStat -fstat uvf = checkFileClosed uvf $ \ fd -> - allocaBytes uvStatSize $ \ s -> do - throwUVIfMinus_ (hs_uv_fs_fstat fd s) - peekUVStat s - --- | If given path is a symbolic link? -isLink :: HasCallStack => CBytes -> IO Bool -isLink p = lstat p >>= \ st -> return (stMode st .&. S_IFMT == S_IFLNK) - --- | If given path is a directory or a symbolic link to a directory? -isDir :: HasCallStack => CBytes -> IO Bool -isDir p = stat p >>= \ st -> return (stMode st .&. S_IFMT == S_IFDIR) - --- | If given path is a file or a symbolic link to a file? -isFile :: HasCallStack => CBytes -> IO Bool -isFile p = stat p >>= \ st -> return (stMode st .&. S_IFMT == S_IFREG) - --------------------------------------------------------------------------------- - --- | Equivalent to . --- --- 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 () -rename path path' = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> - withCBytesUnsafe path' (hs_uv_fs_rename p) - --- | Equivalent to . -fsync :: HasCallStack => File -> IO () -fsync uvf = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fsync fd - --- | Equivalent to . -fdatasync :: HasCallStack => File -> IO () -fdatasync uvf = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fdatasync fd - --- | Equivalent to . -ftruncate :: HasCallStack => File -> Int64 -> IO () -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 () -copyfile path path' flag = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> - withCBytesUnsafe path' $ \ p' -> hs_uv_fs_copyfile p p' flag - --- | Equivalent to on Unix. --- --- Windows uses GetFileAttributesW(). -access :: HasCallStack => CBytes -> AccessMode -> IO AccessResult -access path mode = do - r <- withCBytesUnsafe path $ \ p -> fromIntegral <$> hs_uv_fs_access p mode - if | r == 0 -> return AccessOK - | r == UV_ENOENT -> return NoExistence - | r == UV_EACCES -> return NoPermission - | otherwise -> do - name <- uvErrName r - desc <- uvStdError r - throwUVError r (IOEInfo name desc callStack) - --- | Equivalent to . -chmod :: HasCallStack => CBytes -> FileMode -> IO () -chmod path mode = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_chmod p mode - --- | Equivalent to . -fchmod :: HasCallStack => File -> FileMode -> IO () -fchmod uvf mode = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fchmod fd mode - --- | Equivalent to . --- --- libuv choose 'Double' type due to cross platform concerns, we only provide micro-second precision. -utime :: HasCallStack - => CBytes - -> Double -- ^ atime, i.e. access time - -> Double -- ^ mtime, i.e. modify time - -> IO () -utime path atime mtime = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_utime p atime mtime - --- | Equivalent to . --- --- Same precision notes with 'utime'. -futime :: HasCallStack => File -> Double -> Double -> IO () -futime uvf atime mtime = checkFileClosed uvf $ \ fd -> - throwUVIfMinus_ (hs_uv_fs_futime fd atime mtime) - --- | Equivalent to . --- --- Same precision notes with 'utime'. -lutime :: HasCallStack - => CBytes - -> Double -- ^ atime, i.e. access time - -> Double -- ^ mtime, i.e. modify time - -> IO () -lutime path atime mtime = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_lutime p atime mtime - --- | Equivalent to . -link :: HasCallStack => CBytes -> CBytes -> IO () -link path path' = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> - withCBytesUnsafe path' $ hs_uv_fs_link p - --- | Equivalent to . --- --- | Note On Windows the flags parameter can be specified to control how the symlink will be created. --- --- * 'SYMLINK_DIR': indicates that path points to a directory. --- * 'SYMLINK_JUNCTION': request that the symlink is created using junction points. --- --- On other platforms these flags are ignored. -symlink :: HasCallStack => CBytes -> CBytes -> SymlinkFlag -> IO () -symlink path path' flag = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> - withCBytesUnsafe path' $ \ p' -> hs_uv_fs_symlink p p' flag - --- | Equivalent to . -readlink :: HasCallStack => CBytes -> IO CBytes -readlink path = do - bracket - (withCBytesUnsafe path $ \ p -> - allocPrimUnsafe $ \ p' -> - throwUVIfMinus (hs_uv_fs_readlink p p')) - (hs_uv_fs_readlink_cleanup . fst) - (fromCString . fst) - - --- | Equivalent to on Unix. Windows uses . --- --- Warning This function has certain platform-specific caveats that were discovered when used in Node. --- --- * macOS and other BSDs: this function will fail with UV_ELOOP if more than 32 symlinks are found while --- resolving the given path. This limit is hardcoded and cannot be sidestepped. --- --- * Windows: while this function works in the common case, there are a number of corner cases where it doesn’t: --- --- * Paths in ramdisk volumes created by tools which sidestep the Volume Manager (such as ImDisk) cannot be resolved. --- * Inconsistent casing when using drive letters. --- * Resolved path bypasses subst’d drives. --- --- While this function can still be used, it’s not recommended if scenarios such as the above need to be supported. --- The background story and some more details on these issues can be checked . --- --- 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 -realpath path = do - bracket - (withCBytesUnsafe path $ \ p -> - allocPrimUnsafe $ \ p' -> - throwUVIfMinus (hs_uv_fs_realpath p p')) - (hs_uv_fs_readlink_cleanup . fst) - (fromCString . fst) - --- | Equivalent to . -chown :: HasCallStack => CBytes -> UID -> GID -> IO () -chown path uid gid = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_chown p uid gid - --- | Equivalent to . -fchown :: HasCallStack => File -> UID -> GID -> IO () -fchown uvf uid gid = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fchown fd uid gid + ( -- * Basic Operations + module Z.IO.FileSystem.Base --- | Equivalent to . -lchown :: HasCallStack => CBytes -> UID -> GID -> IO () -lchown path uid gid = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_lchown p uid gid + -- * FilePath + , module Z.IO.FileSystem.FilePath --------------------------------------------------------------------------------- --- high level utilities + -- * FileWatch + , module Z.IO.FileSystem.Watch + ) where +import Z.IO.FileSystem.Base +import Z.IO.FileSystem.FilePath +import Z.IO.FileSystem.Watch diff --git a/Z/IO/FileSystem/Base.hs b/Z/IO/FileSystem/Base.hs new file mode 100644 --- /dev/null +++ b/Z/IO/FileSystem/Base.hs @@ -0,0 +1,570 @@ +{-| +Module : Z.IO.FileSystem.Base +Description : Filesystem IO +Copyright : (c) Dong Han, 2017-2020 +License : BSD +Maintainer : winterland1989@gmail.com +Stability : experimental +Portability : non-portable + +This module provide IO operations related to filesystem, operations are +implemented using unsafe FFIs, which should be prefered when the operations' +estimated time is short(<1ms), which is much common on modern SSDs. +-} +module Z.IO.FileSystem.Base + ( -- * Regular file devices + File, initFile, readFileP, writeFileP, getFileFD, seek + , readFile, readTextFile, writeFile, writeTextFile + , readJSONFile, writeJSONFile + -- * file offset bundle + , FilePtr, newFilePtr, getFilePtrOffset, setFilePtrOffset + -- * Filesystem operations + , mkdir, mkdirp + , unlink + , mkdtemp, mkstemp , initTempFile, initTempDir + , rmdir, rmrf + , DirEntType(..) + , scandir + , scandirRecursively + -- ** File stats + , FStat(..), UVTimeSpec(..) + , doesPathExist, doesFileExist, doesDirExist + , isLink, isDir, isFile + , isLinkSt, isDirSt, isFileSt + , stat, lstat, fstat + , stat', lstat' + , rename + , fsync, fdatasync + , ftruncate + , copyfile + , AccessResult(..) + , access + , chmod, fchmod + , utime, futime, lutime + , link, symlink + , readlink, realpath + , chown, fchown, lchown + -- * opening constant + -- ** AccessMode + , AccessMode + , pattern F_OK + , pattern R_OK + , pattern W_OK + , pattern X_OK + -- ** FileMode + , FileMode + , pattern DEFAULT_FILE_MODE + , pattern DEFAULT_DIR_MODE + , pattern S_IRWXU + , pattern S_IRUSR + , pattern S_IWUSR + , pattern S_IXUSR + , pattern S_IRWXG + , pattern S_IRGRP + , pattern S_IWGRP + , pattern S_IXGRP + , pattern S_IRWXO + , pattern S_IROTH + -- ** file type constant + , pattern S_IFMT + , pattern S_IFLNK + , pattern S_IFDIR + , pattern S_IFREG + -- ** FileFlag + , FileFlag + , pattern O_APPEND + , pattern O_CREAT + , pattern O_DIRECT + , pattern O_DSYNC + , pattern O_EXCL + , pattern O_EXLOCK + , pattern O_NOATIME + , pattern O_NOFOLLOW + , pattern O_RDONLY + , pattern O_RDWR + , pattern O_SYMLINK + , pattern O_SYNC + , pattern O_TRUNC + , pattern O_WRONLY + , pattern O_RANDOM + , pattern O_SHORT_LIVED + , pattern O_SEQUENTIAL + , pattern O_TEMPORARY + -- ** CopyFileFlag + , CopyFileFlag + , pattern COPYFILE_DEFAULT + , pattern COPYFILE_EXCL + , pattern COPYFILE_FICLONE + , pattern COPYFILE_FICLONE_FORCE + -- ** SymlinkFlag + , SymlinkFlag + , pattern SYMLINK_DEFAULT + , pattern SYMLINK_DIR + , pattern SYMLINK_JUNCTION + -- ** Whence + , Whence + , pattern SEEK_SET + , pattern SEEK_CUR + , pattern SEEK_END + ) where + +import Control.Monad +import Data.Bits +import Data.IORef +import Data.Int +import Data.Word +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Ptr +import Foreign.Storable (peekElemOff) +import Prelude hiding (readFile, writeFile) +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 qualified Z.Data.Text as T +import qualified Z.Data.Text.Print as T +import qualified Z.Data.Vector as V +import Z.Foreign +import Z.IO.Buffered +import qualified Z.IO.Environment as Env +import Z.IO.Exception +import qualified Z.IO.FileSystem.FilePath as P +import Z.IO.Resource +import Z.IO.UV.FFI + +#include "_Shared.hs" + +-------------------------------------------------------------------------------- +-- File + +-- | 'File' and its operations are NOT thread safe, use 'MVar' 'File' in multiple threads +-- +-- libuv implements read and write method with both implict and explict offset capable. +-- Implict offset interface is provided by 'Input' \/ 'Output' instances. +-- Explict offset interface is provided by 'readFileP' \/ 'writeFileP'. +-- +data File = File {-# UNPACK #-} !FD -- ^ the file + {-# UNPACK #-} !(IORef Bool) -- ^ closed flag + +instance Show File where show = T.toString + +instance T.Print File where + toUTF8BuilderP _ (File fd _) = "File " >> T.int fd + +-- | Return File fd. +getFileFD :: File -> IO FD +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 +checkFileClosed (File fd closedRef) f = do + closed <- readIORef closedRef + if closed then throwECLOSED else f fd + +-- | Set file's system offset. +-- +-- Equivalent to . +seek :: HasCallStack => File -> Int64 -> Whence -> IO Int64 +seek uvf off w = checkFileClosed uvf $ \ fd -> throwUVIfMinus $ hs_seek fd off w + +instance Input File where + -- readInput :: HasCallStack => File -> Ptr Word8 -> Int -> IO Int + -- use -1 offset to use fd's default offset + readInput f buf bufSiz = readFileP f buf bufSiz (-1) + +-- | Read file with given offset +-- +-- Read length may be smaller than buffer size. +readFileP :: HasCallStack + => File + -> Ptr Word8 -- ^ buffer + -> Int -- ^ buffer size + -> Int64 -- ^ file offset, pass -1 to use default(system) offset + -> IO Int -- ^ read length +readFileP uvf buf bufSiz off = + checkFileClosed uvf $ \ fd -> throwUVIfMinus $ hs_uv_fs_read fd buf bufSiz off + +instance Output File where + writeOutput f buf bufSiz = writeFileP f buf bufSiz (-1) + +-- | Write buffer to file +-- +-- This function will loop until all bytes are written. +-- +-- Note on linux files opened with 'O_APPEND' behave differently since this function use @pwrite@: +-- +-- @ +-- POSIX requires that opening a file with the O_APPEND flag should have no effect +-- on the location at which pwrite() writes data. However, on Linux, +-- if a file is opened with O_APPEND, pwrite() appends data to the end of the file, +-- regardless of the value of offset. +-- @ +writeFileP :: HasCallStack + => File + -> Ptr Word8 -- ^ buffer + -> Int -- ^ buffer size + -> Int64 -- ^ file offset, pass -1 to use default(system) offset + -> IO () +writeFileP uvf buf0 bufSiz0 off0 = + checkFileClosed uvf $ \fd -> if off0 == -1 then go fd buf0 bufSiz0 + else go' fd buf0 bufSiz0 off0 + where + go fd !buf !bufSiz = do + written <- throwUVIfMinus (hs_uv_fs_write fd buf bufSiz (-1)) + when (written < bufSiz) + (go fd (buf `plusPtr` written) (bufSiz-written)) + + go' fd !buf !bufSiz !off = do + written <- throwUVIfMinus (hs_uv_fs_write fd buf bufSiz off) + when (written < bufSiz) $ + go' fd (buf `plusPtr` written) + (bufSiz-written) + (off+fromIntegral written) + + +-------------------------------------------------------------------------------- + +-- | init a file 'Resource', which open a file when used. +-- +-- Resource closing is thread safe, on some versions of OSX, repeatly open and close same file 'Resource' may +-- result in shared memory object error, use 'O_CREAT' to avoid that. +initFile :: HasCallStack + => CBytes + -> FileFlag -- ^ Opening flags, e.g. 'O_CREAT' @.|.@ 'O_RDWR' + -> FileMode -- ^ Sets the file mode (permission and sticky bits), + -- but only if the file was created, see 'DEFAULT_FILE_MODE'. + -> Resource File +initFile path flags mode = + initResource + (do !fd <- withCBytesUnsafe path $ \ p -> + throwUVIfMinus $ hs_uv_fs_open p flags mode + File fd <$> newIORef False) + (\ (File fd closedRef) -> do + closed <- readIORef closedRef + unless closed $ do + throwUVIfMinus_ (hs_uv_fs_close fd) + writeIORef closedRef True) + +-------------------------------------------------------------------------------- + +-- | Create a directory named path with numeric mode 'FileMode'. +-- +-- Equivalent to . +-- +-- 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 () +mkdir path mode = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> + hs_uv_fs_mkdir p mode + +-- | Recursive directory creation function. Like 'mkdir', but makes all +-- intermediate-level directories needed to contain the leaf directory. +-- +-- Equivalent to @mkdir -p@, +-- +-- Note mode is currently not implemented on Windows. On unix you should set +-- execute bit if you want the directory is accessable(so that child folder +-- can be created), e.g. 'DEFAULT_DIR_MODE'. +-- +mkdirp :: HasCallStack => CBytes -> FileMode -> IO () +mkdirp path mode = do + r <- withCBytesUnsafe path $ \ p -> hs_uv_fs_mkdir p mode + case fromIntegral r of + UV_ENOENT -> do + (root, segs) <- P.splitSegments path + case segs of + seg:segs' -> loop segs' =<< P.join root seg + _ -> throwUV r + UV_EEXIST -> do + canIgnore <- isDir path + unless canIgnore $ throwUV r + _ -> throwUV r + where + loop segs p = do + a <- access p F_OK + case a of + AccessOK -> return () + NoExistence -> mkdir p mode + NoPermission -> throwUV UV_EACCES + case segs of + (nextp:ps) -> P.join p nextp >>= loop ps + _ -> return () + +-- | Equivalent to . +unlink :: HasCallStack => CBytes -> IO () +unlink path = throwUVIfMinus_ (withCBytesUnsafe path hs_uv_fs_unlink) + + +-- | Equivalent to +-- +-- Creates a temporary directory in the most secure manner possible. +-- There are no race conditions in the directory’s creation. +-- The directory is readable, writable, and searchable only by the creating user ID. +-- The user of mkdtemp() is responsible for deleting the temporary directory and +-- its contents when done with it. +-- +-- Note: the argument is the prefix of the temporary directory, +-- so no need to add XXXXXX ending. +-- +mkdtemp :: HasCallStack => CBytes -> IO CBytes +mkdtemp path = do + let size = CBytes.length path + withCBytesUnsafe path $ \ p -> do + (p',_) <- CBytes.allocCBytesUnsafe (size+7) $ \ p' -> do -- we append "XXXXXX\NUL" in C + throwUVIfMinus_ (hs_uv_fs_mkdtemp p size p') + return p' + +-- | Equivalent to +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 . +-- +-- Note this function may inherent OS limitations such as argument must be an empty folder. +rmdir :: HasCallStack => CBytes -> IO () +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 () +rmrf path = + withCBytesUnsafe path $ \path' -> + allocaBytes uvStatSize $ \s -> do + r <- fromIntegral <$> hs_uv_fs_stat path' s + if | r == UV_ENOENT -> pure () -- nothing if path does not exist. + | r < 0 -> throwUV r + | otherwise -> do + st <- peekUVStat s + case stMode st .&. S_IFMT of + S_IFREG -> unlink path + S_IFLNK -> unlink path + S_IFDIR -> do + ds <- scandir path + forM_ ds $ \ (d, t) -> + if t /= DirEntDir + then unlink d + else rmrf =<< path `P.join` d + rmdir path + mode -> do + let desc = B.buildText $ "Unsupported file mode: " >> B.hex mode + throwIO $ UnsupportedOperation (IOEInfo "" desc callStack) + +-- | Equivalent to . +-- +-- Note Unlike scandir(3), this function does not return the “.” and “..” entries. +-- +-- 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 +-- man page. +scandir :: HasCallStack => CBytes -> IO [(CBytes, DirEntType)] +scandir path = do + bracket + (withCBytesUnsafe path $ \ p -> + allocPrimUnsafe $ \ dents -> + throwUVIfMinus (hs_uv_fs_scandir p dents)) + (\ (dents, n) -> hs_uv_fs_scandir_cleanup dents n) + (\ (dents, n) -> forM [0..n-1] $ \ i -> do + dent <- peekElemOff dents i + (p, typ) <- peekUVDirEnt dent + let !typ' = fromUVDirEntType typ + !p' <- fromCString p + return (p', typ')) + +-------------------------------------------------------------------------------- +-- File Status + +-- | Equivalent to +stat :: HasCallStack => CBytes -> IO FStat +stat path = withCBytesUnsafe path $ \ p -> + allocaBytes uvStatSize $ \ s -> do + throwUVIfMinus_ (hs_uv_fs_stat p s) + peekUVStat s + +-- | Equivalent to +lstat :: HasCallStack => CBytes -> IO FStat +lstat path = withCBytesUnsafe path $ \ p -> + allocaBytes uvStatSize $ \ s -> do + throwUVIfMinus_ (hs_uv_fs_lstat p s) + peekUVStat s + +-- | Equivalent to +-- +-- Return 'Nothing' instead of throwing 'NoSuchThing' if the file doesn't exist. +stat' :: HasCallStack => CBytes -> IO (Maybe FStat) +stat' path = withCBytesUnsafe path $ \ p -> + allocaBytes uvStatSize $ \ s -> do + r <- fromIntegral <$> hs_uv_fs_stat p s + if | r == UV_ENOENT -> return Nothing + | r < 0 -> throwUV r + | otherwise -> Just <$> peekUVStat s + +-- | Equivalent to +-- +-- Return 'Nothing' instead of throwing 'NoSuchThing' if the link doesn't exist. +lstat' :: HasCallStack => CBytes -> IO (Maybe FStat) +lstat' path = withCBytesUnsafe path $ \ p -> + allocaBytes uvStatSize $ \ s -> do + r <- fromIntegral <$> hs_uv_fs_lstat p s + if | r == UV_ENOENT -> return Nothing + | r < 0 -> throwUV r + | otherwise -> Just <$> peekUVStat s + +-- | Equivalent to +fstat :: HasCallStack => File -> IO FStat +fstat uvf = checkFileClosed uvf $ \ fd -> + allocaBytes uvStatSize $ \ s -> do + throwUVIfMinus_ (hs_uv_fs_fstat fd s) + peekUVStat s + +-------------------------------------------------------------------------------- + +-- | Equivalent to . +-- +-- 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 () +rename path path' = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> + withCBytesUnsafe path' (hs_uv_fs_rename p) + +-- | Equivalent to . +fsync :: HasCallStack => File -> IO () +fsync uvf = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fsync fd + +-- | Equivalent to . +fdatasync :: HasCallStack => File -> IO () +fdatasync uvf = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fdatasync fd + +-- | Equivalent to . +ftruncate :: HasCallStack => File -> Int64 -> IO () +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 () +copyfile path path' flag = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> + withCBytesUnsafe path' $ \ p' -> hs_uv_fs_copyfile p p' flag + +-- | Equivalent to on Unix. +-- +-- Windows uses GetFileAttributesW(). +access :: HasCallStack => CBytes -> AccessMode -> IO AccessResult +access path mode = do + r <- withCBytesUnsafe path $ \ p -> fromIntegral <$> hs_uv_fs_access p mode + if | r == 0 -> return AccessOK + | r == UV_ENOENT -> return NoExistence + | r == UV_EACCES -> return NoPermission + | otherwise -> do + name <- uvErrName r + desc <- uvStdError r + throwUVError r (IOEInfo name desc callStack) + +-- | Equivalent to . +chmod :: HasCallStack => CBytes -> FileMode -> IO () +chmod path mode = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_chmod p mode + +-- | Equivalent to . +fchmod :: HasCallStack => File -> FileMode -> IO () +fchmod uvf mode = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fchmod fd mode + +-- | Equivalent to . +-- +-- libuv choose 'Double' type due to cross platform concerns, we only provide micro-second precision. +utime :: HasCallStack + => CBytes + -> Double -- ^ atime, i.e. access time + -> Double -- ^ mtime, i.e. modify time + -> IO () +utime path atime mtime = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_utime p atime mtime + +-- | Equivalent to . +-- +-- Same precision notes with 'utime'. +futime :: HasCallStack => File -> Double -> Double -> IO () +futime uvf atime mtime = checkFileClosed uvf $ \ fd -> + throwUVIfMinus_ (hs_uv_fs_futime fd atime mtime) + +-- | Equivalent to . +-- +-- Same precision notes with 'utime'. +lutime :: HasCallStack + => CBytes + -> Double -- ^ atime, i.e. access time + -> Double -- ^ mtime, i.e. modify time + -> IO () +lutime path atime mtime = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_lutime p atime mtime + +-- | Equivalent to . +link :: HasCallStack => CBytes -> CBytes -> IO () +link path path' = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> + withCBytesUnsafe path' $ hs_uv_fs_link p + +-- | Equivalent to . +-- +-- | Note On Windows the flags parameter can be specified to control how the symlink will be created. +-- +-- * 'SYMLINK_DIR': indicates that path points to a directory. +-- * 'SYMLINK_JUNCTION': request that the symlink is created using junction points. +-- +-- On other platforms these flags are ignored. +symlink :: HasCallStack => CBytes -> CBytes -> SymlinkFlag -> IO () +symlink path path' flag = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> + withCBytesUnsafe path' $ \ p' -> hs_uv_fs_symlink p p' flag + +-- | Equivalent to . +readlink :: HasCallStack => CBytes -> IO CBytes +readlink path = do + bracket + (withCBytesUnsafe path $ \ p -> + allocPrimUnsafe $ \ p' -> + throwUVIfMinus (hs_uv_fs_readlink p p')) + (hs_uv_fs_readlink_cleanup . fst) + (fromCString . fst) + + +-- | Equivalent to on Unix. Windows uses . +-- +-- Warning This function has certain platform-specific caveats that were discovered when used in Node. +-- +-- * macOS and other BSDs: this function will fail with UV_ELOOP if more than 32 symlinks are found while +-- resolving the given path. This limit is hardcoded and cannot be sidestepped. +-- +-- * Windows: while this function works in the common case, there are a number of corner cases where it doesn’t: +-- +-- * Paths in ramdisk volumes created by tools which sidestep the Volume Manager (such as ImDisk) cannot be resolved. +-- * Inconsistent casing when using drive letters. +-- * Resolved path bypasses subst’d drives. +-- +-- While this function can still be used, it’s not recommended if scenarios such as the above need to be supported. +-- The background story and some more details on these issues can be checked . +-- +-- 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 +realpath path = do + bracket + (withCBytesUnsafe path $ \ p -> + allocPrimUnsafe $ \ p' -> + throwUVIfMinus (hs_uv_fs_realpath p p')) + (hs_uv_fs_readlink_cleanup . fst) + (fromCString . fst) + +-- | Equivalent to . +chown :: HasCallStack => CBytes -> UID -> GID -> IO () +chown path uid gid = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_chown p uid gid + +-- | Equivalent to . +fchown :: HasCallStack => File -> UID -> GID -> IO () +fchown uvf uid gid = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fchown fd uid gid + +-- | Equivalent to . +lchown :: HasCallStack => CBytes -> UID -> GID -> IO () +lchown path uid gid = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_lchown p uid gid diff --git a/Z/IO/FileSystem/Threaded.hs b/Z/IO/FileSystem/Threaded.hs --- a/Z/IO/FileSystem/Threaded.hs +++ b/Z/IO/FileSystem/Threaded.hs @@ -7,7 +7,13 @@ Stability : experimental Portability : non-portable -This module provides filesystem API exactly same with `Z.IO.FileSystem`, operations(except 'seek') are implemented using libuv's threadpool to achieve non-block behavior (non-block here meaning won't block other haskell threads), which would be prefered when the operations' estimated time is long(>1ms) or running with a non-threaded haskell runtime, such as accessing network filesystem or scan a very large directory. Otherwise you may block RTS's capability thus all the other haskell threads live on it. +This module provides filesystem API exactly same with `Z.IO.FileSystem.Base`, +operations(except 'seek') are implemented using libuv's threadpool to achieve +non-block behavior (non-block here meaning won't block other haskell threads), +which would be prefered when the operations' estimated time is long(>1ms) or +running with a non-threaded haskell runtime, such as accessing network filesystem +or scan a very large directory. Otherwise you may block RTS's capability thus +all the other haskell threads live on it. The threadpool version operations have overheads similar to safe FFI, but provide same adventages: @@ -19,24 +25,31 @@ -} +-- FIXME: An elegant way to keep this module's API same with 'Z.IO.FileSystem.Base' +-- automatically. + module Z.IO.FileSystem.Threaded - ( -- * regular file devices + ( -- * Regular file devices File, initFile, readFileP, writeFileP, getFileFD, seek , readFile, readTextFile, writeFile, writeTextFile , readJSONFile, writeJSONFile - -- * file offset bundle - , FilePtrT, newFilePtrT, getFilePtrOffset, setFilePtrOffset - -- * filesystem operations + -- * File offset bundle + , FilePtr, newFilePtr, getFilePtrOffset, setFilePtrOffset + -- * Filesystem operations , mkdir, mkdirp , unlink - , mkdtemp - , rmdir, rmdirrf + , mkdtemp, mkstemp , initTempFile, initTempDir + , rmdir, rmrf , DirEntType(..) , scandir , scandirRecursively + -- ** File stats , FStat(..), UVTimeSpec(..) - , stat, lstat, fstat + , doesPathExist, doesFileExist, doesDirExist , isLink, isDir, isFile + , isLinkSt, isDirSt, isFileSt + , stat, lstat, fstat + , stat', lstat' , rename , fsync, fdatasync , ftruncate @@ -57,7 +70,8 @@ , pattern X_OK -- ** FileMode , FileMode - , pattern DEFAULT_MODE + , pattern DEFAULT_FILE_MODE + , pattern DEFAULT_DIR_MODE , pattern S_IRWXU , pattern S_IRUSR , pattern S_IWUSR @@ -108,27 +122,31 @@ import Control.Monad import Data.Bits -import Data.Int import Data.IORef +import Data.Int import Data.Word +import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Ptr -import Foreign.Storable (peekElemOff) -import Foreign.Marshal.Alloc (allocaBytes) -import Z.Data.CBytes as CBytes +import Foreign.Storable (peekElemOff) +import Prelude hiding (readFile, writeFile) +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 qualified Z.Data.Text as T -import qualified Z.Data.Text.Print as T -import qualified Z.Data.Vector as V -import qualified Z.Data.JSON as JSON +import qualified Z.Data.Text as T +import qualified Z.Data.Text.Print as T +import qualified Z.Data.Vector as V import Z.Foreign import Z.IO.Buffered +import qualified Z.IO.Environment as Env import Z.IO.Exception -import qualified Z.IO.FileSystem.FilePath as P +import qualified Z.IO.FileSystem.FilePath as P import Z.IO.Resource import Z.IO.UV.FFI import Z.IO.UV.Manager -import Prelude hiding (writeFile, readFile) +#include "_Shared.hs" + -------------------------------------------------------------------------------- -- File @@ -227,43 +245,6 @@ (bufSiz-written) (off+fromIntegral written) --- | File bundled with offset. --- --- Reading or writing using 'Input' \/ 'Output' instance will automatically increase offset. --- 'FilePtrT' and its operations are NOT thread safe, use 'MVar' 'FilePtrT' in multiple threads. --- --- The notes on linux 'writeFileP' applied to 'FilePtr' too. -data FilePtrT = FilePtrT {-# UNPACK #-} !File - {-# UNPACK #-} !(PrimIORef Int64) - --- | Create a file offset bundle from an 'File'. --- -newFilePtrT :: File -- ^ the file we're reading - -> Int64 -- ^ initial offset - -> IO FilePtrT -newFilePtrT uvf off = FilePtrT uvf <$> newPrimIORef off - --- | Get current offset. -getFilePtrOffset :: FilePtrT -> IO Int64 -getFilePtrOffset (FilePtrT _ offsetRef) = readPrimIORef offsetRef - --- | Change current offset. -setFilePtrOffset :: FilePtrT -> Int64 -> IO () -setFilePtrOffset (FilePtrT _ offsetRef) = writePrimIORef offsetRef - -instance Input FilePtrT where - readInput (FilePtrT file offsetRef) buf bufSiz = - readPrimIORef offsetRef >>= \ off -> do - l <- readFileP file buf bufSiz off - writePrimIORef offsetRef (off + fromIntegral l) - return l - -instance Output FilePtrT where - writeOutput (FilePtrT file offsetRef) buf bufSiz = - readPrimIORef offsetRef >>= \ off -> do - writeFileP file buf bufSiz off - writePrimIORef offsetRef (off + fromIntegral bufSiz) - -------------------------------------------------------------------------------- -- | init a file 'Resource', which open a file when used. @@ -276,7 +257,7 @@ initFile :: CBytes -> FileFlag -- ^ Opening flags, e.g. 'O_CREAT' @.|.@ 'O_RDWR' -> FileMode -- ^ Sets the file mode (permission and sticky bits), - -- but only if the file was created, see 'DEFAULT_MODE'. + -- but only if the file was created, see 'DEFAULT_FILE_MODE'. -> Resource File initFile path flags mode = initResource @@ -290,35 +271,6 @@ throwUVIfMinus_ (hs_uv_fs_close fd) writeIORef closedRef True) --- | Quickly open a file and read its content. -readFile :: HasCallStack => CBytes -> IO V.Bytes -readFile filename = do - withResource (initFile filename O_RDONLY DEFAULT_MODE) $ \ file -> do - readAll' =<< newBufferedInput file - --- | Quickly open a file and read its content as UTF8 text. -readTextFile :: HasCallStack => CBytes -> IO T.Text -readTextFile filename = T.validate <$> readFile filename - --- | Quickly open a file and write some content. -writeFile :: HasCallStack => CBytes -> V.Bytes -> IO () -writeFile filename content = do - withResource (initFile filename (O_WRONLY .|. O_CREAT) DEFAULT_MODE) $ \ file -> do - withPrimVectorSafe content (writeOutput file) - --- | Quickly open a file and write some content as UTF8 text. -writeTextFile :: HasCallStack => CBytes -> T.Text -> IO () -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 -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 () -writeJSONFile filename x = writeFile filename (JSON.encode x) - -------------------------------------------------------------------------------- -- | Equivalent to . @@ -331,34 +283,40 @@ withCBytesUnsafe path $ \ p -> withUVRequest_ uvm (hs_uv_fs_mkdir_threaded p mode) --- | Equivalent to @mkdir -p@ +-- | Recursive directory creation function. Like 'mkdir', but makes all +-- intermediate-level directories needed to contain the leaf directory. -- --- Note mode is currently not implemented on Windows. On unix you should set execute bit --- if you want the directory is accessable(so that child folder can be created), e.g. 0o777. +-- Equivalent to @mkdir -p@, +-- +-- Note mode is currently not implemented on Windows. On unix you should set +-- execute bit if you want the directory is accessable(so that child folder +-- can be created), e.g. 'DEFAULT_DIR_MODE'. +-- mkdirp :: HasCallStack => CBytes -> FileMode -> IO () mkdirp path mode = do uvm <- getUVManager r <- withCBytesUnsafe path $ \ p -> - withUVRequest' uvm (hs_uv_fs_mkdir_threaded p mode) - (\ r -> do - when (r < 0 && fromIntegral r /= UV_ENOENT) - (throwUVIfMinus_ (return r)) - return r) - when (fromIntegral r == UV_ENOENT) $ do - (root, segs) <- P.splitSegments path - case segs of - seg:segs' -> loop segs' =<< P.join root seg - _ -> throwUVIfMinus_ (return r) + withUVRequest' uvm (hs_uv_fs_mkdir_threaded p mode) return + case fromIntegral r of + UV_ENOENT -> do + (root, segs) <- P.splitSegments path + case segs of + seg:segs' -> loop segs' =<< P.join root seg + _ -> throwUV r + UV_EEXIST -> do + canIgnore <- isDir path + unless canIgnore (throwUV r) + _ -> throwUV r where loop segs p = do a <- access p F_OK case a of AccessOK -> return () NoExistence -> mkdir p mode - NoPermission -> throwUVIfMinus_ (return UV_EACCES) + NoPermission -> throwUV UV_EACCES case segs of (nextp:ps) -> P.join p nextp >>= loop ps - _ -> return () + _ -> return () -- | Equivalent to . unlink :: HasCallStack => CBytes -> IO () @@ -377,6 +335,7 @@ -- -- Note: the argument is the prefix of the temporary directory, -- so no need to add XXXXXX ending. +-- mkdtemp :: HasCallStack => CBytes -> IO CBytes mkdtemp path = do let size = CBytes.length path @@ -386,6 +345,16 @@ withUVRequest_ uvm (hs_uv_fs_mkdtemp_threaded p size p') return p'' +-- | Equivalent to +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'' + -- | Equivalent to . -- -- Note this function may inherent OS limitations such as argument must be an empty folder. @@ -394,17 +363,32 @@ uvm <- getUVManager withCBytesUnsafe path (\ p -> void . withUVRequest uvm $ hs_uv_fs_rmdir_threaded p) --- | Equivalent to @rmdir -rf@ --- --- This function will try to remove folder and files contained by it. -rmdirrf :: HasCallStack => CBytes -> IO () -rmdirrf path = do - ds <- scandir path - forM_ ds $ \ (d, t) -> do - if t /= DirEntDir - then unlink d - else rmdirrf =<< path `P.join` d - rmdir path +-- | 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 () +rmrf path = + withCBytesUnsafe path $ \path' -> + allocaBytes uvStatSize $ \s -> do + uvm <- getUVManager + withUVRequest' uvm (hs_uv_fs_stat_threaded path' s) $ \ r -> do + if | r == fromIntegral UV_ENOENT -> pure () + | r < 0 -> throwUV r + | otherwise -> do + st <- peekUVStat s + case stMode st .&. S_IFMT of + S_IFREG -> unlink path + S_IFLNK -> unlink path + S_IFDIR -> do + ds <- scandir path + forM_ ds $ \ (d, t) -> + if t /= DirEntDir + then unlink d + else rmrf =<< path `P.join` d + rmdir path + mode -> do + let desc = B.buildText $ "Unsupported file mode: " >> B.hex mode + throwIO $ UnsupportedOperation (IOEInfo "" desc callStack) -------------------------------------------------------------------------------- @@ -430,26 +414,6 @@ !p' <- fromCString p return (p', typ')) --- | Find all files and directories within a given directory with a predicator. --- --- @ --- import Z.IO.FileSystem.FilePath (splitExtension) --- -- find all haskell source file within current dir --- scandirRecursively "." (\ p _ -> (== ".hs") . snd <$> splitExtension p) --- @ -scandirRecursively :: HasCallStack => CBytes -> (CBytes -> DirEntType -> IO Bool) -> IO [CBytes] -scandirRecursively dir p = loop [] =<< P.normalize dir - where - loop acc0 pdir = - foldM (\ acc (d,t) -> do - d' <- pdir `P.join` d - r <- p d' t - let acc' = if r then (d':acc) else acc - if (t == DirEntDir) - then loop acc' d' - else return acc' - ) acc0 =<< scandir pdir - -------------------------------------------------------------------------------- -- | Equivalent to @@ -470,6 +434,32 @@ withUVRequest_ uvm (hs_uv_fs_lstat_threaded p s) peekUVStat s +-- | Equivalent to +-- +-- Return 'Nothing' instead of throwing 'NoSuchThing' if the file doesn't exist. +stat' :: HasCallStack => CBytes -> IO (Maybe FStat) +stat' path = do + withCBytesUnsafe path $ \ p -> + allocaBytes uvStatSize $ \ s -> do + uvm <- getUVManager + withUVRequest' uvm (hs_uv_fs_stat_threaded p s) $ \ r -> + if | r == fromIntegral UV_ENOENT -> pure Nothing + | r < 0 -> throwUV r + | otherwise -> Just <$> peekUVStat s + +-- | Equivalent to +-- +-- Return 'Nothing' instead of throwing 'NoSuchThing' if the link doesn't exist. +lstat' :: HasCallStack => CBytes -> IO (Maybe FStat) +lstat' path = + withCBytesUnsafe path $ \ p -> + allocaBytes uvStatSize $ \ s -> do + uvm <- getUVManager + withUVRequest' uvm (hs_uv_fs_lstat_threaded p s) $ \ r -> + if | r == fromIntegral UV_ENOENT -> pure Nothing + | r < 0 -> throwUV r + | otherwise -> Just <$> peekUVStat s + -- | Equivalent to fstat :: HasCallStack => File -> IO FStat fstat uvf = checkFileClosed uvf $ \ fd -> @@ -477,18 +467,6 @@ uvm <- getUVManager withUVRequest_ uvm (hs_uv_fs_fstat_threaded fd s) peekUVStat s) - --- | If given path is a symbolic link? -isLink :: HasCallStack => CBytes -> IO Bool -isLink p = lstat p >>= \ st -> return (stMode st .&. S_IFMT == S_IFLNK) - --- | If given path is a directory or a symbolic link to a directory? -isDir :: HasCallStack => CBytes -> IO Bool -isDir p = stat p >>= \ st -> return (stMode st .&. S_IFMT == S_IFDIR) - --- | If given path is a file or a symbolic link to a file? -isFile :: HasCallStack => CBytes -> IO Bool -isFile p = stat p >>= \ st -> return (stMode st .&. S_IFMT == S_IFREG) -------------------------------------------------------------------------------- diff --git a/Z/IO/FileSystem/Watch.hs b/Z/IO/FileSystem/Watch.hs --- a/Z/IO/FileSystem/Watch.hs +++ b/Z/IO/FileSystem/Watch.hs @@ -46,7 +46,7 @@ import Z.IO.BIO import Z.IO.BIO.Concurrent import Z.IO.Exception -import Z.IO.FileSystem +import Z.IO.FileSystem.Base import qualified Z.IO.FileSystem.FilePath as P import Z.IO.UV.FFI import Z.IO.UV.Manager diff --git a/Z/IO/FileSystem/_Shared.hs b/Z/IO/FileSystem/_Shared.hs new file mode 100644 --- /dev/null +++ b/Z/IO/FileSystem/_Shared.hs @@ -0,0 +1,156 @@ +-- This file should be included from both base and threaded FS module + +-- | File bundled with offset. +-- +-- Reading or writing using 'Input' \/ 'Output' instance will automatically increase offset. +-- 'FilePtr' and its operations are NOT thread safe, use 'MVar' 'FilePtr' in multiple threads. +-- +-- The notes on linux 'writeFileP' applied to 'FilePtr' too. +data FilePtr = FilePtr {-# UNPACK #-} !File + {-# UNPACK #-} !(PrimIORef 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 + +-- | Get current offset. +getFilePtrOffset :: FilePtr -> IO Int64 +getFilePtrOffset (FilePtr _ offsetRef) = readPrimIORef offsetRef + +-- | Change current offset. +setFilePtrOffset :: FilePtr -> Int64 -> IO () +setFilePtrOffset (FilePtr _ offsetRef) = writePrimIORef offsetRef + +instance Input FilePtr where + readInput (FilePtr file offsetRef) buf bufSiz = + readPrimIORef offsetRef >>= \ off -> do + l <- readFileP file buf bufSiz off + writePrimIORef offsetRef (off + fromIntegral l) + return l + +instance Output FilePtr where + writeOutput (FilePtr file offsetRef) buf bufSiz = + readPrimIORef offsetRef >>= \ off -> do + writeFileP file buf bufSiz off + writePrimIORef offsetRef (off + fromIntegral bufSiz) + +-- | Quickly open a file and read its content. +readFile :: HasCallStack => CBytes -> IO V.Bytes +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 +readTextFile filename = T.validate <$> readFile filename + +-- | Quickly open a file and write some content. +writeFile :: HasCallStack => CBytes -> V.Bytes -> IO () +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 () +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 +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 () +writeJSONFile filename x = writeFile filename (JSON.encode x) + +-------------------------------------------------------------------------------- + +-- | Find all files and directories within a given directory with a predicator. +-- +-- @ +-- import Z.IO.FileSystem.FilePath (splitExtension) +-- -- find all haskell source file within current dir +-- scandirRecursively "." (\\ p _ -> (== ".hs") . snd \<$\> splitExtension p) +-- @ +scandirRecursively :: HasCallStack => CBytes -> (CBytes -> DirEntType -> IO Bool) -> IO [CBytes] +scandirRecursively dir p = loop [] =<< P.normalize dir + where + loop acc0 pdir = + foldM (\ acc (d,t) -> do + d' <- pdir `P.join` d + r <- p d' t + let acc' = if r then (d':acc) else acc + if (t == DirEntDir) + then loop acc' d' + else return acc' + ) acc0 =<< scandir pdir + +-------------------------------------------------------------------------------- + +-- | Does given path exist? +-- +doesPathExist :: CBytes -> IO Bool +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 +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 +doesDirExist path = maybe False isDirSt <$> stat' path + +-------------------------------------------------------------------------------- + +-- | If given path is a symbolic link? +isLink :: HasCallStack => CBytes -> IO Bool +isLink = fmap isLinkSt . lstat + +-- | If given path is a directory or a symbolic link to a directory? +isDir :: HasCallStack => CBytes -> IO Bool +isDir = fmap isDirSt . stat + +-- | If given path is a file or a symbolic link to a file? +isFile :: HasCallStack => CBytes -> IO Bool +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 +isLinkSt st = stMode st .&. S_IFMT == S_IFLNK + +-- | Shortcut to @\\ st -> stMode st .&. S_IFMT == S_IFDIR@ +isDirSt :: FStat -> Bool +isDirSt st = stMode st .&. S_IFMT == S_IFDIR + +-- | Shortcut to @\\ st -> stMode st .&. S_IFMT == S_IFREG@ +isFileSt :: FStat -> Bool +isFileSt st = stMode st .&. S_IFMT == S_IFREG + +------------------------------------------------------------------------------- + +-- | Make a temporary file under system 'Env.getTempDir' and automatically clean after used. +-- +-- >>> withResource (initTempFile "foo") $ printStd +-- File 13 +-- +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 + +-- | Make a temporary directory under system 'Env.getTempDir' and automatically clean after used. +-- +-- >>> withResource (initTempDir "foo") $ printStd +-- "/tmp/fooxfWR0L" +-- +initTempDir :: CBytes -> Resource CBytes +initTempDir prefix = + initResource (Env.getTempDir >>= (`P.join` prefix) >>= mkdtemp) rmrf diff --git a/Z/IO/UV/FFI.hsc b/Z/IO/UV/FFI.hsc --- a/Z/IO/UV/FFI.hsc +++ b/Z/IO/UV/FFI.hsc @@ -45,7 +45,7 @@ -------------------------------------------------------------------------------- -- Type alias type UVSlot = Int --- | UVSlotUnsafe wrap a slot which may not have a 'MVar' in blocking table, +-- | UVSlotUnsafe wrap a slot which may not have a 'MVar' in blocking table, -- i.e. the blocking table need to be resized. newtype UVSlotUnsafe = UVSlotUnsafe { unsafeGetSlot :: UVSlot } type FD = CInt @@ -77,7 +77,7 @@ <$> (#{peek hs_loop_data, buffer_table } p) <*> (#{peek hs_loop_data, buffer_size_table } p) -type UVRunMode = CInt +type UVRunMode = CInt pattern UV_RUN_DEFAULT :: UVRunMode pattern UV_RUN_DEFAULT = #const UV_RUN_DEFAULT @@ -174,14 +174,14 @@ foreign import ccall unsafe uv_udp_open :: Ptr UVHandle -> FD -> IO CInt foreign import ccall unsafe uv_udp_bind :: Ptr UVHandle -> MBA## SocketAddr -> UDPFlag -> IO CInt -type Membership = CInt +type Membership = CInt pattern LEAVE_GROUP :: Membership pattern LEAVE_GROUP = #const UV_LEAVE_GROUP pattern JOIN_GROUP :: Membership pattern JOIN_GROUP = #const UV_JOIN_GROUP -type UDPFlag = CInt +type UDPFlag = CInt pattern UDP_DEFAULT :: UDPFlag pattern UDP_DEFAULT = 0 @@ -215,11 +215,11 @@ foreign import ccall unsafe hs_uv_udp_check_start :: Ptr UVHandle -> IO CInt -foreign import ccall unsafe hs_uv_udp_send +foreign import ccall unsafe hs_uv_udp_send :: Ptr UVHandle -> MBA## SocketAddr -> Ptr Word8 -> Int -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_udp_send_connected :: Ptr UVHandle -> Ptr Word8 -> Int -> IO UVSlotUnsafe -foreign import ccall unsafe uv_udp_getsockname +foreign import ccall unsafe uv_udp_getsockname :: Ptr UVHandle -> MBA## SocketAddr -> MBA## CInt -> IO CInt foreign import ccall unsafe uv_udp_getpeername :: Ptr UVHandle -> MBA## SocketAddr -> MBA## CInt -> IO CInt @@ -231,7 +231,7 @@ -- | Terminal mode. -- -- When in 'TTY_MODE_RAW' mode, input is always available character-by-character, --- not including modifiers. Additionally, all special processing of characters by the terminal is disabled, +-- not including modifiers. Additionally, all special processing of characters by the terminal is disabled, -- including echoing input characters. Note that CTRL+C will no longer cause a SIGINT when in this mode. type TTYMode = CInt @@ -299,10 +299,14 @@ pattern S_IXOTH :: FileMode pattern S_IXOTH = #const S_IXOTH --- | Default mode for open, 0o666(readable and writable). -pattern DEFAULT_MODE :: FileMode -pattern DEFAULT_MODE = 0o666 +-- | Default mode for file open, 0x666(readable and writable). +pattern DEFAULT_FILE_MODE :: FileMode +pattern DEFAULT_FILE_MODE = 0o644 +-- | Default mode for open, 0x755. +pattern DEFAULT_DIR_MODE :: FileMode +pattern DEFAULT_DIR_MODE = 0o755 + -- | This is the file type mask. pattern S_IFMT :: FileMode pattern S_IFMT = #const S_IFMT @@ -328,24 +332,27 @@ foreign import ccall unsafe hs_uv_fs_mkdir :: BA## Word8 -> FileMode -> IO Int foreign import ccall unsafe hs_uv_fs_rmdir :: BA## Word8 -> IO Int foreign import ccall unsafe hs_uv_fs_mkdtemp :: BA## Word8 -> Int -> MBA## Word8 -> IO Int +foreign import ccall unsafe hs_uv_fs_mkstemp :: BA## Word8 -> Int -> MBA## Word8 -> IO Int -- threaded functions -foreign import ccall unsafe hs_uv_fs_open_threaded +foreign import ccall unsafe hs_uv_fs_open_threaded :: BA## Word8 -> FileFlag -> FileMode -> Ptr UVLoop -> IO UVSlotUnsafe -foreign import ccall unsafe hs_uv_fs_close_threaded +foreign import ccall unsafe hs_uv_fs_close_threaded :: FD -> Ptr UVLoop -> IO UVSlotUnsafe -foreign import ccall unsafe hs_uv_fs_read_threaded +foreign import ccall unsafe hs_uv_fs_read_threaded :: FD -> Ptr Word8 -> Int -> Int64 -> Ptr UVLoop -> IO UVSlotUnsafe -foreign import ccall unsafe hs_uv_fs_write_threaded +foreign import ccall unsafe hs_uv_fs_write_threaded :: FD -> Ptr Word8 -> Int -> Int64 -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_unlink_threaded :: BA## Word8 -> Ptr UVLoop -> IO UVSlotUnsafe -foreign import ccall unsafe hs_uv_fs_mkdir_threaded +foreign import ccall unsafe hs_uv_fs_mkdir_threaded :: BA## Word8 -> FileMode -> Ptr UVLoop -> IO UVSlotUnsafe -foreign import ccall unsafe hs_uv_fs_rmdir_threaded +foreign import ccall unsafe hs_uv_fs_rmdir_threaded :: BA## Word8 -> Ptr UVLoop -> IO UVSlotUnsafe -foreign import ccall unsafe hs_uv_fs_mkdtemp_threaded +foreign import ccall unsafe hs_uv_fs_mkdtemp_threaded :: BA## Word8 -> Int -> MBA## Word8 -> Ptr UVLoop -> IO UVSlotUnsafe +foreign import ccall unsafe hs_uv_fs_mkstemp_threaded + :: BA## Word8 -> Int -> MBA## Word8 -> Ptr UVLoop -> IO UVSlotUnsafe type FileFlag = CInt @@ -375,8 +382,8 @@ -- | If the 'O_CREAT' flag is set and the file already exists, fail the open. -- --- Note In general, the behavior of 'O_EXCL' is undefined if it is used without 'O_CREAT'. There is one exception: on --- Linux 2.6 and later, 'O_EXCL' can be used without 'O_CREAT' if pathname refers to a block device. If the block +-- Note In general, the behavior of 'O_EXCL' is undefined if it is used without 'O_CREAT'. There is one exception: on +-- Linux 2.6 and later, 'O_EXCL' can be used without 'O_CREAT' if pathname refers to a block device. If the block -- device is in use by the system (e.g., mounted), the open will fail with the error @EBUSY@. pattern O_EXCL :: FileFlag pattern O_EXCL = #const UV_FS_O_EXCL @@ -389,7 +396,7 @@ pattern O_EXLOCK = #const UV_FS_O_EXLOCK -- | Do not update the file access time when the file is read. --- +-- -- Note 'O_NOATIME' is not supported on Windows. pattern O_NOATIME :: FileFlag pattern O_NOATIME = #const UV_FS_O_NOATIME @@ -413,7 +420,7 @@ pattern O_NONBLOCK = #const UV_FS_O_NONBLOCK -- | Access is intended to be random. The system can use this as a hint to optimize file caching. --- +-- -- Note 'O_RANDOM' is only supported on Windows via @FILE_FLAG_RANDOM_ACCESS@. pattern O_RANDOM :: FileFlag pattern O_RANDOM = #const UV_FS_O_RANDOM @@ -428,7 +435,7 @@ -- | Access is intended to be sequential from beginning to end. The system can use this as a hint to optimize file caching. --- +-- -- Note 'O_SEQUENTIAL' is only supported on Windows via @FILE_FLAG_SEQUENTIAL_SCAN@. pattern O_SEQUENTIAL :: FileFlag pattern O_SEQUENTIAL = #const UV_FS_O_SEQUENTIAL @@ -519,12 +526,12 @@ :: Ptr (Ptr DirEntType) -> Int -> IO () foreign import ccall unsafe hs_uv_fs_scandir :: BA## Word8 -> MBA## (Ptr DirEntType) -> IO Int -foreign import ccall unsafe hs_uv_fs_scandir_extra_cleanup +foreign import ccall unsafe hs_uv_fs_scandir_extra_cleanup :: Ptr (Ptr (Ptr DirEntType)) -> Int -> IO () foreign import ccall unsafe hs_uv_fs_scandir_threaded :: BA## Word8 -> Ptr (Ptr (Ptr DirEntType)) -> Ptr UVLoop -> IO UVSlotUnsafe -data UVTimeSpec = UVTimeSpec +data UVTimeSpec = UVTimeSpec { uvtSecond :: {-# UNPACK #-} !CLong , uvtNanoSecond :: {-# UNPACK #-} !CLong } deriving (Show, Read, Eq, Ord, Generic) @@ -557,7 +564,7 @@ , stCtim :: {-# UNPACK #-} !UVTimeSpec , stBirthtim :: {-# UNPACK #-} !UVTimeSpec } deriving (Show, Read, Eq, Ord, Generic) - deriving anyclass (Print, JSON) + deriving anyclass (Print, JSON) uvStatSize :: Int uvStatSize = #{size uv_stat_t} @@ -601,11 +608,11 @@ :: FD -> Ptr UVLoop -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_fs_fdatasync_threaded :: FD -> Ptr UVLoop -> IO UVSlotUnsafe -foreign import ccall unsafe hs_uv_fs_ftruncate_threaded +foreign import ccall unsafe hs_uv_fs_ftruncate_threaded :: FD -> Int64 -> Ptr UVLoop -> IO UVSlotUnsafe -- | Flags control copying. --- +-- -- * 'COPYFILE_EXCL': If present, uv_fs_copyfile() will fail with UV_EEXIST if the destination path already exists. The default behavior is to overwrite the destination if it exists. -- * 'COPYFILE_FICLONE': If present, uv_fs_copyfile() will attempt to create a copy-on-write reflink. If the underlying platform does not support copy-on-write, then a fallback copy mechanism is used. -- * 'COPYFILE_FICLONE_FORCE': If present, uv_fs_copyfile() will attempt to create a copy-on-write reflink. If the underlying platform does not support copy-on-write, or an error occurs while attempting to use copy-on-write, then an error is returned. @@ -638,7 +645,7 @@ pattern X_OK :: AccessMode pattern X_OK = #const X_OK -data AccessResult = NoExistence | NoPermission | AccessOK +data AccessResult = NoExistence | NoPermission | AccessOK deriving (Show, Eq, Ord, Enum, Generic) deriving anyclass (Print, JSON) @@ -696,7 +703,7 @@ :: BA## Word8 -> MBA## CString -> IO Int foreign import ccall unsafe hs_uv_fs_realpath :: BA## Word8 -> MBA## CString -> IO Int -foreign import ccall unsafe hs_uv_fs_readlink_extra_cleanup +foreign import ccall unsafe hs_uv_fs_readlink_extra_cleanup :: Ptr CString -> IO () foreign import ccall unsafe hs_uv_fs_readlink_threaded :: BA## Word8 -> Ptr CString -> Ptr UVLoop -> IO UVSlotUnsafe @@ -716,7 +723,7 @@ -------------------------------------------------------------------------------- -- process -newtype UID = UID +newtype UID = UID #if defined(_WIN32) Word8 #else @@ -726,7 +733,7 @@ deriving newtype (Storable, Prim, Unaligned, Num, JSON) deriving anyclass Print -newtype GID = GID +newtype GID = GID #if defined(_WIN32) Word8 #else @@ -749,12 +756,12 @@ pattern PROCESS_SETGID :: ProcessFlag pattern PROCESS_SETGID = (#const UV_PROCESS_SETGID) -- | Do not wrap any arguments in quotes, or perform any other escaping, when --- converting the argument list into a command line string. +-- converting the argument list into a command line string. -- -- This option is only meaningful on Windows systems. On Unix it is silently ignored. pattern PROCESS_WINDOWS_VERBATIM_ARGUMENTS :: ProcessFlag pattern PROCESS_WINDOWS_VERBATIM_ARGUMENTS = (#const UV_PROCESS_WINDOWS_VERBATIM_ARGUMENTS) --- | Spawn the child process in a detached state +-- | Spawn the child process in a detached state -- -- This will make it a process group leader, and will effectively enable the child to keep running after -- the parent exits. @@ -765,12 +772,12 @@ -- This option is only meaningful on Windows systems. On Unix it is silently ignored. pattern PROCESS_WINDOWS_HIDE :: ProcessFlag pattern PROCESS_WINDOWS_HIDE = (#const UV_PROCESS_WINDOWS_HIDE) --- | Hide the subprocess console window that would normally be created. +-- | Hide the subprocess console window that would normally be created. -- -- This option is only meaningful on Windows systems. On Unix it is silently ignored. pattern PROCESS_WINDOWS_HIDE_CONSOLE :: ProcessFlag pattern PROCESS_WINDOWS_HIDE_CONSOLE = (#const UV_PROCESS_WINDOWS_HIDE_CONSOLE) --- | Hide the subprocess GUI window that would normally be created. +-- | Hide the subprocess GUI window that would normally be created. -- -- This option is only meaningful on Windows systems. On Unix it is silently ignored. pattern PROCESS_WINDOWS_HIDE_GUI :: ProcessFlag @@ -793,7 +800,7 @@ data ProcessOptions = ProcessOptions { processFile :: CBytes -- ^ Path pointing to the program to be executed. - , processArgs :: [CBytes] -- ^ Command line arguments. + , processArgs :: [CBytes] -- ^ Command line arguments. -- On Windows this uses CreateProcess which concatenates -- the arguments into a string this can cause some strange errors. -- See the 'PROCESS_WINDOWS_VERBATIM_ARGUMENTS'. @@ -803,7 +810,7 @@ , processUID :: UID -- ^ This happens only when the appropriate bits are set in the flags fields. , processGID :: GID -- ^ This happens only when the appropriate bits are set in the flags fields. , processStdStreams :: (ProcessStdStream, ProcessStdStream, ProcessStdStream) -- ^ Specifying how (stdin, stdout, stderr) should be passed/created to the child, see 'ProcessStdStream' - + } deriving (Eq, Ord, Show, Read, Generic) deriving anyclass (Print, JSON) @@ -816,12 +823,12 @@ processStdStreamFlag :: ProcessStdStream -> CInt processStdStreamFlag ProcessIgnore = #const UV_IGNORE -processStdStreamFlag ProcessCreate = (#const UV_CREATE_PIPE) +processStdStreamFlag ProcessCreate = (#const UV_CREATE_PIPE) .|. (#const UV_READABLE_PIPE) .|. (#const UV_WRITABLE_PIPE) processStdStreamFlag (ProcessInherit _) = #const UV_INHERIT_FD -foreign import ccall unsafe hs_uv_spawn :: Ptr UVLoop +foreign import ccall unsafe hs_uv_spawn :: Ptr UVLoop -> MBA## ProcessOptions -- option -> BA## Word8 -- file -> BAArray## Word8 -- all args @@ -888,7 +895,7 @@ -- | Data type for storing times. -- typedef struct { long tv_sec; long tv_usec; } uv_timeval_t; -data TimeVal = TimeVal +data TimeVal = TimeVal { tv_sec :: {-# UNPACK #-} !CLong , tv_usec :: {-# UNPACK #-} !CLong } deriving (Show, Read, Eq, Ord, Generic) @@ -896,7 +903,7 @@ -- | Data type for resource usage results. -- --- Members marked with (X) are unsupported on Windows. +-- Members marked with (X) are unsupported on Windows. -- See for supported fields on Unix data ResUsage = ResUsage { ru_utime :: {-# UNPACK #-} !TimeVal -- ^ user CPU time used, in microseconds @@ -950,7 +957,7 @@ foreign import ccall unsafe uv_os_getpriority :: PID -> MBA## CInt -> IO CInt foreign import ccall unsafe uv_os_setpriority :: PID -> CInt -> IO CInt -newtype PID = PID CInt +newtype PID = PID CInt deriving (Eq, Ord, Show, Read, Generic) deriving newtype (Storable, Prim, Unaligned, JSON) deriving anyclass Print @@ -962,12 +969,12 @@ pattern PRIORITY_ABOVE_NORMAL :: Priority pattern PRIORITY_HIGH :: Priority pattern PRIORITY_HIGHEST :: Priority -pattern PRIORITY_LOW = #const UV_PRIORITY_LOW -pattern PRIORITY_BELOW_NORMAL = #const UV_PRIORITY_BELOW_NORMAL -pattern PRIORITY_NORMAL = #const UV_PRIORITY_NORMAL -pattern PRIORITY_ABOVE_NORMAL = #const UV_PRIORITY_ABOVE_NORMAL -pattern PRIORITY_HIGH = #const UV_PRIORITY_HIGH -pattern PRIORITY_HIGHEST = #const UV_PRIORITY_HIGHEST +pattern PRIORITY_LOW = #const UV_PRIORITY_LOW +pattern PRIORITY_BELOW_NORMAL = #const UV_PRIORITY_BELOW_NORMAL +pattern PRIORITY_NORMAL = #const UV_PRIORITY_NORMAL +pattern PRIORITY_ABOVE_NORMAL = #const UV_PRIORITY_ABOVE_NORMAL +pattern PRIORITY_HIGH = #const UV_PRIORITY_HIGH +pattern PRIORITY_HIGHEST = #const UV_PRIORITY_HIGHEST foreign import ccall unsafe uv_hrtime :: IO Word64 @@ -997,9 +1004,9 @@ sn <- peekMBACBytes mba## (#offset uv_utsname_t, sysname) re <- peekMBACBytes mba## (#offset uv_utsname_t, release) ve <- peekMBACBytes mba## (#offset uv_utsname_t, version) - ma <- peekMBACBytes mba## (#offset uv_utsname_t, machine) + ma <- peekMBACBytes mba## (#offset uv_utsname_t, machine) return (OSName sn re ve ma) - + foreign import ccall unsafe uv_os_uname :: MBA## OSName -> IO CInt foreign import ccall unsafe hs_uv_random :: MBA## Word8 -> CSize -> CInt -> IO CInt @@ -1018,10 +1025,10 @@ foreign import ccall unsafe uv_os_get_passwd :: MBA## PassWD -> IO CInt foreign import ccall unsafe uv_os_free_passwd :: MBA## PassWD -> IO () --- | Gets a subset of the password file entry for the current effective uid (not the real uid). +-- | Gets a subset of the password file entry for the current effective uid (not the real uid). -- -- The populated data includes the username, euid, gid, shell, and home directory. --- On non-Windows systems, all data comes from getpwuid_r(3). +-- 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 getPassWD = bracket @@ -1049,10 +1056,10 @@ data CPUInfo = CPUInfo { cpu_model :: CBytes , cpu_speed :: CInt - , cpu_times_user :: Word64 -- ^ milliseconds + , cpu_times_user :: Word64 -- ^ milliseconds , cpu_times_nice :: Word64 -- ^ milliseconds - , cpu_times_sys :: Word64 -- ^ milliseconds - , cpu_times_idle :: Word64 -- ^ milliseconds + , cpu_times_sys :: Word64 -- ^ milliseconds + , cpu_times_idle :: Word64 -- ^ milliseconds , cpu_times_irq :: Word64 -- ^ milliseconds } deriving (Eq, Ord, Show, Read, Generic) deriving anyclass (Print, JSON) @@ -1060,8 +1067,8 @@ -- | Gets information about the CPUs on the system. getCPUInfo :: HasCallStack => IO [CPUInfo] getCPUInfo = bracket - (do (p, (len, _)) <- allocPrimUnsafe $ \ pp -> - allocPrimUnsafe $ \ plen -> + (do (p, (len, _)) <- allocPrimUnsafe $ \ pp -> + allocPrimUnsafe $ \ plen -> throwUVIfMinus_ (uv_cpu_info pp plen) return (p, len)) (\ (p, len) -> uv_free_cpu_info p len) @@ -1084,7 +1091,7 @@ -- | Gets the load average. See: getLoadAvg :: IO (Double, Double, Double) getLoadAvg = do - (arr, _) <- allocPrimArrayUnsafe 3 uv_loadavg + (arr, _) <- allocPrimArrayUnsafe 3 uv_loadavg return ( indexPrimArray arr 0 , indexPrimArray arr 1 , indexPrimArray arr 2) diff --git a/cbits/hs_uv_file.c b/cbits/hs_uv_file.c --- a/cbits/hs_uv_file.c +++ b/cbits/hs_uv_file.c @@ -90,6 +90,16 @@ return (HsInt)req.result; } +HsInt hs_uv_fs_mkstemp(const char* tpl, HsInt tpl_size, char* temp_path) { + uv_fs_t req; + strcpy(temp_path, tpl); + strcpy(temp_path + tpl_size, "XXXXXX"); + uv_fs_mkstemp(NULL, &req, temp_path, NULL); + strcpy(temp_path, req.path); // save the temp path + uv_fs_req_cleanup(&req); // maybe not neccessary + return (HsInt)req.result; +} + HsInt hs_uv_fs_rmdir(const char* path){ uv_fs_t req; uv_fs_rmdir(NULL, &req, path, NULL); @@ -281,7 +291,7 @@ void hs_uv_fs_callback(uv_fs_t* req){ uv_loop_t* loop = req->loop; hs_loop_data* loop_data = loop->data; - HsInt slot = (HsInt)req->data; + HsInt slot = (HsInt)req->data; // push the slot to event queue loop_data->buffer_size_table[slot] = (HsInt)req->result; loop_data->event_queue[loop_data->event_counter] = slot; @@ -294,7 +304,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; @@ -309,7 +319,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_close(loop, req, (uv_file)file, hs_uv_fs_callback); @@ -323,7 +333,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; uv_buf_t buf = { .base = buffer, .len = (size_t)buffer_size }; @@ -338,7 +348,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; uv_buf_t buf = { .base = buffer, .len = (size_t)buffer_size }; @@ -353,7 +363,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_unlink(loop, req, path, hs_uv_fs_callback); @@ -367,7 +377,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_mkdir(loop, req, path, mode, hs_uv_fs_callback); @@ -377,10 +387,10 @@ } else return slot; } -void hs_uv_fs_mkdtemp_callback(uv_fs_t* req){ +void hs_uv_fs_mktemp_callback(uv_fs_t* req){ uv_loop_t* loop = req->loop; hs_loop_data* loop_data = loop->data; - HsInt slot = (HsInt)req->data; + HsInt slot = (HsInt)req->data; char* path = loop_data->buffer_table[slot]; if (path != NULL) { // push the slot to event queue @@ -397,24 +407,41 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; strcpy(temp_path, tpl); strcpy(temp_path + tpl_size, "XXXXXX"); loop_data->buffer_table[slot] = temp_path; - int r = uv_fs_mkdtemp(loop, req, temp_path, hs_uv_fs_mkdtemp_callback); + int r = uv_fs_mkdtemp(loop, req, temp_path, hs_uv_fs_mktemp_callback); if (r < 0) { free_slot(loop_data, slot); return (HsInt)r; } else return slot; } +HsInt hs_uv_fs_mkstemp_threaded(const char* tpl, HsInt tpl_size, char* temp_path, uv_loop_t* loop){ + hs_loop_data* loop_data = loop->data; + HsInt slot = alloc_slot(loop_data); + if (slot < 0) return UV_ENOMEM; + uv_fs_t* req = + (uv_fs_t*)fetch_uv_struct(loop_data, slot); + req->data = (void*)slot; + strcpy(temp_path, tpl); + strcpy(temp_path + tpl_size, "XXXXXX"); + loop_data->buffer_table[slot] = temp_path; + int r = uv_fs_mkstemp(loop, req, temp_path, hs_uv_fs_mktemp_callback); + if (r < 0) { + free_slot(loop_data, slot); + return (HsInt)r; + } else return slot; +} + HsInt hs_uv_fs_rmdir_threaded(const char* path, uv_loop_t* loop){ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_rmdir(loop, req, path, hs_uv_fs_callback); @@ -427,7 +454,7 @@ void hs_uv_fs_scandir_callback(uv_fs_t* req){ uv_loop_t* loop = req->loop; hs_loop_data* loop_data = loop->data; - HsInt slot = (HsInt)req->data; + HsInt slot = (HsInt)req->data; uv_dirent_t*** dents = (uv_dirent_t***)loop_data->buffer_table[slot]; if (dents != NULL) { *dents = req->ptr; @@ -438,14 +465,14 @@ loop_data->event_counter += 1; } // we can't cleanup request here, because doing that will - // destory our dents array, which we haven't copied in Haskell yet. + // destory our dents array, which we haven't copied in Haskell yet. // so we manually break down uv_fs_req_cleanup here: // we free path buffer first, then clean up dents later using - // hs_uv_fs_scandir_cleanup, or hs_uv_fs_scandir_extra_cleanup + // hs_uv_fs_scandir_cleanup, or hs_uv_fs_scandir_extra_cleanup // in case of async exception. #if defined(_WIN32) if (req->file.pathw != NULL) - uv__free(req->file.pathw); + uv__free(req->file.pathw); #else if (req->path != NULL) uv__free((void*) req->path); @@ -468,7 +495,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; loop_data->buffer_table[slot] = (char*)dents; @@ -482,7 +509,7 @@ void hs_uv_fs_stat_callback(uv_fs_t* req){ uv_loop_t* loop = req->loop; hs_loop_data* loop_data = loop->data; - HsInt slot = (HsInt)req->data; + HsInt slot = (HsInt)req->data; uv_stat_t* stat = (uv_stat_t*)loop_data->buffer_table[slot]; if (stat != NULL) { // push the slot to event queue @@ -499,7 +526,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; loop_data->buffer_table[slot] = (char*)stat; @@ -514,7 +541,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; loop_data->buffer_table[slot] = (char*)stat; @@ -529,7 +556,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; loop_data->buffer_table[slot] = (char*)stat; @@ -544,7 +571,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_rename(loop, req, path, path2, hs_uv_fs_callback); @@ -558,7 +585,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_fsync(loop, req, file, hs_uv_fs_callback); @@ -572,7 +599,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_fdatasync(loop, req, file, hs_uv_fs_callback); @@ -586,7 +613,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_ftruncate(loop, req, file, off, hs_uv_fs_callback); @@ -600,7 +627,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_copyfile(loop, req, path, path2, flag, hs_uv_fs_callback); @@ -614,7 +641,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_access(loop, req, path, mode, hs_uv_fs_callback); @@ -628,7 +655,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_chmod(loop, req, path, mode, hs_uv_fs_callback); @@ -642,7 +669,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_fchmod(loop, req, file, mode, hs_uv_fs_callback); @@ -656,7 +683,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_utime(loop, req, path, atime, mtime, hs_uv_fs_callback); @@ -670,7 +697,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_futime(loop, req, file, atime, mtime, hs_uv_fs_callback); @@ -684,7 +711,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_lutime(loop, req, path, atime, mtime, hs_uv_fs_callback); @@ -698,7 +725,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_link(loop, req, path, path2, hs_uv_fs_callback); @@ -712,7 +739,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_symlink(loop, req, path, path2, flag, hs_uv_fs_callback); @@ -725,7 +752,7 @@ void hs_uv_fs_readlink_callback(uv_fs_t* req){ uv_loop_t* loop = req->loop; hs_loop_data* loop_data = loop->data; - HsInt slot = (HsInt)req->data; + HsInt slot = (HsInt)req->data; char** path = (char**)loop_data->buffer_table[slot]; if (path != NULL) { *path = req->ptr; // save the result path @@ -737,7 +764,7 @@ // for the same reason with 'scandir', we can't cleanup request here #if defined(_WIN32) if (req->file.pathw != NULL) - uv__free(req->file.pathw); + uv__free(req->file.pathw); #else if (req->path != NULL) uv__free((void*) req->path); @@ -753,7 +780,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; loop_data->buffer_table[slot] = (char*)result_path; @@ -769,7 +796,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; loop_data->buffer_table[slot] = (char*)result_path; @@ -784,7 +811,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_chown(loop, req, path, uid, gid, hs_uv_fs_callback); @@ -798,7 +825,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_fchown(loop, req, file, uid, gid, hs_uv_fs_callback); @@ -812,7 +839,7 @@ hs_loop_data* loop_data = loop->data; HsInt slot = alloc_slot(loop_data); if (slot < 0) return UV_ENOMEM; - uv_fs_t* req = + uv_fs_t* req = (uv_fs_t*)fetch_uv_struct(loop_data, slot); req->data = (void*)slot; int r = uv_fs_lchown(loop, req, path, uid, gid, hs_uv_fs_callback); @@ -830,7 +857,7 @@ #endif if (r < 0) { return uv_translate_sys_error(errno); - } else { + } else { return r; } } diff --git a/include/hs_uv.h b/include/hs_uv.h --- a/include/hs_uv.h +++ b/include/hs_uv.h @@ -37,7 +37,7 @@ #if !defined(_WIN32) -#include +#include #if defined(__sun) # include @@ -190,7 +190,7 @@ // // But in practice, we never directly return a free slot back to slot_table, because // the haskell thread allocating slot may be paused by RTS before its takeMVar parking its -// TSO since parking itself need an allocation. Now if uv_run fired its callback and +// TSO since parking itself need an allocation. Now if uv_run fired its callback and // free the slot, next registration will got the same slot, and mess up with previous // haskell thread. In order to solve this race condition, we free a slot in two steps: // @@ -302,7 +302,7 @@ int hs_uv_udp_check_start(uv_check_t* check); //////////////////////////////////////////////////////////////////////////////// -// fs +// filesystem // we define file open flag here for compatibility on libuv < v1.16 // see https://github.com/libuv/libuv/commit/4b666bd2d82a51f1c809b2703a91679789c1ec01#diff-a5e63f9b16ca783355e2d83941c3eafb @@ -586,7 +586,7 @@ void hs_uv_fs_readlink_cleanup(char* path); //////////////////////////////////////////////////////////////////////////////// -// fs, none thread pool version +// filesystem, none thread pool version int64_t hs_seek(int file, int64_t off, int origin); int32_t hs_uv_fs_open(const char* path, int flags, int mode); @@ -596,6 +596,7 @@ HsInt hs_uv_fs_unlink(const char* path); HsInt hs_uv_fs_mkdir(const char* path, int mode); HsInt hs_uv_fs_mkdtemp(const char* tpl, HsInt tpl_size, char* temp_path); +HsInt hs_uv_fs_mkstemp(const char* tpl, HsInt tpl_size, char* temp_path); HsInt hs_uv_fs_rmdir(const char* path); HsInt hs_uv_fs_scandir(const char* path, uv_dirent_t*** dents); HsInt hs_uv_fs_stat(const char* path, uv_stat_t* stat); @@ -629,6 +630,7 @@ HsInt hs_uv_fs_unlink_threaded(const char* path, uv_loop_t* loop); HsInt hs_uv_fs_mkdir_threaded(const char* path, int mode, uv_loop_t* loop); HsInt hs_uv_fs_mkdtemp_threaded(const char* tpl, HsInt tpl_size, char* temp_path, uv_loop_t* loop); +HsInt hs_uv_fs_mkstemp_threaded(const char* tpl, HsInt tpl_size, char* temp_path, uv_loop_t* loop); HsInt hs_uv_fs_rmdir_threaded(const char* path, uv_loop_t* loop); HsInt hs_uv_fs_scandir_threaded(const char* path, uv_dirent_t*** dents, uv_loop_t* loop); HsInt hs_uv_fs_stat_threaded(const char* path, uv_stat_t* stat, uv_loop_t* loop); diff --git a/test/Z/IO/FileSystem/ThreadedSpec.hs b/test/Z/IO/FileSystem/ThreadedSpec.hs --- a/test/Z/IO/FileSystem/ThreadedSpec.hs +++ b/test/Z/IO/FileSystem/ThreadedSpec.hs @@ -35,7 +35,7 @@ let flags = O_RDWR .|. O_CREAT - mode = DEFAULT_MODE + mode = DEFAULT_FILE_MODE filename = "test-file" it "Opens and writes a file" $ do @@ -49,7 +49,7 @@ written <- readExactly size i written @?= content - fr <- newFilePtrT file 0 + fr <- newFilePtr file 0 i <- newBufferedInput' 4096 fr written <- readExactly size i written @=? content @@ -72,7 +72,7 @@ Just firstLine <- readLine i firstLine @=? fst (V.break (== c2w '\n') content2) - fr <- newFilePtrT file (fromIntegral $ size2 `div` 2) + fr <- newFilePtr file (fromIntegral $ size2 `div` 2) i <- newBufferedInput' 4096 fr replicateM_ 512 $ do Just firstLine <- readLine i diff --git a/test/Z/IO/FileSystemSpec.hs b/test/Z/IO/FileSystemSpec.hs --- a/test/Z/IO/FileSystemSpec.hs +++ b/test/Z/IO/FileSystemSpec.hs @@ -36,7 +36,7 @@ let flags = O_RDWR .|. O_CREAT - mode = DEFAULT_MODE + mode = DEFAULT_FILE_MODE filename = "test-file" it "Opens and writes a file" $ do diff --git a/test/Z/IO/ProcessSpec.hs b/test/Z/IO/ProcessSpec.hs --- a/test/Z/IO/ProcessSpec.hs +++ b/test/Z/IO/ProcessSpec.hs @@ -53,13 +53,13 @@ tempdir <- mkdtemp "stdio-filesystem-unit" let ifilename = tempdir <> "/test-stdin" ofilename = tempdir <> "/test-stdout" - withResource (initFile ifilename (O_RDWR .|. O_CREAT) DEFAULT_MODE) $ \ input -> do + withResource (initFile ifilename (O_RDWR .|. O_CREAT) DEFAULT_FILE_MODE) $ \ input -> do bi <- newBufferedOutput' 4096 input writeBuffer bi "hello world" >> flushBuffer bi - ecode <- withResource (initFile ifilename O_RDWR DEFAULT_MODE) $ \ input -> do + ecode <- withResource (initFile ifilename O_RDWR DEFAULT_FILE_MODE) $ \ input -> do - withResource (initFile ofilename (O_RDWR .|. O_CREAT) DEFAULT_MODE) $ \ output -> do + withResource (initFile ofilename (O_RDWR .|. O_CREAT) DEFAULT_FILE_MODE) $ \ output -> do iF <- getFileFD input oF <- getFileFD output @@ -71,7 +71,7 @@ waitProcessExit pstate - withResource (initFile ofilename (O_RDWR .|. O_CREAT) DEFAULT_MODE) $ \ output -> do + withResource (initFile ofilename (O_RDWR .|. O_CREAT) DEFAULT_FILE_MODE) $ \ output -> do bo <- newBufferedInput' 4096 output o <- readBuffer bo assertEqual "cat echo back" "hello world" o