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