hpath-io 0.10.1 → 0.11.0

raw patch · 9 files changed

+422/−19 lines, 9 filesdep +exceptionsdep +timedep ~hpath-filepathPVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions, time

Dependency ranges changed: hpath-filepath

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−0
• hpath-io.cabal +8/−2
• src/HPath/IO.hs +158/−13
• src/HPath/IO/Errors.hs +6/−1
• src/Streamly/ByteString/Lazy.hs +45/−0
• test/HPath/IO/CreateDirIfMissingSpec.hs +69/−0
• test/HPath/IO/GetDirsFilesSpec.hs +1/−1
• test/HPath/IO/WriteFileLSpec.hs +108/−0
• test/Utils.hs +12/−2

@@ -1,5 +1,20 @@ # Revision history for hpath-io +## 0.11.0 -- 2020-01-18++* `writeFile` not allows to set file mode and create file if it does not exist (this broke API)+* added various new functions:+	* createDirIfMissing+	* writeFileL (for lazy bytestring)+	* isReadable+	* isExecutable+	* getModificationTime+	* setModificationTime+	* setModificationTimeHiRes+	* getDirsFiles' (returns filenames instead of paths)+	* withRawFilePath+	* withHandle+ ## 0.10.1 -- 2020-01-13  * Move file check functions to HPath.IO

@@ -1,5 +1,5 @@ name:                hpath-io-version:             0.10.1+version:             0.11.0 synopsis:            High-level IO operations on files/directories description:         High-level IO operations on files/directories, utilizing type-safe Paths -- bug-reports:@@ -33,14 +33,17 @@   c-sources:         cbits/dirutils.c    other-modules:     Streamly.ByteString+                     Streamly.ByteString.Lazy   -- other-extensions:   build-depends:     base >= 4.8 && <5                    , IfElse                    , bytestring >= 0.10.0.0+                   , exceptions                    , hpath >= 0.10 && < 0.11-                   , hpath-filepath >= 0.10 && < 0.11+                   , hpath-filepath >= 0.10.2 && < 0.11                    , safe-exceptions >= 0.1                    , streamly >= 0.7+                   , time >= 1.8                    , unix >= 2.5                    , unix-bytestring                    , utf8-string@@ -65,6 +68,7 @@                         HPath.IO.CopyDirRecursiveSpec                         HPath.IO.CopyFileOverwriteSpec                         HPath.IO.CopyFileSpec+                        HPath.IO.CreateDirIfMissingSpec                         HPath.IO.CreateDirRecursiveSpec                         HPath.IO.CreateDirSpec                         HPath.IO.CreateRegularFileSpec@@ -81,6 +85,7 @@                         HPath.IO.RecreateSymlinkSpec                         HPath.IO.RenameFileSpec                         HPath.IO.ToAbsSpec+                        HPath.IO.WriteFileLSpec                         HPath.IO.WriteFileSpec                         Spec                         Utils@@ -93,6 +98,7 @@                       , hpath-io                       , hspec >= 1.3                       , process+                      , time >= 1.8                       , unix                       , unix-bytestring                       , utf8-string

@@ -60,6 +60,7 @@   -- * File creation   , createRegularFile   , createDir+  , createDirIfMissing   , createDirRecursive   , createSymlink   -- * File renaming/moving@@ -70,6 +71,7 @@   , readFileStream   -- * File writing   , writeFile+  , writeFileL   , appendFile   -- * File permissions   , newFilePerms@@ -78,15 +80,24 @@   , doesExist   , doesFileExist   , doesDirectoryExist+  , isReadable   , isWritable+  , isExecutable   , canOpenDirectory+  -- * File times+  , getModificationTime+  , setModificationTime+  , setModificationTimeHiRes   -- * Directory reading   , getDirsFiles+  , getDirsFiles'   -- * Filetype operations   , getFileType   -- * Others   , canonicalizePath   , toAbs+  , withRawFilePath+  , withHandle   )   where @@ -99,7 +110,9 @@   (     IOException   , bracket+  , bracketOnError   , throwIO+  , finally   ) import Control.Monad   (@@ -107,6 +120,7 @@   , void   , when   )+import Control.Monad.Catch (MonadThrow(..)) import Control.Monad.IfElse   (     unlessM@@ -115,6 +129,8 @@   (     ByteString   )+import           Data.Traversable               ( for )+import           Data.Functor                   ( ($>) ) #if MIN_VERSION_bytestring(0,10,2) import Data.ByteString.Builder #else@@ -150,6 +166,8 @@     (<>)   , mempty   )+import Data.Time.Clock+import Data.Time.Clock.POSIX (getPOSIXTime, posixSecondsToUTCTime, POSIXTime) import Data.Word   (     Word8@@ -184,6 +202,7 @@ import Prelude hiding (appendFile, readFile, writeFile) import Streamly import Streamly.ByteString+import qualified Streamly.ByteString.Lazy as SL import qualified Streamly.Data.Fold as FL import Streamly.Memory.Array import qualified Streamly.FileSystem.Handle as FH@@ -234,6 +253,7 @@   , setFileMode   , unionFileModes   )+import qualified System.Posix.FilePath as FP import qualified System.Posix.Files.ByteString as PF import qualified "unix" System.Posix.IO.ByteString as SPI import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB@@ -249,7 +269,9 @@     FileMode   , ProcessID   , Fd+  , EpochTime   )+import System.Posix.Time   @@ -716,7 +738,18 @@ createDir :: FileMode -> Path b -> IO () createDir fm (MkPath destBS) = createDirectory destBS fm +-- |Create an empty directory at the given directory with the given filename.+--+-- Throws:+--+--    - `PermissionDenied` if output directory cannot be written to+--    - `NoSuchThing` if any of the parent components of the path+--      do not exist+createDirIfMissing :: FileMode -> Path b -> IO ()+createDirIfMissing fm (MkPath destBS) =+  hideError AlreadyExists $ createDirectory destBS fm + -- |Create an empty directory at the given directory with the given filename. -- All parent directories are created with the same filemode. This -- basically behaves like:@@ -734,7 +767,7 @@ --    - `PermissionDenied` if any part of the path components do not --      exist and cannot be written to --    - `AlreadyExists` if destination already exists and---      is not a directory+--      is *not* a directory -- -- Note: calls `getcwd` if the input path is a relative path createDirRecursive :: FileMode -> Path b -> IO ()@@ -922,7 +955,7 @@   -- |Write a given ByteString to a file, truncating the file beforehand.--- The file must exist. Follows symlinks.+-- Follows symlinks. -- -- Throws: --@@ -930,12 +963,36 @@ --     - `PermissionDenied` if we cannot read the file or the directory --        containting it --     - `NoSuchThing` if the file does not exist-writeFile :: Path b -> ByteString -> IO ()-writeFile (MkPath fp) bs =-  bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] Nothing) (SPI.closeFd) $ \fd -> -    void $ SPB.fdWrite fd bs+writeFile :: Path b+          -> Maybe FileMode  -- ^ if Nothing, file must exist+          -> ByteString+          -> IO ()+writeFile (MkPath fp) fmode bs =+  bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs  +-- |Write a given lazy ByteString to a file, truncating the file beforehand.+-- Follows symlinks.+--+-- Throws:+--+--     - `InappropriateType` if file is not a regular file or a symlink+--     - `PermissionDenied` if we cannot read the file or the directory+--        containting it+--     - `NoSuchThing` if the file does not exist+--+-- Note: uses streamly under the hood+writeFileL :: Path b+           -> Maybe FileMode  -- ^ if Nothing, file must exist+           -> L.ByteString+           -> IO ()+writeFileL (MkPath fp) fmode lbs = do+  handle <- bracketOnError (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) $ SPI.fdToHandle+  finally (streamlyCopy handle) (SIO.hClose handle)+  where+    streamlyCopy tH = S.fold (FH.writeChunks tH) $ SL.fromByteString lbs++ -- |Append a given ByteString to a file. -- The file must exist. Follows symlinks. --@@ -1022,6 +1079,16 @@     $ return False  +-- |Checks whether a file or folder is readable.+--+-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False).+--+-- Throws:+--+--     - `NoSuchThing` if the file does not exist+isReadable :: Path b -> IO Bool+isReadable (MkPath bs) = fileAccess bs True False False+ -- |Checks whether a file or folder is writable. -- -- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False).@@ -1033,6 +1100,18 @@ isWritable (MkPath bs) = fileAccess bs False True False  +-- |Checks whether a file or folder is executable.+--+-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False).+--+-- Throws:+--+--     - `NoSuchThing` if the file does not exist+isExecutable :: Path b -> IO Bool+isExecutable (MkPath bs) = fileAccess bs False False True+++ -- |Checks whether the directory at the given path exists and can be -- opened. This invokes `openDirStream` which follows symlinks. canOpenDirectory :: Path b -> IO Bool@@ -1046,6 +1125,30 @@   +    ------------------+    --[ File times ]--+    ------------------+++getModificationTime :: Path b -> IO UTCTime+getModificationTime (MkPath bs) = do+  fs <- PF.getFileStatus bs+  pure $ posixSecondsToUTCTime $ PF.modificationTimeHiRes fs++setModificationTime :: Path b -> EpochTime -> IO ()+setModificationTime (MkPath bs) t = do+  -- TODO: setFileTimes doesn't allow to pass NULL to utime+  ctime <- epochTime+  PF.setFileTimes bs ctime t++setModificationTimeHiRes :: Path b -> POSIXTime -> IO ()+setModificationTimeHiRes (MkPath bs) t = do+  -- TODO: setFileTimesHiRes doesn't allow to pass NULL to utimes+  ctime <- getPOSIXTime+  PF.setFileTimesHiRes bs ctime t+++     -------------------------     --[ Directory reading ]--     -------------------------@@ -1063,17 +1166,25 @@ --     - `InappropriateType` if file type is wrong (symlink to file) --     - `InappropriateType` if file type is wrong (symlink to dir) --     - `PermissionDenied` if directory cannot be opened+--     - `PathParseException` if a filename could not be parsed (should never happen) getDirsFiles :: Path b        -- ^ dir to read              -> IO [Path b] getDirsFiles p@(MkPath fp) = do+  contents <- getDirsFiles' p+  pure $ fmap (p </>) contents+++-- | Like 'getDirsFiles', but returns the filename only, instead+-- of prepending the base path.+getDirsFiles' :: Path b        -- ^ dir to read+             -> IO [Path Fn]+getDirsFiles' p@(MkPath fp) = do   fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing-  return-    . catMaybes-    .   fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))-    =<< getDirectoryContents' fd-  where-    parseMaybe :: ByteString -> Maybe (Path Fn)-    parseMaybe = parseFn+  rawContents <- getDirectoryContents' fd+  fmap catMaybes $ for rawContents $ \(_, f) ->+      if FP.isSpecialDirectoryEntry f+      then pure Nothing+      else fmap Just $ parseFn f   @@ -1139,3 +1250,37 @@       cwd <- getWorkingDirectory >>= parseAbs       rel <- parseRel bs -- we know it must be relative now       return $ cwd </> rel+++-- | Helper function to use the Path library without+-- buying into the Path type too much. This uses 'parseAny'+-- under the hood and may throw `PathParseException`.+--+-- Throws:+--+--    - `PathParseException` if the bytestring could neither be parsed as+--      relative or absolute Path+withRawFilePath :: MonadThrow m => ByteString -> (Path a -> m b) -> m b+withRawFilePath bs action = do+  path <- parseAny bs+  action path+++-- | Convenience function to open the path as a handle.+--+-- If the file does not exist, it will be created with 'newFilePerms'.+--+-- Throws:+--+--    - `PathParseException` if the bytestring could neither be parsed as+--      relative or absolute Path+withHandle :: ByteString+           -> SPI.OpenMode+           -> ((SIO.Handle, Path a) -> IO a)+           -> IO a+withHandle bs mode action = do+  path   <- parseAny bs+  handle <-+    bracketOnError (openFd bs mode [] (Just newFilePerms)) (SPI.closeFd)+      $ SPI.fdToHandle+  finally (action (handle, path)) (SIO.hClose handle)

@@ -38,6 +38,7 @@   , catchErrno   , rethrowErrnoAs   , handleIOError+  , hideError   , bracketeer   , reactOnError   )@@ -281,9 +282,13 @@ handleIOError = flip catchIOError  +hideError :: IOErrorType -> IO () -> IO ()+hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else ioError e)++ -- |Like `bracket`, but allows to have different clean-up -- actions depending on whether the in-between computation--- has raised an exception or not. +-- has raised an exception or not. bracketeer :: IO a        -- ^ computation to run first            -> (a -> IO b) -- ^ computation to run last, when                           --   no exception was raised

@@ -0,0 +1,45 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Streamly.ByteString.Lazy where++import Control.Monad.IO.Class+import qualified Data.ByteString as BS+import Data.ByteString.Lazy (ByteString, foldlChunks, fromChunks)+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.ByteString (arrayToByteString, byteStringToArray)+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 = do+  ys :: [BS.ByteString] <- S.toList $ S.mapM arrayToByteString stream+  pure $ fromChunks ys++stepFunction ::+     forall m. (MonadIO m)+  => SerialT m (Array Word8)+  -> BS.ByteString+  -> SerialT m (Array Word8)+stepFunction stream1 bs = do+  arr <- liftIO $ byteStringToArray bs+  let stream2 = pure arr+  stream1 <> stream2++fromByteString ::+     forall m. (MonadIO m)+  => ByteString+  -> SerialT m (Array Word8)+fromByteString bs = foldlChunks stepFunction mempty bs+

@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CreateDirIfMissingSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "CreateDirIfMissingSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createDir' "alreadyExists"+  createDir' "noPerms"+  createDir' "noWritePerms"+  noPerms "noPerms"+  noWritableDirPerms "noWritePerms"++++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "noWritePerms"+  deleteDir' "alreadyExists"+  deleteDir' "noPerms"+  deleteDir' "noWritePerms"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.CreateDirIfMissing" $ do++    -- successes --+    it "createDirIfMissing, all fine" $ do+      createDirIfMissing' "newDir"+      removeDirIfExists "newDir"++    it "createDirIfMissing, destination directory already exists" $+      createDirIfMissing' "alreadyExists"++    -- posix failures --+    it "createDirIfMissing, parent directories do not exist" $+      createDirIfMissing' "some/thing/dada"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "createDirIfMissing, can't write to output directory" $+      createDirIfMissing' "noWritePerms/newDir"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "createDirIfMissing, can't open output directory" $+      createDirIfMissing' "noPerms/newDir"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)

@@ -8,7 +8,7 @@     sort   ) import qualified HPath as P-import HPath.IO+import HPath.IO hiding (getDirsFiles') import Test.Hspec import System.IO.Error   (

@@ -0,0 +1,108 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.WriteFileLSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "WriteFileLSpec"+  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" "BLKASL"+++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.WriteFileL" $ do++    -- successes --+    it "WriteFileL file with content, everything clear" $ do+      writeFileL' "fileWithContent" "blahfaselllll"+      out <- readFile' "fileWithContent"+      out `shouldBe` "blahfaselllll"++    it "WriteFileL file with content, everything clear" $ do+      writeFileL' "fileWithContent" "gagagaga"+      out <- readFile' "fileWithContent"+      out `shouldBe` "gagagaga"++    it "WriteFileL file with content, everything clear" $ do+      writeFileL' "fileWithContent" ""+      out <- readFile' "fileWithContent"+      out `shouldBe` ""++    it "WriteFileL file without content, everything clear" $ do+      writeFileL' "fileWithoutContent" "blahfaselllll"+      out <- readFile' "fileWithoutContent"+      out `shouldBe` "blahfaselllll"++    it "WriteFileL, everything clear" $ do+      writeFileL' "fileWithoutContent" "gagagaga"+      out <- readFile' "fileWithoutContent"+      out `shouldBe` "gagagaga"++    it "WriteFileL symlink, everything clear" $ do+      writeFileL' "inputFileSymL" "blahfaselllll"+      out <- readFile' "inputFileSymL"+      out `shouldBe` "blahfaselllll"++    it "WriteFileL symlink, everything clear" $ do+      writeFileL' "inputFileSymL" "gagagaga"+      out <- readFile' "inputFileSymL"+      out `shouldBe` "gagagaga"+++    -- posix failures --+    it "WriteFileL to dir, inappropriate type" $ do+      writeFileL' "alreadyExistsD" ""+        `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)++    it "WriteFileL, no permissions to file" $ do+      writeFileL' "noPerms" ""+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "WriteFileL, no permissions to file" $ do+      writeFileL' "noPermsD/inputFile" ""+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "WriteFileL, file does not exist" $ do+      writeFileL' "gaga" ""+        `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

@@ -19,6 +19,7 @@     whenM   ) import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL import Data.IORef   (     newIORef@@ -163,6 +164,10 @@ {-# NOINLINE createDir' #-} createDir' dest = withTmpDir dest (createDir newDirPerms) +createDirIfMissing' :: ByteString -> IO ()+{-# NOINLINE createDirIfMissing' #-}+createDirIfMissing' dest = withTmpDir dest (createDirIfMissing newDirPerms)+ createDirRecursive' :: ByteString -> IO () {-# NOINLINE createDirRecursive' #-} createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms)@@ -262,8 +267,13 @@  writeFile' :: ByteString -> ByteString -> IO () {-# NOINLINE writeFile' #-}-writeFile' ip bs = -  withTmpDir ip $ \p -> writeFile p bs+writeFile' ip bs =+  withTmpDir ip $ \p -> writeFile p Nothing bs++writeFileL' :: ByteString -> BSL.ByteString -> IO ()+{-# NOINLINE writeFileL' #-}+writeFileL' ip bs =+  withTmpDir ip $ \p -> writeFileL p Nothing bs   appendFile' :: ByteString -> ByteString -> IO ()