Add various new functions to HPath.IO

hpath-io/hpath-io.cabal

@@ -33,14 +33,17 @@ library
   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
                    , safe-exceptions >= 0.1
                    , streamly >= 0.7
+                   , time >= 1.8
                    , unix >= 2.5
                    , unix-bytestring
                    , utf8-string
@@ -65,6 +68,7 @@ test-suite spec
                         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 @@ test-suite spec
                         HPath.IO.RecreateSymlinkSpec
                         HPath.IO.RenameFileSpec
                         HPath.IO.ToAbsSpec
+                        HPath.IO.WriteFileLSpec
                         HPath.IO.WriteFileSpec
                         Spec
                         Utils
@@ -93,6 +98,7 @@ test-suite spec
                       , hpath-io
                       , hspec >= 1.3
                       , process
+                      , time >= 1.8
                       , unix
                       , unix-bytestring
                       , utf8-string

hpath-io/src/HPath/IO.hs

@@ -60,6 +60,7 @@ module HPath.IO
   -- * File creation
   , createRegularFile
   , createDir
+  , createDirIfMissing
   , createDirRecursive
   , createSymlink
   -- * File renaming/moving
@@ -70,6 +71,7 @@ module HPath.IO
   , readFileStream
   -- * File writing
   , writeFile
+  , writeFileL
   , appendFile
   -- * File permissions
   , newFilePerms
@@ -78,15 +80,24 @@ module HPath.IO
   , 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 @@ import Control.Exception.Safe
   (
     IOException
   , bracket
+  , bracketOnError
   , throwIO
+  , finally
   )
 import Control.Monad
   (
@@ -107,6 +120,7 @@ import Control.Monad
   , void
   , when
   )
+import Control.Monad.Catch (MonadThrow(..))
 import Control.Monad.IfElse
   (
     unlessM
@@ -115,6 +129,8 @@ import Data.ByteString
   (
     ByteString
   )
+import           Data.Traversable               ( for )
+import           Data.Functor                   ( ($>) )
 #if MIN_VERSION_bytestring(0,10,2)
 import Data.ByteString.Builder
 #else
@@ -150,6 +166,8 @@ import Data.Monoid
     (<>)
   , mempty
   )
+import Data.Time.Clock
+import Data.Time.Clock.POSIX (getPOSIXTime, posixSecondsToUTCTime, POSIXTime)
 import Data.Word
   (
     Word8
@@ -184,6 +202,7 @@ import HPath.IO.Errors
 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 @@ import System.Posix.Files.ByteString
   , 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 @@ import System.Posix.Types
     FileMode
   , ProcessID
   , Fd
+  , EpochTime
   )
+import System.Posix.Time
 
 
 
@@ -716,6 +738,17 @@ createRegularFile fm (MkPath destBS) =
 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
@@ -734,7 +767,7 @@ createDir fm (MkPath destBS) = createDirectory destBS fm
 --    - `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 @@ readFileStream (MkPath fp) = do
 
 
 -- |Write a given ByteString to a file, truncating the file beforehand.
--- The file must exist. Follows symlinks.
+-- Follows symlinks.
 --
 -- Throws:
 --
@@ -930,10 +963,34 @@ readFileStream (MkPath fp) = do
 --     - `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.
@@ -1022,6 +1079,16 @@ doesDirectoryExist (MkPath bs) =
     $ 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 :: Path b -> IO Bool
 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 @@ canOpenDirectory (MkPath bs) =
 
 
 
+    ------------------
+    --[ 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 @@ canOpenDirectory (MkPath bs) =
 --     - `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 @@ toAbs (MkPath bs) = do
       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)

hpath-io/src/HPath/IO/Errors.hs

@@ -38,6 +38,7 @@ module HPath.IO.Errors
   , catchErrno
   , rethrowErrnoAs
   , handleIOError
+  , hideError
   , bracketeer
   , reactOnError
   )
@@ -281,9 +282,13 @@ handleIOError :: (IOError -> IO a) -> IO a -> IO a
 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

hpath-io/src/Streamly/ByteString/Lazy.hs

@@ -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
+

hpath-io/test/HPath/IO/CreateDirIfMissingSpec.hs

@@ -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)

hpath-io/test/HPath/IO/GetDirsFilesSpec.hs

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

hpath-io/test/HPath/IO/WriteFileLSpec.hs

@@ -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)

hpath-io/test/Utils.hs

@@ -19,6 +19,7 @@ import Control.Monad.IfElse
     whenM
   )
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL
 import Data.IORef
   (
     newIORef
@@ -163,6 +164,10 @@ createDir' :: ByteString -> IO ()
 {-# 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 @@ canonicalizePath' p = withTmpDir p canonicalizePath
 
 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 ()