From ecb52f5217fb4a314e6c9f6c7dabf706f4c853e4 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sun, 26 Jan 2020 22:40:03 +0100 Subject: [PATCH] Clean up --- .../src/System/Posix/RawFilePath/Directory.hs | 704 +++++++++--------- hpath-io/hpath-io.cabal | 5 - hpath-io/src/HPath/IO.hs | 278 ++----- 3 files changed, 390 insertions(+), 597 deletions(-) diff --git a/hpath-directory/src/System/Posix/RawFilePath/Directory.hs b/hpath-directory/src/System/Posix/RawFilePath/Directory.hs index 4043c06..d533774 100644 --- a/hpath-directory/src/System/Posix/RawFilePath/Directory.hs +++ b/hpath-directory/src/System/Posix/RawFilePath/Directory.hs @@ -28,8 +28,6 @@ -- > import System.Posix.RawFilePath.Directory {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} module System.Posix.RawFilePath.Directory ( @@ -90,180 +88,135 @@ module System.Posix.RawFilePath.Directory , canonicalizePath , toAbs ) - where - - -import Control.Applicative - ( - (<$>) - ) -import Control.Exception.Safe - ( - IOException - , bracket - , bracketOnError - , throwIO - , finally - ) -import Control.Monad - ( - unless - , void - , when - ) -import Control.Monad.Catch (MonadThrow(..)) -import Control.Monad.Fail (MonadFail) -import Control.Monad.IfElse - ( - unlessM - ) -import qualified Data.ByteString as BS -import Data.ByteString - ( - ByteString - ) +where + + +import Control.Applicative ( (<$>) ) +import Control.Exception.Safe ( IOException + , bracket + , bracketOnError + , throwIO + , finally + ) +import Control.Monad ( unless + , void + , when + ) +import Control.Monad.Catch ( MonadThrow(..) ) +import Control.Monad.Fail ( MonadFail ) +import Control.Monad.IfElse ( unlessM ) +import qualified Data.ByteString as BS +import Data.ByteString ( ByteString ) import Data.Traversable ( for ) import Data.Functor ( ($>) ) #if MIN_VERSION_bytestring(0,10,2) -import Data.ByteString.Builder +import Data.ByteString.Builder #else -import Data.ByteString.Lazy.Builder +import Data.ByteString.Lazy.Builder #endif - ( - Builder - , byteString - , toLazyByteString - ) -import qualified Data.ByteString.Lazy as L -import Data.ByteString.Unsafe - ( - unsafePackCStringFinalizer - ) -import Data.Foldable - ( - for_ - ) -import Data.IORef - ( - IORef - , modifyIORef - , newIORef - , readIORef - ) -import Data.Maybe - ( - catMaybes - ) -import Data.Monoid - ( - (<>) - , mempty - ) -import Data.Time.Clock -import Data.Time.Clock.POSIX (getPOSIXTime, posixSecondsToUTCTime, POSIXTime) -import Data.Word - ( - Word8 - ) -import Foreign.C.Error - ( - eEXIST - , eNOENT - , eNOTEMPTY - , eXDEV - , getErrno - ) -import Foreign.C.Types - ( - CSize - ) -import Foreign.Marshal.Alloc - ( - allocaBytes - ) -import Foreign.Ptr - ( - Ptr - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import Prelude hiding (appendFile, readFile, writeFile) -import Streamly -import Streamly.External.ByteString -import qualified Streamly.External.ByteString.Lazy as SL -import qualified Streamly.Data.Fold as FL -import Streamly.Memory.Array -import qualified Streamly.FileSystem.Handle as FH + ( Builder + , byteString + , toLazyByteString + ) +import qualified Data.ByteString.Lazy as L +import Data.ByteString.Unsafe ( unsafePackCStringFinalizer ) +import qualified Data.ByteString.UTF8 as UTF8 +import Data.Foldable ( for_ ) +import Data.IORef ( IORef + , modifyIORef + , newIORef + , readIORef + ) +import Data.Maybe ( catMaybes ) +import Data.Monoid ( (<>) + , mempty + ) +import Data.Time.Clock +import Data.Time.Clock.POSIX ( getPOSIXTime + , posixSecondsToUTCTime + , POSIXTime + ) +import Data.Word ( Word8 ) +import Foreign.C.Error ( eEXIST + , eNOENT + , eNOTEMPTY + , eXDEV + , getErrno + ) +import Foreign.C.Types ( CSize ) +import Foreign.Marshal.Alloc ( allocaBytes ) +import Foreign.Ptr ( Ptr ) +import GHC.IO.Exception ( IOErrorType(..) ) +import Prelude hiding ( appendFile + , readFile + , writeFile + ) +import Streamly +import Streamly.External.ByteString +import qualified Streamly.External.ByteString.Lazy + as SL +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 - ( - catchIOError - , ioeGetErrorType - ) -import System.Posix.FilePath -import System.Posix.ByteString - ( - exclusive - ) -import System.Posix.RawFilePath.Directory.Errors -import System.Posix.Directory.ByteString - ( - createDirectory - , closeDirStream - , getWorkingDirectory - , openDirStream - , removeDirectory - ) -import System.Posix.RawFilePath.Directory.Traversals - ( - getDirectoryContents' - ) -import System.Posix.Files.ByteString - ( - createSymbolicLink - , fileAccess - , fileMode - , getFdStatus - , groupExecuteMode - , groupReadMode - , groupWriteMode - , otherExecuteMode - , otherReadMode - , otherWriteMode - , ownerModes - , ownerReadMode - , ownerWriteMode - , readSymbolicLink - , removeLink - , rename - , setFileMode - , unionFileModes - ) -import qualified System.Posix.FilePath as FP +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 ( catchIOError + , ioeGetErrorType + ) +import System.Posix.FilePath +import System.Posix.ByteString ( exclusive ) +import System.Posix.RawFilePath.Directory.Errors +import System.Posix.Directory.ByteString + ( createDirectory + , closeDirStream + , getWorkingDirectory + , openDirStream + , removeDirectory + ) +import System.Posix.RawFilePath.Directory.Traversals + ( getDirectoryContents' ) +import System.Posix.Files.ByteString ( createSymbolicLink + , fileAccess + , fileMode + , getFdStatus + , groupExecuteMode + , groupReadMode + , groupWriteMode + , otherExecuteMode + , otherReadMode + , otherWriteMode + , ownerModes + , ownerReadMode + , ownerWriteMode + , readSymbolicLink + , removeLink + , rename + , 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 -import System.Posix.FD - ( - openFd - ) -import qualified System.Posix.RawFilePath.Directory.Traversals as SPDT -import qualified System.Posix.Foreign as SPDF -import qualified System.Posix.Process.ByteString as SPP -import System.Posix.Types - ( - FileMode - , ProcessID - , Fd - , EpochTime - ) -import System.Posix.Time +import qualified "unix" System.Posix.IO.ByteString + as SPI +import qualified "unix-bytestring" System.Posix.IO.ByteString + as SPB +import System.Posix.FD ( openFd ) +import qualified System.Posix.RawFilePath.Directory.Traversals + as SPDT +import qualified System.Posix.Foreign as SPDF +import qualified System.Posix.Process.ByteString + as SPP +import System.Posix.Types ( FileMode + , ProcessID + , Fd + , EpochTime + ) +import System.Posix.Time @@ -372,72 +325,74 @@ copyDirRecursive :: RawFilePath -- ^ source dir -> CopyMode -> RecursiveErrorMode -> IO () -copyDirRecursive fromp destdirp cm rm - = do - ce <- newIORef [] - -- for performance, sanity checks are only done for the top dir - throwSameFile fromp destdirp - throwDestinationInSource fromp destdirp - go ce fromp destdirp - collectedExceptions <- readIORef ce - unless (null collectedExceptions) - (throwIO . RecursiveFailure $ collectedExceptions) - where - basename :: MonadFail m => RawFilePath -> m RawFilePath - basename x = let b = takeBaseName x - in if BS.null b then fail ("No base name" :: String) else pure b - - go :: IORef [(RecursiveFailureHint, IOException)] - -> RawFilePath -> RawFilePath -> IO () - go ce from destdir = do - - -- NOTE: order is important here, so we don't get empty directories - -- on failure - - -- get the contents of the source dir - contents <- handleIOE (ReadContentsFailed from destdir) ce [] $ do - contents <- getDirsFiles from - - -- create the destination dir and - -- only return contents if we succeed - handleIOE (CreateDirFailed from destdir) ce [] $ do - fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus from - case cm of - Strict -> createDirectory destdir fmode' - Overwrite -> catchIOError (createDirectory destdir - fmode') - $ \e -> - case ioeGetErrorType e of - AlreadyExists -> setFileMode destdir - fmode' - _ -> ioError e - return contents - - -- NOTE: we can't use `easyCopy` here, because we want to call `go` - -- recursively to skip the top-level sanity checks - - -- if reading the contents and creating the destination dir worked, - -- then copy the contents to the destination too - for_ contents $ \f -> do - ftype <- getFileType f - newdest <- (destdir ) <$> basename f - case ftype of - SymbolicLink -> handleIOE (RecreateSymlinkFailed f newdest) ce () - $ recreateSymlink f newdest cm - Directory -> go ce f newdest - RegularFile -> handleIOE (CopyFileFailed f newdest) ce () - $ copyFile f newdest cm - _ -> return () - - -- helper to handle errors for both RecursiveErrorModes and return a - -- default value - handleIOE :: RecursiveFailureHint - -> IORef [(RecursiveFailureHint, IOException)] - -> a -> IO a -> IO a - handleIOE hint ce def = case rm of - FailEarly -> handleIOError throwIO - CollectFailures -> handleIOError (\e -> modifyIORef ce ((hint, e):) - >> return def) +copyDirRecursive fromp destdirp cm rm = do + ce <- newIORef [] + -- for performance, sanity checks are only done for the top dir + throwSameFile fromp destdirp + throwDestinationInSource fromp destdirp + go ce fromp destdirp + collectedExceptions <- readIORef ce + unless (null collectedExceptions) + (throwIO . RecursiveFailure $ collectedExceptions) + where + basename :: MonadFail m => RawFilePath -> m RawFilePath + basename x = + let b = takeBaseName x + in if BS.null b then fail ("No base name" :: String) else pure b + + go :: IORef [(RecursiveFailureHint, IOException)] + -> RawFilePath + -> RawFilePath + -> IO () + go ce from destdir = do + + -- NOTE: order is important here, so we don't get empty directories + -- on failure + + -- get the contents of the source dir + contents <- handleIOE (ReadContentsFailed from destdir) ce [] $ do + contents <- getDirsFiles from + + -- create the destination dir and + -- only return contents if we succeed + handleIOE (CreateDirFailed from destdir) ce [] $ do + fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus from + case cm of + Strict -> createDirectory destdir fmode' + Overwrite -> catchIOError (createDirectory destdir fmode') $ \e -> + case ioeGetErrorType e of + AlreadyExists -> setFileMode destdir fmode' + _ -> ioError e + return contents + + -- NOTE: we can't use `easyCopy` here, because we want to call `go` + -- recursively to skip the top-level sanity checks + + -- if reading the contents and creating the destination dir worked, + -- then copy the contents to the destination too + for_ contents $ \f -> do + ftype <- getFileType f + newdest <- (destdir ) <$> basename f + case ftype of + SymbolicLink -> + handleIOE (RecreateSymlinkFailed f newdest) ce () + $ recreateSymlink f newdest cm + Directory -> go ce f newdest + RegularFile -> + handleIOE (CopyFileFailed f newdest) ce () $ copyFile f newdest cm + _ -> return () + + -- helper to handle errors for both RecursiveErrorModes and return a + -- default value + handleIOE :: RecursiveFailureHint + -> IORef [(RecursiveFailureHint, IOException)] + -> a + -> IO a + -> IO a + handleIOE hint ce def = case rm of + FailEarly -> handleIOError throwIO + CollectFailures -> + handleIOError (\e -> modifyIORef ce ((hint, e) :) >> return def) -- |Recreate a symlink. @@ -473,21 +428,20 @@ recreateSymlink :: RawFilePath -- ^ the old symlink file -> RawFilePath -- ^ destination file -> CopyMode -> IO () -recreateSymlink symsource newsym cm - = do - throwSameFile symsource newsym - sympoint <- readSymbolicLink symsource - case cm of - Strict -> return () - Overwrite -> do - writable <- do - e <- doesExist newsym - if e then isWritable newsym else pure False - isfile <- doesFileExist newsym - isdir <- doesDirectoryExist newsym - when (writable && isfile) (deleteFile newsym) - when (writable && isdir) (deleteDir newsym) - createSymbolicLink sympoint newsym +recreateSymlink symsource newsym cm = do + throwSameFile symsource newsym + sympoint <- readSymbolicLink symsource + case cm of + Strict -> return () + Overwrite -> do + writable <- do + e <- doesExist newsym + if e then isWritable newsym else pure False + isfile <- doesFileExist newsym + isdir <- doesDirectoryExist newsym + when (writable && isfile) (deleteFile newsym) + when (writable && isdir) (deleteDir newsym) + createSymbolicLink sympoint newsym -- |Copies the given regular file to the given destination. @@ -534,34 +488,44 @@ copyFile :: RawFilePath -- ^ source file -> IO () copyFile from to cm = do throwSameFile from to - bracket (do - fd <- openFd from SPI.ReadOnly [SPDF.oNofollow] Nothing - handle <- SPI.fdToHandle fd - pure (fd, handle)) - (\(_, handle) -> SIO.hClose handle) + bracket + (do + fd <- openFd from SPI.ReadOnly [SPDF.oNofollow] Nothing + handle <- SPI.fdToHandle fd + pure (fd, handle) + ) + (\(_, handle) -> SIO.hClose handle) $ \(fromFd, fH) -> do - sourceFileMode <- System.Posix.Files.ByteString.fileMode <$> getFdStatus fromFd - let dflags = [SPDF.oNofollow, case cm of - Strict -> SPDF.oExcl - Overwrite -> SPDF.oTrunc] - bracketeer (do - fd <- openFd to SPI.WriteOnly dflags $ Just sourceFileMode - handle <- SPI.fdToHandle fd - pure (fd, handle)) - (\(_, handle) -> SIO.hClose handle) - (\(_, handle) -> do - SIO.hClose handle - case cm of - -- if we created the file and copying failed, it's - -- safe to clean up - Strict -> deleteFile to - Overwrite -> pure ()) - $ \(_, tH) -> do - SIO.hSetBinaryMode fH True - SIO.hSetBinaryMode tH True - streamlyCopy (fH, tH) - where - streamlyCopy (fH, tH) = S.fold (FH.writeChunks tH) $ IFH.toChunksWithBufferOf (256*1024) fH + sourceFileMode <- System.Posix.Files.ByteString.fileMode + <$> getFdStatus fromFd + let dflags = + [ SPDF.oNofollow + , case cm of + Strict -> SPDF.oExcl + Overwrite -> SPDF.oTrunc + ] + bracketeer + (do + fd <- openFd to SPI.WriteOnly dflags $ Just sourceFileMode + handle <- SPI.fdToHandle fd + pure (fd, handle) + ) + (\(_, handle) -> SIO.hClose handle) + (\(_, handle) -> do + SIO.hClose handle + case cm of + -- if we created the file and copying failed, it's + -- safe to clean up + Strict -> deleteFile to + Overwrite -> pure () + ) + $ \(_, tH) -> do + SIO.hSetBinaryMode fH True + SIO.hSetBinaryMode tH True + streamlyCopy (fH, tH) + where + streamlyCopy (fH, tH) = + S.fold (FH.writeChunks tH) $ IFH.toChunksWithBufferOf (256 * 1024) fH -- |Copies a regular file, directory or symbolic link. In case of a -- symbolic link it is just recreated, even if it points to a directory. @@ -581,10 +545,10 @@ easyCopy :: RawFilePath easyCopy from to cm rm = do ftype <- getFileType from case ftype of - SymbolicLink -> recreateSymlink from to cm - RegularFile -> copyFile from to cm - Directory -> copyDirRecursive from to cm rm - _ -> return () + SymbolicLink -> recreateSymlink from to cm + RegularFile -> copyFile from to cm + Directory -> copyDirRecursive from to cm rm + _ -> return () @@ -644,19 +608,16 @@ deleteDir = removeDirectory -- - `NoSuchThing` if directory does not exist -- - `PermissionDenied` if we can't open or write to parent directory deleteDirRecursive :: RawFilePath -> IO () -deleteDirRecursive p = - catchErrno [eNOTEMPTY, eEXIST] - (deleteDir p) - $ do - files <- getDirsFiles p - for_ files $ \file -> do - ftype <- getFileType file - case ftype of - SymbolicLink -> deleteFile file - Directory -> deleteDirRecursive file - RegularFile -> deleteFile file - _ -> return () - removeDirectory p +deleteDirRecursive p = catchErrno [eNOTEMPTY, eEXIST] (deleteDir p) $ do + files <- getDirsFiles p + for_ files $ \file -> do + ftype <- getFileType file + case ftype of + SymbolicLink -> deleteFile file + Directory -> deleteDirRecursive file + RegularFile -> deleteFile file + _ -> return () + removeDirectory p -- |Deletes a file, directory or symlink. @@ -687,18 +648,16 @@ easyDelete p = do -- |Opens a file appropriately by invoking xdg-open. The file type -- is not checked. This forks a process. -openFile :: RawFilePath - -> IO ProcessID -openFile fp = - SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing +openFile :: RawFilePath -> IO ProcessID +openFile fp = SPP.forkProcess + $ SPP.executeFile (UTF8.fromString "xdg-open") True [fp] Nothing -- |Executes a program with the given arguments. This forks a process. executeFile :: RawFilePath -- ^ program -> [ByteString] -- ^ arguments -> IO ProcessID -executeFile fp args = - SPP.forkProcess $ SPP.executeFile fp True args Nothing +executeFile fp args = SPP.forkProcess $ SPP.executeFile fp True args Nothing @@ -718,11 +677,14 @@ executeFile fp args = -- - `NoSuchThing` if any of the parent components of the path -- do not exist createRegularFile :: FileMode -> RawFilePath -> IO () -createRegularFile fm destBS = - bracket (SPI.openFd destBS SPI.WriteOnly (Just fm) - (SPI.defaultFileFlags { exclusive = True })) - SPI.closeFd - (\_ -> return ()) +createRegularFile fm destBS = bracket + (SPI.openFd destBS + SPI.WriteOnly + (Just fm) + (SPI.defaultFileFlags { exclusive = True }) + ) + SPI.closeFd + (\_ -> return ()) -- |Create an empty directory at the given directory with the given filename. @@ -769,18 +731,21 @@ createDirIfMissing fm destBS = -- -- Note: calls `getcwd` if the input path is a relative path createDirRecursive :: FileMode -> RawFilePath -> IO () -createDirRecursive fm p = - go p - where - go :: RawFilePath -> IO () - go dest = do - catchIOError (createDirectory dest fm) $ \e -> do - errno <- getErrno - case errno of - en | en == eEXIST -> unlessM (doesDirectoryExist dest) (ioError e) - | en == eNOENT -> createDirRecursive fm (takeDirectory dest) - >> createDirectory dest fm - | otherwise -> ioError e +createDirRecursive fm p = go p + where + go :: RawFilePath -> IO () + go dest = do + catchIOError (createDirectory dest fm) $ \e -> do + errno <- getErrno + case errno of + en + | en == eEXIST + -> unlessM (doesDirectoryExist dest) (ioError e) + | en == eNOENT + -> createDirRecursive fm (takeDirectory dest) + >> createDirectory dest fm + | otherwise + -> ioError e -- |Create a symlink. @@ -796,8 +761,7 @@ createDirRecursive fm p = createSymlink :: RawFilePath -- ^ destination file -> RawFilePath -- ^ path the symlink points to -> IO () -createSymlink destBS sympoint - = createSymbolicLink sympoint destBS +createSymlink destBS sympoint = createSymbolicLink sympoint destBS @@ -875,13 +839,13 @@ moveFile from to cm = do throwSameFile from to case cm of Strict -> catchErrno [eXDEV] (renameFile from to) $ do - easyCopy from to Strict FailEarly - easyDelete from + easyCopy from to Strict FailEarly + easyDelete from Overwrite -> do - ft <- getFileType from + ft <- getFileType from writable <- do - e <- doesFileExist to - if e then isWritable to else pure False + e <- doesFileExist to + if e then isWritable to else pure False case ft of RegularFile -> do @@ -936,12 +900,12 @@ readFile path = do -- - `PermissionDenied` if we cannot read the file or the directory -- containting it -- - `NoSuchThing` if the file does not exist -readFileStream :: RawFilePath - -> IO (SerialT IO ByteString) +readFileStream :: RawFilePath -> IO (SerialT IO ByteString) readFileStream fp = do - fd <- openFd fp SPI.ReadOnly [] Nothing + fd <- openFd fp SPI.ReadOnly [] Nothing handle <- SPI.fdToHandle fd - let stream = fmap fromArray (S.unfold (SU.finally SIO.hClose FH.readChunks) handle) + let stream = + fmap fromArray (S.unfold (SU.finally SIO.hClose FH.readChunks) handle) pure stream @@ -966,7 +930,8 @@ writeFile :: RawFilePath -> ByteString -> IO () writeFile fp fmode bs = - bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd 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. @@ -985,10 +950,11 @@ writeFileL :: RawFilePath -> L.ByteString -> IO () writeFileL fp fmode lbs = do - handle <- bracketOnError (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) $ SPI.fdToHandle + 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.toChunks lbs + where streamlyCopy tH = S.fold (FH.writeChunks tH) $ SL.toChunks lbs -- |Append a given ByteString to a file. @@ -1002,8 +968,8 @@ writeFileL fp fmode lbs = do -- - `NoSuchThing` if the file does not exist appendFile :: RawFilePath -> ByteString -> IO () appendFile fp bs = - bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing) - (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs + bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing) (SPI.closeFd) + $ \fd -> void $ SPB.fdWrite fd bs @@ -1015,8 +981,8 @@ appendFile fp bs = -- |Default permissions for a new file. newFilePerms :: FileMode -newFilePerms - = ownerWriteMode +newFilePerms = + ownerWriteMode `unionFileModes` ownerReadMode `unionFileModes` groupWriteMode `unionFileModes` groupReadMode @@ -1026,8 +992,8 @@ newFilePerms -- |Default permissions for a new directory. newDirPerms :: FileMode -newDirPerms - = ownerModes +newDirPerms = + ownerModes `unionFileModes` groupExecuteMode `unionFileModes` groupReadMode `unionFileModes` otherExecuteMode @@ -1047,9 +1013,12 @@ newDirPerms -- Only eNOENT is catched (and returns False). doesExist :: RawFilePath -> IO Bool doesExist bs = - catchErrno [eNOENT] (do - _ <- PF.getSymbolicLinkStatus bs - return $ True) + catchErrno + [eNOENT] + (do + _ <- PF.getSymbolicLinkStatus bs + return $ True + ) $ return False @@ -1059,9 +1028,12 @@ doesExist bs = -- Only eNOENT is catched (and returns False). doesFileExist :: RawFilePath -> IO Bool doesFileExist bs = - catchErrno [eNOENT] (do - fs <- PF.getSymbolicLinkStatus bs - return $ not . PF.isDirectory $ fs) + catchErrno + [eNOENT] + (do + fs <- PF.getSymbolicLinkStatus bs + return $ not . PF.isDirectory $ fs + ) $ return False @@ -1071,9 +1043,12 @@ doesFileExist bs = -- Only eNOENT is catched (and returns False). doesDirectoryExist :: RawFilePath -> IO Bool doesDirectoryExist bs = - catchErrno [eNOENT] (do - fs <- PF.getSymbolicLinkStatus bs - return $ PF.isDirectory fs) + catchErrno + [eNOENT] + (do + fs <- PF.getSymbolicLinkStatus bs + return $ PF.isDirectory fs + ) $ return False @@ -1113,12 +1088,9 @@ isExecutable 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 :: RawFilePath -> IO Bool -canOpenDirectory bs = - handleIOError (\_ -> return False) $ do - bracket (openDirStream bs) - closeDirStream - (\_ -> return ()) - return True +canOpenDirectory bs = handleIOError (\_ -> return False) $ do + bracket (openDirStream bs) closeDirStream (\_ -> return ()) + return True @@ -1176,12 +1148,10 @@ getDirsFiles p = do getDirsFiles' :: RawFilePath -- ^ dir to read -> IO [RawFilePath] getDirsFiles' fp = do - fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing + fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing rawContents <- getDirectoryContents' fd fmap catMaybes $ for rawContents $ \(_, f) -> - if FP.isSpecialDirectoryEntry f - then pure Nothing - else pure $ Just f + if FP.isSpecialDirectoryEntry f then pure Nothing else pure $ Just f @@ -1202,16 +1172,15 @@ getFileType :: RawFilePath -> IO FileType getFileType fp = do fs <- PF.getSymbolicLinkStatus fp decide fs - where - decide fs - | PF.isDirectory fs = return Directory - | PF.isRegularFile fs = return RegularFile - | PF.isSymbolicLink fs = return SymbolicLink - | PF.isBlockDevice fs = return BlockDevice - | PF.isCharacterDevice fs = return CharacterDevice - | PF.isNamedPipe fs = return NamedPipe - | PF.isSocket fs = return Socket - | otherwise = ioError $ userError "No filetype?!" + where + decide fs | PF.isDirectory fs = return Directory + | PF.isRegularFile fs = return RegularFile + | PF.isSymbolicLink fs = return SymbolicLink + | PF.isBlockDevice fs = return BlockDevice + | PF.isCharacterDevice fs = return CharacterDevice + | PF.isNamedPipe fs = return NamedPipe + | PF.isSocket fs = return Socket + | otherwise = ioError $ userError "No filetype?!" @@ -1243,4 +1212,3 @@ toAbs bs = do False -> do cwd <- getWorkingDirectory return $ cwd bs - diff --git a/hpath-io/hpath-io.cabal b/hpath-io/hpath-io.cabal index e48614e..262d17c 100644 --- a/hpath-io/hpath-io.cabal +++ b/hpath-io/hpath-io.cabal @@ -26,19 +26,14 @@ library buildable: False exposed-modules: HPath.IO build-depends: base >= 4.8 && <5 - , IfElse , bytestring >= 0.10.0.0 , exceptions , hpath >= 0.11 && < 0.12 , hpath-directory >= 0.13 && < 0.14 - , hpath-filepath >= 0.10.2 && < 0.11 , safe-exceptions >= 0.1 , streamly >= 0.7 - , streamly-bytestring >= 0.1 , time >= 1.8 , unix >= 2.5 - , unix-bytestring - , utf8-string if !impl(ghc>=7.11) build-depends: transformers hs-source-dirs: src diff --git a/hpath-io/src/HPath/IO.hs b/hpath-io/src/HPath/IO.hs index 754ea60..f6aec1d 100644 --- a/hpath-io/src/HPath/IO.hs +++ b/hpath-io/src/HPath/IO.hs @@ -27,10 +27,7 @@ -- For other functions (like `copyFile`), the behavior on these file types is -- unreliable/unsafe. Check the documentation of those functions for details. -{-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} module HPath.IO ( @@ -68,8 +65,8 @@ module HPath.IO , writeFileL , appendFile -- * File permissions - , newFilePerms - , newDirPerms + , RD.newFilePerms + , RD.newDirPerms -- * File checks , doesExist , doesFileExist @@ -94,180 +91,43 @@ module HPath.IO , withHandle , module System.Posix.RawFilePath.Directory.Errors ) - where +where -import Control.Applicative - ( - (<$>) - ) -import Control.Exception.Safe - ( - IOException - , bracket - , bracketOnError - , throwIO - , finally - ) -import Control.Monad - ( - unless - , void - , when - ) -import Control.Monad.Catch (MonadThrow(..)) -import Control.Monad.IfElse - ( - unlessM - ) -import Data.ByteString - ( - ByteString - ) -import Data.Traversable ( for ) -import Data.Functor ( ($>) ) -#if MIN_VERSION_bytestring(0,10,2) -import Data.ByteString.Builder -#else -import Data.ByteString.Lazy.Builder -#endif - ( - Builder - , byteString - , toLazyByteString - ) -import qualified Data.ByteString.Lazy as L -import Data.ByteString.Unsafe - ( - unsafePackCStringFinalizer - ) -import Data.Foldable - ( - for_ - ) -import Data.IORef - ( - IORef - , modifyIORef - , newIORef - , readIORef - ) -import Data.Maybe - ( - catMaybes - ) -import Data.Monoid - ( - (<>) - , mempty - ) -import Data.Time.Clock -import Data.Time.Clock.POSIX (getPOSIXTime, posixSecondsToUTCTime, POSIXTime) -import Data.Word - ( - Word8 - ) -import Foreign.C.Error - ( - eEXIST - , eNOENT - , eNOTEMPTY - , eXDEV - , getErrno - ) -import Foreign.C.Types - ( - CSize - ) -import Foreign.Marshal.Alloc - ( - allocaBytes - ) -import Foreign.Ptr - ( - Ptr - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import HPath -import Prelude hiding (appendFile, readFile, writeFile) -import Streamly -import Streamly.External.ByteString -import qualified Streamly.External.ByteString.Lazy as SL -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 - ( - catchIOError - , ioeGetErrorType - ) -import System.Posix.ByteString - ( - exclusive - ) -import System.Posix.Directory.ByteString - ( - createDirectory - , closeDirStream - , getWorkingDirectory - , openDirStream - , removeDirectory - ) -import System.Posix.Files.ByteString - ( - createSymbolicLink - , fileAccess - , fileMode - , getFdStatus - , groupExecuteMode - , groupReadMode - , groupWriteMode - , otherExecuteMode - , otherReadMode - , otherWriteMode - , ownerModes - , ownerReadMode - , ownerWriteMode - , readSymbolicLink - , removeLink - , rename - , 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 -import System.Posix.FD - ( - openFd - ) -import qualified System.Posix.Process.ByteString as SPP -import System.Posix.RawFilePath.Directory.Errors -import System.Posix.Types - ( - FileMode - , ProcessID - , Fd - , EpochTime - ) -import System.Posix.Time +import Control.Exception.Safe ( bracketOnError + , finally + ) +import Control.Monad.Catch ( MonadThrow(..) ) -import qualified System.Posix.RawFilePath.Directory as RD -import System.Posix.RawFilePath.Directory - ( - FileType - , RecursiveErrorMode - , CopyMode - ) +import Data.ByteString ( ByteString ) +import Data.Traversable ( for ) +import qualified Data.ByteString.Lazy as L +import Data.Time.Clock +import Data.Time.Clock.POSIX ( POSIXTime ) +import HPath +import Prelude hiding ( appendFile + , readFile + , writeFile + ) +import Streamly +import qualified System.IO as SIO +import System.Posix.Directory.ByteString + ( getWorkingDirectory ) +import qualified "unix" System.Posix.IO.ByteString + as SPI +import System.Posix.FD ( openFd ) +import System.Posix.RawFilePath.Directory.Errors +import System.Posix.Types ( FileMode + , ProcessID + , EpochTime + ) +import qualified System.Posix.RawFilePath.Directory + as RD +import System.Posix.RawFilePath.Directory + ( FileType + , RecursiveErrorMode + , CopyMode + ) @@ -337,8 +197,8 @@ copyDirRecursive :: Path b1 -- ^ source dir -> CopyMode -> RecursiveErrorMode -> IO () -copyDirRecursive (Path fromp) (Path destdirp) cm rm - = RD.copyDirRecursive fromp destdirp cm rm +copyDirRecursive (Path fromp) (Path destdirp) cm rm = + RD.copyDirRecursive fromp destdirp cm rm -- |Recreate a symlink. @@ -374,8 +234,8 @@ recreateSymlink :: Path b1 -- ^ the old symlink file -> Path b2 -- ^ destination file -> CopyMode -> IO () -recreateSymlink (Path symsourceBS) (Path newsymBS) cm - = RD.recreateSymlink symsourceBS newsymBS cm +recreateSymlink (Path symsourceBS) (Path newsymBS) cm = + RD.recreateSymlink symsourceBS newsymBS cm -- |Copies the given regular file to the given destination. @@ -432,11 +292,7 @@ copyFile (Path from) (Path to) cm = RD.copyFile from to cm -- * calls `copyDirRecursive` for directories -- -- Note: may call `getcwd` in Overwrite mode (if destination is a relative path) -easyCopy :: Path b1 - -> Path b2 - -> CopyMode - -> RecursiveErrorMode - -> IO () +easyCopy :: Path b1 -> Path b2 -> CopyMode -> RecursiveErrorMode -> IO () easyCopy (Path from) (Path to) cm rm = RD.easyCopy from to cm rm @@ -522,8 +378,7 @@ easyDelete (Path p) = RD.easyDelete p -- |Opens a file appropriately by invoking xdg-open. The file type -- is not checked. This forks a process. -openFile :: Path b - -> IO ProcessID +openFile :: Path b -> IO ProcessID openFile (Path fp) = RD.openFile fp @@ -725,8 +580,7 @@ readFile (Path path) = RD.readFile path -- - `PermissionDenied` if we cannot read the file or the directory -- containting it -- - `NoSuchThing` if the file does not exist -readFileStream :: Path b - -> IO (SerialT IO ByteString) +readFileStream :: Path b -> IO (SerialT IO ByteString) readFileStream (Path fp) = RD.readFileStream fp @@ -786,33 +640,6 @@ appendFile (Path fp) bs = RD.appendFile fp bs - ----------------------- - --[ File Permissions]-- - ----------------------- - - --- |Default permissions for a new file. -newFilePerms :: FileMode -newFilePerms - = ownerWriteMode - `unionFileModes` ownerReadMode - `unionFileModes` groupWriteMode - `unionFileModes` groupReadMode - `unionFileModes` otherWriteMode - `unionFileModes` otherReadMode - - --- |Default permissions for a new directory. -newDirPerms :: FileMode -newDirPerms - = ownerModes - `unionFileModes` groupExecuteMode - `unionFileModes` groupReadMode - `unionFileModes` otherExecuteMode - `unionFileModes` otherReadMode - - - ------------------- --[ File checks ]-- @@ -920,7 +747,7 @@ setModificationTimeHiRes (Path bs) t = RD.setModificationTimeHiRes bs t -- - `PathParseException` if a filename could not be parsed (should never happen) getDirsFiles :: Path b -- ^ dir to read -> IO [Path b] -getDirsFiles p@(Path fp) = do +getDirsFiles p = do contents <- getDirsFiles' p pure $ fmap (p ) contents @@ -928,7 +755,7 @@ getDirsFiles p@(Path fp) = do -- | Like 'getDirsFiles', but returns the filename only, instead -- of prepending the base path. getDirsFiles' :: Path b -- ^ dir to read - -> IO [Path Rel] + -> IO [Path Rel] getDirsFiles' (Path fp) = do rawContents <- RD.getDirsFiles' fp for rawContents $ \r -> parseRel r @@ -981,11 +808,11 @@ toAbs :: Path b -> IO (Path Abs) toAbs (Path bs) = do let mabs = parseAbs bs :: Maybe (Path Abs) case mabs of - Just a -> return a - Nothing -> do + Just a -> return a + Nothing -> do cwd <- getWorkingDirectory >>= parseAbs - rel <- parseRel bs -- we know it must be relative now - return $ cwd rel + r <- parseRel bs -- we know it must be relative now + return $ cwd r -- | Helper function to use the Path library without @@ -996,7 +823,10 @@ toAbs (Path bs) = do -- -- - `PathParseException` if the bytestring could neither be parsed as -- relative or absolute Path -withRawFilePath :: MonadThrow m => ByteString -> (Either (Path Abs) (Path Rel) -> m b) -> m b +withRawFilePath :: MonadThrow m + => ByteString + -> (Either (Path Abs) (Path Rel) -> m b) + -> m b withRawFilePath bs action = do path <- parseAny bs action path @@ -1017,6 +847,6 @@ withHandle :: ByteString withHandle bs mode action = do path <- parseAny bs handle <- - bracketOnError (openFd bs mode [] (Just newFilePerms)) (SPI.closeFd) + bracketOnError (openFd bs mode [] (Just RD.newFilePerms)) (SPI.closeFd) $ SPI.fdToHandle finally (action (handle, path)) (SIO.hClose handle)