summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormaerwald <>2020-01-13 23:22:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-01-13 23:22:00 (GMT)
commit47dba67a98726404c9213f0ecad78a7151986966 (patch)
treec33d7a0892e46429df78dac90cc397a352c65577
parent8305aa8cdc06db5246940f15f4c91d65850de463 (diff)
version 0.10.10.10.1
-rwxr-xr-xCHANGELOG.md16
-rwxr-xr-xREADME.md2
-rw-r--r--hpath-io.cabal8
-rw-r--r--src/HPath/IO.hs152
-rw-r--r--src/HPath/IO.hs-boot8
-rw-r--r--src/HPath/IO/Errors.hs47
-rw-r--r--src/Streamly/ByteString.hs57
-rw-r--r--test/HPath/IO/ReadFileEOFSpec.hs85
-rw-r--r--test/Utils.hs8
9 files changed, 201 insertions, 182 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 35b59e9..046842d 100755
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,17 @@
# Revision history for hpath-io
-## 0.9.3 -- YYYY-mm-dd
+## 0.10.1 -- 2020-01-13
-* First version. Released on an unsuspecting world.
+* Move file check functions to HPath.IO
+* Add 'doesExist'
+* Exception handling of `doesExist`, `doesFileExist`, `doesDirectoryExist` has changed: only eNOENT is catched
+* Exception handling of `isWritable` has changed: just a wrapper around `access` now
+* switch exception handling to `safe-exceptions`
+* Redo file reading API (readFileEOF dropped and now using streamly under the hood, added `readFileStream`)
+
+
+## 0.10.0 -- 2020-01-04
+
+* First version. Split from 'hpath', contains only the IO parts.
+* Now uses streamly for 'copyFile'
+* Fixed tmpdir in hspec
diff --git a/README.md b/README.md
index 95166d4..027ac79 100755
--- a/README.md
+++ b/README.md
@@ -4,6 +4,8 @@
High-level IO operations on files/directories, utilizing type-safe Paths.
+This package is part of the HPath suite, also check out [hpath](https://hackage.haskell.org/package/hpath) and [hpath-filepath](https://hackage.haskell.org/package/hpath-filepath).
+
## Motivation
The motivation came during development of
diff --git a/hpath-io.cabal b/hpath-io.cabal
index 1f02815..f74a01c 100644
--- a/hpath-io.cabal
+++ b/hpath-io.cabal
@@ -1,5 +1,5 @@
name: hpath-io
-version: 0.10.0
+version: 0.10.1
synopsis: High-level IO operations on files/directories
description: High-level IO operations on files/directories, utilizing type-safe Paths
-- bug-reports:
@@ -32,17 +32,20 @@ library
System.Posix.FD
c-sources: cbits/dirutils.c
- -- other-modules:
+ other-modules: Streamly.ByteString
-- other-extensions:
build-depends: base >= 4.8 && <5
, IfElse
, bytestring >= 0.10.0.0
, hpath >= 0.10 && < 0.11
, hpath-filepath >= 0.10 && < 0.11
+ , safe-exceptions >= 0.1
, streamly >= 0.7
, unix >= 2.5
, unix-bytestring
, utf8-string
+ if !impl(ghc>=7.11)
+ build-depends: transformers
hs-source-dirs: src
default-language: Haskell2010
@@ -73,7 +76,6 @@ test-suite spec
HPath.IO.GetFileTypeSpec
HPath.IO.MoveFileOverwriteSpec
HPath.IO.MoveFileSpec
- HPath.IO.ReadFileEOFSpec
HPath.IO.ReadFileSpec
HPath.IO.RecreateSymlinkOverwriteSpec
HPath.IO.RecreateSymlinkSpec
diff --git a/src/HPath/IO.hs b/src/HPath/IO.hs
index ff6826d..e20533a 100644
--- a/src/HPath/IO.hs
+++ b/src/HPath/IO.hs
@@ -36,6 +36,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
module HPath.IO
(
@@ -66,13 +67,19 @@ module HPath.IO
, moveFile
-- * File reading
, readFile
- , readFileEOF
+ , readFileStream
-- * File writing
, writeFile
, appendFile
-- * File permissions
, newFilePerms
, newDirPerms
+ -- * File checks
+ , doesExist
+ , doesFileExist
+ , doesDirectoryExist
+ , isWritable
+ , canOpenDirectory
-- * Directory reading
, getDirsFiles
-- * Filetype operations
@@ -88,7 +95,7 @@ import Control.Applicative
(
(<$>)
)
-import Control.Exception
+import Control.Exception.Safe
(
IOException
, bracket
@@ -175,8 +182,14 @@ import HPath
import HPath.Internal
import HPath.IO.Errors
import Prelude hiding (appendFile, readFile, writeFile)
+import Streamly
+import Streamly.ByteString
+import qualified Streamly.Data.Fold as FL
+import Streamly.Memory.Array
import qualified Streamly.FileSystem.Handle as FH
+import qualified Streamly.Internal.Data.Unfold as SU
import qualified Streamly.Internal.FileSystem.Handle as IFH
+import qualified Streamly.Internal.Memory.ArrayStream as AS
import qualified Streamly.Prelude as S
import qualified System.IO as SIO
import System.IO.Error
@@ -191,7 +204,9 @@ import System.Posix.ByteString
import System.Posix.Directory.ByteString
(
createDirectory
+ , closeDirStream
, getWorkingDirectory
+ , openDirStream
, removeDirectory
)
import System.Posix.Directory.Traversals
@@ -201,6 +216,7 @@ import System.Posix.Directory.Traversals
import System.Posix.Files.ByteString
(
createSymbolicLink
+ , fileAccess
, fileMode
, getFdStatus
, groupExecuteMode
@@ -446,7 +462,9 @@ recreateSymlink symsource@(MkPath symsourceBS) newsym@(MkPath newsymBS) cm
case cm of
Strict -> return ()
Overwrite -> do
- writable <- toAbs newsym >>= isWritable
+ writable <- toAbs newsym >>= (\p -> do
+ e <- doesExist p
+ if e then isWritable p else pure False)
isfile <- doesFileExist newsym
isdir <- doesDirectoryExist newsym
when (writable && isfile) (deleteFile newsym)
@@ -830,7 +848,10 @@ moveFile from to cm = do
easyDelete from
Overwrite -> do
ft <- getFileType from
- writable <- toAbs to >>= isWritable
+ writable <- toAbs to >>= (\p -> do
+ e <- doesFileExist p
+ if e then isWritable p else pure False)
+
case ft of
RegularFile -> do
exists <- doesFileExist to
@@ -853,19 +874,14 @@ moveFile from to cm = do
--------------------
--- |Read the given file at once into memory as a strict ByteString.
+-- |Read the given file *at once* into memory as a lazy ByteString.
-- Symbolic links are followed, no sanity checks on file size
--- or file type. File must exist.
---
--- Note: the size of the file is determined in advance, as to only
--- have one allocation.
+-- or file type. File must exist. Uses Builders under the hood
+-- (hence lazy ByteString).
--
-- Safety/reliability concerns:
--
--- * since amount of bytes to read is determined in advance,
--- the file might be read partially only if something else is
--- appending to it while reading
--- * the whole file is read into memory!
+-- * the whole file is read into memory, this doesn't read lazily
--
-- Throws:
--
@@ -873,21 +889,15 @@ moveFile from to cm = do
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
-readFile :: Path b -> IO ByteString
-readFile (MkPath fp) =
- bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd -> do
- stat <- PF.getFdStatus fd
- let fsize = PF.fileSize stat
- SPB.fdRead fd (fromIntegral fsize)
+readFile :: Path b -> IO L.ByteString
+readFile path = do
+ stream <- readFileStream path
+ toLazyByteString <$> S.fold FL.mconcat (fmap byteString stream)
--- |Read the given file in chunks of size `8192` into memory until
--- `fread` returns 0. Returns a lazy ByteString, because it uses
--- Builders under the hood.
---
--- Safety/reliability concerns:
---
--- * the whole file is read into memory!
+
+-- | Open the given file as a filestream. Once the filestream is
+-- exits, the filehandle is cleaned up.
--
-- Throws:
--
@@ -895,23 +905,13 @@ readFile (MkPath fp) =
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
-readFileEOF :: Path b -> IO L.ByteString
-readFileEOF (MkPath fp) =
- bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd ->
- allocaBytes (fromIntegral bufSize) $ \buf -> read' fd buf mempty
- where
- bufSize :: CSize
- bufSize = 8192
- read' :: Fd -> Ptr Word8 -> Builder -> IO L.ByteString
- read' fd buf builder = do
- size <- SPB.fdReadBuf fd buf bufSize
- if size == 0
- then return $ toLazyByteString builder
- else do
- readBS <- unsafePackCStringFinalizer buf
- (fromIntegral size)
- (return ())
- read' fd buf (builder <> byteString readBS)
+readFileStream :: Path b
+ -> IO (SerialT IO ByteString)
+readFileStream (MkPath fp) = do
+ fd <- openFd fp SPI.ReadOnly [] Nothing
+ handle <- SPI.fdToHandle fd
+ let stream = (S.unfold (SU.finally SIO.hClose FH.readChunks) handle) >>= arrayToByteString
+ pure stream
@@ -980,6 +980,72 @@ newDirPerms
+
+ -------------------
+ --[ File checks ]--
+ -------------------
+
+
+-- |Checks if the given file exists.
+-- Does not follow symlinks.
+--
+-- Only eNOENT is catched (and returns False).
+doesExist :: Path b -> IO Bool
+doesExist (MkPath bs) =
+ catchErrno [eNOENT] (do
+ _ <- PF.getSymbolicLinkStatus bs
+ return $ True)
+ $ return False
+
+
+-- |Checks if the given file exists and is not a directory.
+-- Does not follow symlinks.
+--
+-- Only eNOENT is catched (and returns False).
+doesFileExist :: Path b -> IO Bool
+doesFileExist (MkPath bs) =
+ catchErrno [eNOENT] (do
+ fs <- PF.getSymbolicLinkStatus bs
+ return $ not . PF.isDirectory $ fs)
+ $ return False
+
+
+-- |Checks if the given file exists and is a directory.
+-- Does not follow symlinks.
+--
+-- Only eNOENT is catched (and returns False).
+doesDirectoryExist :: Path b -> IO Bool
+doesDirectoryExist (MkPath bs) =
+ catchErrno [eNOENT] (do
+ fs <- PF.getSymbolicLinkStatus bs
+ return $ PF.isDirectory fs)
+ $ return False
+
+
+-- |Checks whether a file or folder is writable.
+--
+-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False).
+--
+-- Throws:
+--
+-- - `NoSuchThing` if the file does not exist
+isWritable :: Path b -> IO Bool
+isWritable (MkPath bs) = fileAccess bs False True False
+
+
+-- |Checks whether the directory at the given path exists and can be
+-- opened. This invokes `openDirStream` which follows symlinks.
+canOpenDirectory :: Path b -> IO Bool
+canOpenDirectory (MkPath bs) =
+ handleIOError (\_ -> return False) $ do
+ bracket (openDirStream bs)
+ closeDirStream
+ (\_ -> return ())
+ return True
+
+
+
+
-------------------------
--[ Directory reading ]--
-------------------------
diff --git a/src/HPath/IO.hs-boot b/src/HPath/IO.hs-boot
index d16bf75..bee74f5 100644
--- a/src/HPath/IO.hs-boot
+++ b/src/HPath/IO.hs-boot
@@ -6,3 +6,11 @@ import HPath
canonicalizePath :: Path b -> IO (Path Abs)
toAbs :: Path b -> IO (Path Abs)
+
+doesFileExist :: Path b -> IO Bool
+
+doesDirectoryExist :: Path b -> IO Bool
+
+isWritable :: Path b -> IO Bool
+
+canOpenDirectory :: Path b -> IO Bool
diff --git a/src/HPath/IO/Errors.hs b/src/HPath/IO/Errors.hs
index f6ef440..2511134 100644
--- a/src/HPath/IO/Errors.hs
+++ b/src/HPath/IO/Errors.hs
@@ -33,10 +33,6 @@ module HPath.IO.Errors
, throwSameFile
, sameFile
, throwDestinationInSource
- , doesFileExist
- , doesDirectoryExist
- , isWritable
- , canOpenDirectory
-- * Error handling functions
, catchErrno
@@ -52,7 +48,7 @@ import Control.Applicative
(
(<$>)
)
-import Control.Exception
+import Control.Exception.Safe hiding (handleIOError)
import Control.Monad
(
forM
@@ -92,11 +88,14 @@ import {-# SOURCE #-} HPath.IO
(
canonicalizePath
, toAbs
+ , doesFileExist
+ , doesDirectoryExist
+ , isWritable
+ , canOpenDirectory
)
import System.IO.Error
(
alreadyExistsErrorType
- , catchIOError
, ioeGetErrorType
, mkIOError
)
@@ -242,42 +241,6 @@ throwDestinationInSource (MkPath sbs) dest@(MkPath dbs) = do
(throwIO $ DestinationInSource dbs sbs)
--- |Checks if the given file exists and is not a directory.
--- Does not follow symlinks.
-doesFileExist :: Path b -> IO Bool
-doesFileExist (MkPath bs) =
- handleIOError (\_ -> return False) $ do
- fs <- PF.getSymbolicLinkStatus bs
- return $ not . PF.isDirectory $ fs
-
-
--- |Checks if the given file exists and is a directory.
--- Does not follow symlinks.
-doesDirectoryExist :: Path b -> IO Bool
-doesDirectoryExist (MkPath bs) =
- handleIOError (\_ -> return False) $ do
- fs <- PF.getSymbolicLinkStatus bs
- return $ PF.isDirectory fs
-
-
--- |Checks whether a file or folder is writable.
-isWritable :: Path b -> IO Bool
-isWritable (MkPath bs) =
- handleIOError (\_ -> return False) $
- fileAccess bs False True False
-
-
--- |Checks whether the directory at the given path exists and can be
--- opened. This invokes `openDirStream` which follows symlinks.
-canOpenDirectory :: Path b -> IO Bool
-canOpenDirectory (MkPath bs) =
- handleIOError (\_ -> return False) $ do
- bracket (PFD.openDirStream bs)
- PFD.closeDirStream
- (\_ -> return ())
- return True
-
-
--------------------------------
diff --git a/src/Streamly/ByteString.hs b/src/Streamly/ByteString.hs
new file mode 100644
index 0000000..2cee0a1
--- /dev/null
+++ b/src/Streamly/ByteString.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Streamly.ByteString where
+
+import Control.Monad.IO.Class
+import Data.ByteString hiding (length)
+import qualified Data.ByteString as BS
+import Data.ByteString.Unsafe
+import Data.Word (Word8)
+import Foreign.ForeignPtr
+import Foreign.ForeignPtr.Unsafe
+import Foreign.Ptr (castPtr, minusPtr, plusPtr)
+import Prelude hiding (length)
+import Streamly
+import Streamly.Internal.Memory.Array.Types
+import Streamly.Memory.Array
+import qualified Streamly.Prelude as S
+
+toByteString ::
+ forall m. (MonadIO m, MonadAsync m)
+ => SerialT m (Array Word8)
+ -> m ByteString
+toByteString stream =
+ let xs = S.mapM arrayToByteString stream
+ ys = S.foldlM' (\a b -> pure $ a <> b) mempty xs
+ in ys
+
+arrayToByteString :: (MonadIO m) => Array Word8 -> m ByteString
+arrayToByteString arr
+ | length arr == 0 = return mempty
+arrayToByteString Array {..} =
+ liftIO $
+ withForeignPtr aStart $ \ptr ->
+ unsafePackCStringFinalizer ptr aLen (return ())
+ where
+ aLen =
+ let p = unsafeForeignPtrToPtr aStart
+ in aEnd `minusPtr` p
+
+byteStringToArray :: (MonadIO m) => ByteString -> m (Array Word8)
+byteStringToArray bs =
+ liftIO $
+ unsafeUseAsCStringLen
+ bs
+ (\(ptr, _) -> do
+ let endPtr pr = (castPtr pr `plusPtr` (BS.length bs))
+ fptr <- newForeignPtr_ (castPtr ptr)
+ return $ Array {aStart = fptr, aEnd = endPtr ptr, aBound = endPtr ptr})
+
+fromByteString ::
+ forall m. (MonadIO m)
+ => ByteString
+ -> m (Array Word8)
+fromByteString bs = byteStringToArray bs
diff --git a/test/HPath/IO/ReadFileEOFSpec.hs b/test/HPath/IO/ReadFileEOFSpec.hs
deleted file mode 100644
index 6a92b52..0000000
--- a/test/HPath/IO/ReadFileEOFSpec.hs
+++ /dev/null
@@ -1,85 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-
-module HPath.IO.ReadFileEOFSpec where
-
-
-import Test.Hspec
-import System.IO.Error
- (
- ioeGetErrorType
- )
-import GHC.IO.Exception
- (
- IOErrorType(..)
- )
-import Utils
-
-
-
-upTmpDir :: IO ()
-upTmpDir = do
- setTmpDir "ReadFileEOFSpec"
- createTmpDir
-
-setupFiles :: IO ()
-setupFiles = do
- createRegularFile' "fileWithContent"
- createRegularFile' "fileWithoutContent"
- createSymlink' "inputFileSymL" "fileWithContent"
- createDir' "alreadyExistsD"
- createRegularFile' "noPerms"
- noPerms "noPerms"
- createDir' "noPermsD"
- createRegularFile' "noPermsD/inputFile"
- noPerms "noPermsD"
- writeFile' "fileWithContent" "Blahfaselgagaga"
-
-
-cleanupFiles :: IO ()
-cleanupFiles = do
- deleteFile' "fileWithContent"
- deleteFile' "fileWithoutContent"
- deleteFile' "inputFileSymL"
- deleteDir' "alreadyExistsD"
- normalFilePerms "noPerms"
- deleteFile' "noPerms"
- normalDirPerms "noPermsD"
- deleteFile' "noPermsD/inputFile"
- deleteDir' "noPermsD"
-
-
-spec :: Spec
-spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
- describe "HPath.IO.readFileEOF" $ do
-
- -- successes --
- it "readFileEOF (Strict) file with content, everything clear" $ do
- out <- readFileEOF' "fileWithContent"
- out `shouldBe` "Blahfaselgagaga"
-
- it "readFileEOF (Strict) symlink, everything clear" $ do
- out <- readFileEOF' "inputFileSymL"
- out `shouldBe` "Blahfaselgagaga"
-
- it "readFileEOF (Strict) empty file, everything clear" $ do
- out <- readFileEOF' "fileWithoutContent"
- out `shouldBe` ""
-
-
- -- posix failures --
- it "readFileEOF (Strict) directory, wrong file type" $ do
- readFileEOF' "alreadyExistsD"
- `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
-
- it "readFileEOF (Strict) file, no permissions" $ do
- readFileEOF' "noPerms"
- `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
-
- it "readFileEOF (Strict) file, no permissions on dir" $ do
- readFileEOF' "noPermsD/inputFile"
- `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
-
- it "readFileEOF (Strict) file, no such file" $ do
- readFileEOF' "lalala"
- `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)
diff --git a/test/Utils.hs b/test/Utils.hs
index c069cde..22627e7 100644
--- a/test/Utils.hs
+++ b/test/Utils.hs
@@ -27,7 +27,6 @@ import Data.IORef
, IORef
)
import HPath.IO
-import HPath.IO.Errors
import Prelude hiding (appendFile, readFile, writeFile)
import Data.Maybe
(
@@ -281,10 +280,5 @@ allDirectoryContents' ip =
readFile' :: ByteString -> IO ByteString
{-# NOINLINE readFile' #-}
-readFile' p = withTmpDir p readFile
-
-
-readFileEOF' :: ByteString -> IO L.ByteString
-{-# NOINLINE readFileEOF' #-}
-readFileEOF' p = withTmpDir p readFileEOF
+readFile' p = withTmpDir p (fmap L.toStrict . readFile)