-- |
-- Module      :  HPath.IO
-- Copyright   :  © 2016 Julian Ospald
-- License     :  BSD3
--
-- Maintainer  :  Julian Ospald <hasufell@posteo.de>
-- Stability   :  experimental
-- Portability :  portable
--
-- This module provides high-level IO related file operations like
-- copy, delete, move and so on. It only operates on /Path x/ which
-- guarantees us well-typed paths. Passing in /Path Abs/ to any
-- of these functions generally increases safety. Passing /Path Rel/
-- may trigger looking up the current directory via `getcwd` in some
-- cases where it cannot be avoided.
--
-- Some functions are just path-safe wrappers around
-- unix functions, others have stricter exception handling
-- and some implement functionality that doesn't have a unix
-- counterpart (like `copyDirRecursive`).
--
-- Some of these operations are due to their nature __not atomic__, which
-- means they may do multiple syscalls which form one context. Some
-- of them also have to examine the filetypes explicitly before the
-- syscalls, so a reasonable decision can be made. That means
-- the result is undefined if another process changes that context
-- while the non-atomic operation is still happening. However, where
-- possible, as few syscalls as possible are used and the underlying
-- exception handling is kept.
--
-- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket`
-- are ignored by some of the more high-level functions (like `easyCopy`).
-- 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 #-}

module HPath.IO
  (
  -- * Types
    FileType(..)
  , RecursiveErrorMode(..)
  , CopyMode(..)
  -- * File copying
  , copyDirRecursive
  , recreateSymlink
  , copyFile
  , easyCopy
  -- * File deletion
  , deleteFile
  , deleteDir
  , deleteDirRecursive
  , easyDelete
  -- * File opening
  , openFile
  , executeFile
  -- * File creation
  , createRegularFile
  , createDir
  , createDirRecursive
  , createSymlink
  -- * File renaming/moving
  , renameFile
  , moveFile
  -- * File reading
  , readFile
  , readFileEOF
  -- * File writing
  , writeFile
  , appendFile
  -- * File permissions
  , newFilePerms
  , newDirPerms
  -- * Directory reading
  , getDirsFiles
  -- * Filetype operations
  , getFileType
  -- * Others
  , canonicalizePath
  , toAbs
  )
  where


import Control.Applicative
  (
    (<$>)
  )
import Control.Exception
  (
    IOException
  , bracket
  , throwIO
  )
import Control.Monad
  (
    unless
  , void
  , when
  )
import Control.Monad.IfElse
  (
    unlessM
  )
import Data.ByteString
  (
    ByteString
  )
#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.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 HPath.Internal
import HPath.IO.Errors
import Prelude hiding (appendFile, readFile, writeFile)
import qualified Streamly.FileSystem.Handle as FH
import qualified Streamly.Internal.FileSystem.Handle as IFH
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
  , getWorkingDirectory
  , removeDirectory
  )
import System.Posix.Directory.Traversals
  (
    getDirectoryContents'
  )
import System.Posix.Files.ByteString
  (
    createSymbolicLink
  , fileMode
  , getFdStatus
  , groupExecuteMode
  , groupReadMode
  , groupWriteMode
  , otherExecuteMode
  , otherReadMode
  , otherWriteMode
  , ownerModes
  , ownerReadMode
  , ownerWriteMode
  , readSymbolicLink
  , removeLink
  , rename
  , setFileMode
  , unionFileModes
  )
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.Directory.Traversals as SPDT
import qualified System.Posix.Directory.Foreign as SPDF
import qualified System.Posix.Process.ByteString as SPP
import System.Posix.Types
  (
    FileMode
  , ProcessID
  , Fd
  )





    -------------
    --[ Types ]--
    -------------


data FileType = Directory
              | RegularFile
              | SymbolicLink
              | BlockDevice
              | CharacterDevice
              | NamedPipe
              | Socket
  deriving (FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c== :: FileType -> FileType -> Bool
Eq, Int -> FileType -> ShowS
[FileType] -> ShowS
FileType -> String
(Int -> FileType -> ShowS)
-> (FileType -> String) -> ([FileType] -> ShowS) -> Show FileType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileType] -> ShowS
$cshowList :: [FileType] -> ShowS
show :: FileType -> String
$cshow :: FileType -> String
showsPrec :: Int -> FileType -> ShowS
$cshowsPrec :: Int -> FileType -> ShowS
Show)



-- |The error mode for recursive operations.
--
-- On `FailEarly` the whole operation fails immediately if any of the
-- recursive sub-operations fail, which is sort of the default
-- for IO operations.
--
-- On `CollectFailures` skips errors in the recursion and keeps on recursing.
-- However all errors are collected in the `RecursiveFailure` error type,
-- which is raised finally if there was any error. Also note that
-- `RecursiveFailure` does not give any guarantees on the ordering
-- of the collected exceptions.
data RecursiveErrorMode = FailEarly
                        | CollectFailures


-- |The mode for copy and file moves.
-- Overwrite mode is usually not very well defined, but is a convenience
-- shortcut.
data CopyMode = Strict    -- ^ fail if any target exists
              | Overwrite -- ^ overwrite targets




    --------------------
    --[ File Copying ]--
    --------------------



-- |Copies the contents of a directory recursively to the given destination, while preserving permissions.
-- Does not follow symbolic links. This behaves more or less like
-- the following, without descending into the destination if it
-- already exists:
--
-- @
--   cp -a \/source\/dir \/destination\/somedir
-- @
--
-- For directory contents, this will ignore any file type that is not
-- `RegularFile`, `SymbolicLink` or `Directory`.
--
-- For `Overwrite` copy mode this does not prune destination directory
-- contents, so the destination might contain more files than the source after
-- the operation has completed. Permissions of existing directories are
-- fixed.
--
-- Safety/reliability concerns:
--
--    * not atomic
--    * examines filetypes explicitly
--    * an explicit check `throwDestinationInSource` is carried out for the
--      top directory for basic sanity, because otherwise we might end up
--      with an infinite copy loop... however, this operation is not
--      carried out recursively (because it's slow)
--
-- Throws:
--
--    - `NoSuchThing` if source directory does not exist
--    - `PermissionDenied` if source directory can't be opened
--    - `SameFile` if source and destination are the same file
--      (`HPathIOException`)
--    - `DestinationInSource` if destination is contained in source
--      (`HPathIOException`)
--
-- Throws in `FailEarly` RecursiveErrorMode only:
--
--    - `PermissionDenied` if output directory is not writable
--    - `InvalidArgument` if source directory is wrong type (symlink)
--    - `InappropriateType` if source directory is wrong type (regular file)
--
-- Throws in `CollectFailures` RecursiveErrorMode only:
--
--    - `RecursiveFailure` if any of the recursive operations that are not
--      part of the top-directory sanity-checks fail (`HPathIOException`)
--
-- Throws in `Strict` CopyMode only:
--
--    - `AlreadyExists` if destination already exists
--
-- Note: may call `getcwd` (only if destination is a relative path)
copyDirRecursive :: Path b1  -- ^ source dir
                 -> Path b2  -- ^ destination (parent dirs
                             --   are not automatically created)
                 -> CopyMode
                 -> RecursiveErrorMode
                 -> IO ()
copyDirRecursive :: Path b1 -> Path b2 -> CopyMode -> RecursiveErrorMode -> IO ()
copyDirRecursive fromp :: Path b1
fromp destdirp :: Path b2
destdirp cm :: CopyMode
cm rm :: RecursiveErrorMode
rm
  = do
    IORef [(RecursiveFailureHint, IOException)]
ce <- [(RecursiveFailureHint, IOException)]
-> IO (IORef [(RecursiveFailureHint, IOException)])
forall a. a -> IO (IORef a)
newIORef []
    -- for performance, sanity checks are only done for the top dir
    Path b1 -> Path b2 -> IO ()
forall b1 b2. Path b1 -> Path b2 -> IO ()
throwSameFile Path b1
fromp Path b2
destdirp
    Path b1 -> Path b2 -> IO ()
forall b1 b2. Path b1 -> Path b2 -> IO ()
throwDestinationInSource Path b1
fromp Path b2
destdirp
    IORef [(RecursiveFailureHint, IOException)]
-> Path b1 -> Path b2 -> IO ()
forall b1 b2.
IORef [(RecursiveFailureHint, IOException)]
-> Path b1 -> Path b2 -> IO ()
go IORef [(RecursiveFailureHint, IOException)]
ce Path b1
fromp Path b2
destdirp
    [(RecursiveFailureHint, IOException)]
collectedExceptions <- IORef [(RecursiveFailureHint, IOException)]
-> IO [(RecursiveFailureHint, IOException)]
forall a. IORef a -> IO a
readIORef IORef [(RecursiveFailureHint, IOException)]
ce
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(RecursiveFailureHint, IOException)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RecursiveFailureHint, IOException)]
collectedExceptions)
           (HPathIOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HPathIOException -> IO ())
-> ([(RecursiveFailureHint, IOException)] -> HPathIOException)
-> [(RecursiveFailureHint, IOException)]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RecursiveFailureHint, IOException)] -> HPathIOException
RecursiveFailure ([(RecursiveFailureHint, IOException)] -> IO ())
-> [(RecursiveFailureHint, IOException)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [(RecursiveFailureHint, IOException)]
collectedExceptions)
  where
    go :: IORef [(RecursiveFailureHint, IOException)]
       -> Path b1 -> Path b2 -> IO ()
    go :: IORef [(RecursiveFailureHint, IOException)]
-> Path b1 -> Path b2 -> IO ()
go ce :: IORef [(RecursiveFailureHint, IOException)]
ce fromp' :: Path b1
fromp'@(MkPath fromBS :: ByteString
fromBS) destdirp' :: Path b2
destdirp'@(MkPath destdirpBS :: ByteString
destdirpBS) = do

      -- NOTE: order is important here, so we don't get empty directories
      -- on failure

      -- get the contents of the source dir
      [Path b1]
contents <- RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)]
-> [Path b1]
-> IO [Path b1]
-> IO [Path b1]
forall a.
RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)] -> a -> IO a -> IO a
handleIOE (ByteString -> ByteString -> RecursiveFailureHint
ReadContentsFailed ByteString
fromBS ByteString
destdirpBS) IORef [(RecursiveFailureHint, IOException)]
ce [] (IO [Path b1] -> IO [Path b1]) -> IO [Path b1] -> IO [Path b1]
forall a b. (a -> b) -> a -> b
$ do
        [Path b1]
contents <- Path b1 -> IO [Path b1]
forall b. Path b -> IO [Path b]
getDirsFiles Path b1
fromp'

        -- create the destination dir and
        -- only return contents if we succeed
        RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)]
-> [Path b1]
-> IO [Path b1]
-> IO [Path b1]
forall a.
RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)] -> a -> IO a -> IO a
handleIOE (ByteString -> ByteString -> RecursiveFailureHint
CreateDirFailed ByteString
fromBS ByteString
destdirpBS) IORef [(RecursiveFailureHint, IOException)]
ce [] (IO [Path b1] -> IO [Path b1]) -> IO [Path b1] -> IO [Path b1]
forall a b. (a -> b) -> a -> b
$ do
          FileMode
fmode' <- FileStatus -> FileMode
PF.fileMode (FileStatus -> FileMode) -> IO FileStatus -> IO FileMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO FileStatus
PF.getSymbolicLinkStatus ByteString
fromBS
          case CopyMode
cm of
            Strict    -> ByteString -> FileMode -> IO ()
createDirectory ByteString
destdirpBS FileMode
fmode'
            Overwrite -> IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
catchIOError (ByteString -> FileMode -> IO ()
createDirectory ByteString
destdirpBS
                                                       FileMode
fmode')
                           ((IOException -> IO ()) -> IO ())
-> (IOException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \e :: IOException
e ->
                             case IOException -> IOErrorType
ioeGetErrorType IOException
e of
                               AlreadyExists -> ByteString -> FileMode -> IO ()
setFileMode ByteString
destdirpBS
                                                            FileMode
fmode'
                               _             -> IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e
          [Path b1] -> IO [Path b1]
forall (m :: * -> *) a. Monad m => a -> m a
return [Path b1]
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
      [Path b1] -> (Path b1 -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Path b1]
contents ((Path b1 -> IO ()) -> IO ()) -> (Path b1 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \f :: Path b1
f -> do
        FileType
ftype <- Path b1 -> IO FileType
forall b. Path b -> IO FileType
getFileType Path b1
f
        Path b2
newdest <- (Path b2
destdirp' Path b2 -> Path Fn -> Path b2
forall r b. RelC r => Path b -> Path r -> Path b
</>) (Path Fn -> Path b2) -> IO (Path Fn) -> IO (Path b2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path b1 -> IO (Path Fn)
forall (m :: * -> *) b. MonadThrow m => Path b -> m (Path Fn)
basename Path b1
f
        case FileType
ftype of
          SymbolicLink -> RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)]
-> ()
-> IO ()
-> IO ()
forall a.
RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)] -> a -> IO a -> IO a
handleIOE (ByteString -> ByteString -> RecursiveFailureHint
RecreateSymlinkFailed (Path b1 -> ByteString
forall b. Path b -> ByteString
toFilePath Path b1
f) (Path b2 -> ByteString
forall b. Path b -> ByteString
toFilePath Path b2
newdest)) IORef [(RecursiveFailureHint, IOException)]
ce ()
                            (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path b1 -> Path b2 -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
recreateSymlink Path b1
f Path b2
newdest CopyMode
cm
          Directory    -> IORef [(RecursiveFailureHint, IOException)]
-> Path b1 -> Path b2 -> IO ()
forall b1 b2.
IORef [(RecursiveFailureHint, IOException)]
-> Path b1 -> Path b2 -> IO ()
go IORef [(RecursiveFailureHint, IOException)]
ce Path b1
f Path b2
newdest
          RegularFile  -> RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)]
-> ()
-> IO ()
-> IO ()
forall a.
RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)] -> a -> IO a -> IO a
handleIOE (ByteString -> ByteString -> RecursiveFailureHint
CopyFileFailed (Path b1 -> ByteString
forall b. Path b -> ByteString
toFilePath Path b1
f) (Path b2 -> ByteString
forall b. Path b -> ByteString
toFilePath Path b2
newdest)) IORef [(RecursiveFailureHint, IOException)]
ce ()
                            (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path b1 -> Path b2 -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile Path b1
f Path b2
newdest CopyMode
cm
          _            -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    -- helper to handle errors for both RecursiveErrorModes and return a
    -- default value
    handleIOE :: RecursiveFailureHint
              -> IORef [(RecursiveFailureHint, IOException)]
              -> a -> IO a -> IO a
    handleIOE :: RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)] -> a -> IO a -> IO a
handleIOE hint :: RecursiveFailureHint
hint ce :: IORef [(RecursiveFailureHint, IOException)]
ce def :: a
def = case RecursiveErrorMode
rm of
      FailEarly       -> (IOException -> IO a) -> IO a -> IO a
forall a. (IOException -> IO a) -> IO a -> IO a
handleIOError IOException -> IO a
forall e a. Exception e => e -> IO a
throwIO
      CollectFailures -> (IOException -> IO a) -> IO a -> IO a
forall a. (IOException -> IO a) -> IO a -> IO a
handleIOError (\e :: IOException
e -> IORef [(RecursiveFailureHint, IOException)]
-> ([(RecursiveFailureHint, IOException)]
    -> [(RecursiveFailureHint, IOException)])
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [(RecursiveFailureHint, IOException)]
ce ((RecursiveFailureHint
hint, IOException
e)(RecursiveFailureHint, IOException)
-> [(RecursiveFailureHint, IOException)]
-> [(RecursiveFailureHint, IOException)]
forall a. a -> [a] -> [a]
:)
                                         IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
def)


-- |Recreate a symlink.
--
-- In `Overwrite` copy mode only files and empty directories are deleted.
--
-- Safety/reliability concerns:
--
--    * `Overwrite` mode is inherently non-atomic
--
-- Throws:
--
--    - `InvalidArgument` if source file is wrong type (not a symlink)
--    - `PermissionDenied` if output directory cannot be written to
--    - `PermissionDenied` if source directory cannot be opened
--    - `SameFile` if source and destination are the same file
--      (`HPathIOException`)
--
--
-- Throws in `Strict` mode only:
--
--    - `AlreadyExists` if destination already exists
--
-- Throws in `Overwrite` mode only:
--
--    - `UnsatisfiedConstraints` if destination file is non-empty directory
--
-- Notes:
--
--    - calls `symlink`
--    - calls `getcwd` in Overwrite mode (if destination is a relative path)
recreateSymlink :: Path b1   -- ^ the old symlink file
                -> Path b2   -- ^ destination file
                -> CopyMode
                -> IO ()
recreateSymlink :: Path b1 -> Path b2 -> CopyMode -> IO ()
recreateSymlink symsource :: Path b1
symsource@(MkPath symsourceBS :: ByteString
symsourceBS) newsym :: Path b2
newsym@(MkPath newsymBS :: ByteString
newsymBS) cm :: CopyMode
cm
  = do
    Path b1 -> Path b2 -> IO ()
forall b1 b2. Path b1 -> Path b2 -> IO ()
throwSameFile Path b1
symsource Path b2
newsym
    ByteString
sympoint <- ByteString -> IO ByteString
readSymbolicLink ByteString
symsourceBS
    case CopyMode
cm of
      Strict -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Overwrite -> do
        Bool
writable <- Path b2 -> IO (Path Abs)
forall b. Path b -> IO (Path Abs)
toAbs Path b2
newsym IO (Path Abs) -> (Path Abs -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs -> IO Bool
forall b. Path b -> IO Bool
isWritable
        Bool
isfile   <- Path b2 -> IO Bool
forall b. Path b -> IO Bool
doesFileExist Path b2
newsym
        Bool
isdir    <- Path b2 -> IO Bool
forall b. Path b -> IO Bool
doesDirectoryExist Path b2
newsym
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
writable Bool -> Bool -> Bool
&& Bool
isfile) (Path b2 -> IO ()
forall b. Path b -> IO ()
deleteFile Path b2
newsym)
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
writable Bool -> Bool -> Bool
&& Bool
isdir)  (Path b2 -> IO ()
forall b. Path b -> IO ()
deleteDir Path b2
newsym)
    ByteString -> ByteString -> IO ()
createSymbolicLink ByteString
sympoint ByteString
newsymBS


-- |Copies the given regular file to the given destination.
-- Neither follows symbolic links, nor accepts them.
-- For "copying" symbolic links, use `recreateSymlink` instead.
--
-- Note that this is still sort of a low-level function and doesn't
-- examine file types. For a more high-level version, use `easyCopy`
-- instead.
--
-- In `Overwrite` copy mode only overwrites actual files, not directories.
-- In `Strict` mode the destination file must not exist.
--
-- Safety/reliability concerns:
--
--    * `Overwrite` mode is not atomic
--    * when used on `CharacterDevice`, reads the "contents" and copies
--      them to a regular file, which might take indefinitely
--    * when used on `BlockDevice`, may either read the "contents"
--      and copy them to a regular file (potentially hanging indefinitely)
--      or may create a regular empty destination file
--    * when used on `NamedPipe`, will hang indefinitely
--
-- Throws:
--
--    - `NoSuchThing` if source file does not exist
--    - `NoSuchThing` if source file is a a `Socket`
--    - `PermissionDenied` if output directory is not writable
--    - `PermissionDenied` if source directory can't be opened
--    - `InvalidArgument` if source file is wrong type (symlink or directory)
--    - `SameFile` if source and destination are the same file
--      (`HPathIOException`)
--
-- Throws in `Strict` mode only:
--
--    - `AlreadyExists` if destination already exists
--
-- Notes:
--
--    - may call `getcwd` in Overwrite mode (if destination is a relative path)
copyFile :: Path b1   -- ^ source file
         -> Path b2   -- ^ destination file
         -> CopyMode
         -> IO ()
copyFile :: Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile fp :: Path b1
fp@(MkPath from :: ByteString
from) tp :: Path b2
tp@(MkPath to :: ByteString
to) cm :: CopyMode
cm = do
  Path b1 -> Path b2 -> IO ()
forall b1 b2. Path b1 -> Path b2 -> IO ()
throwSameFile Path b1
fp Path b2
tp
  IO (Fd, Handle)
-> ((Fd, Handle) -> IO ()) -> ((Fd, Handle) -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (do
            Fd
fd <- ByteString -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd ByteString
from OpenMode
SPI.ReadOnly [Flags
SPDF.oNofollow] Maybe FileMode
forall a. Maybe a
Nothing
            Handle
handle <- Fd -> IO Handle
SPI.fdToHandle Fd
fd
            (Fd, Handle) -> IO (Fd, Handle)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fd
fd, Handle
handle))
    (\(_, handle :: Handle
handle) -> Handle -> IO ()
SIO.hClose Handle
handle)
    (((Fd, Handle) -> IO ()) -> IO ())
-> ((Fd, Handle) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(fromFd :: Fd
fromFd, fH :: Handle
fH) -> do
                   FileMode
sourceFileMode <- FileStatus -> FileMode
System.Posix.Files.ByteString.fileMode (FileStatus -> FileMode) -> IO FileStatus -> IO FileMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fd -> IO FileStatus
getFdStatus Fd
fromFd
                   let dflags :: [Flags]
dflags = [Flags
SPDF.oNofollow, case CopyMode
cm of
                                                      Strict    -> Flags
SPDF.oExcl
                                                      Overwrite -> Flags
SPDF.oTrunc]
                   IO (Fd, Handle)
-> ((Fd, Handle) -> IO ())
-> ((Fd, Handle) -> IO ())
-> ((Fd, Handle) -> IO ())
-> IO ()
forall a b c.
IO a -> (a -> IO b) -> (a -> IO b) -> (a -> IO c) -> IO c
bracketeer (do
                                Fd
fd <- ByteString -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd ByteString
to OpenMode
SPI.WriteOnly [Flags]
dflags (Maybe FileMode -> IO Fd) -> Maybe FileMode -> IO Fd
forall a b. (a -> b) -> a -> b
$ FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
sourceFileMode
                                Handle
handle <- Fd -> IO Handle
SPI.fdToHandle Fd
fd
                                (Fd, Handle) -> IO (Fd, Handle)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fd
fd, Handle
handle))
                              (\(_, handle :: Handle
handle) -> Handle -> IO ()
SIO.hClose Handle
handle)
                              (\(_, handle :: Handle
handle) -> do
                                                 Handle -> IO ()
SIO.hClose Handle
handle
                                                 case CopyMode
cm of
                                                      -- if we created the file and copying failed, it's
                                                      -- safe to clean up
                                                      Strict -> Path b2 -> IO ()
forall b. Path b -> IO ()
deleteFile Path b2
tp
                                                      Overwrite -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
                              (((Fd, Handle) -> IO ()) -> IO ())
-> ((Fd, Handle) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(_, tH :: Handle
tH) -> do
                                           Handle -> Bool -> IO ()
SIO.hSetBinaryMode Handle
fH Bool
True
                                           Handle -> Bool -> IO ()
SIO.hSetBinaryMode Handle
tH Bool
True
                                           (Handle, Handle) -> IO ()
forall (m :: * -> *). MonadIO m => (Handle, Handle) -> m ()
streamlyCopy (Handle
fH, Handle
tH)
  where
    streamlyCopy :: (Handle, Handle) -> m ()
streamlyCopy (fH :: Handle
fH, tH :: Handle
tH) = Fold m (Array Word8) () -> SerialT m (Array Word8) -> m ()
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> SerialT m a -> m b
S.fold (Handle -> Fold m (Array Word8) ()
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Handle -> Fold m (Array a) ()
FH.writeChunks Handle
tH) (SerialT m (Array Word8) -> m ())
-> SerialT m (Array Word8) -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Handle -> SerialT m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadIO m) =>
Int -> Handle -> t m (Array Word8)
IFH.toChunksWithBufferOf (256Int -> Int -> Int
forall a. Num a => a -> a -> a
*1024) Handle
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.
-- Any other file type is ignored.
--
-- Safety/reliability concerns:
--
--    * examines filetypes explicitly
--    * 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 from :: Path b1
from to :: Path b2
to cm :: CopyMode
cm rm :: RecursiveErrorMode
rm = do
  FileType
ftype <- Path b1 -> IO FileType
forall b. Path b -> IO FileType
getFileType Path b1
from
  case FileType
ftype of
       SymbolicLink -> Path b1 -> Path b2 -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
recreateSymlink Path b1
from Path b2
to CopyMode
cm
       RegularFile  -> Path b1 -> Path b2 -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile Path b1
from Path b2
to CopyMode
cm
       Directory    -> Path b1 -> Path b2 -> CopyMode -> RecursiveErrorMode -> IO ()
forall b1 b2.
Path b1 -> Path b2 -> CopyMode -> RecursiveErrorMode -> IO ()
copyDirRecursive Path b1
from Path b2
to CopyMode
cm RecursiveErrorMode
rm
       _            -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()





    ---------------------
    --[ File Deletion ]--
    ---------------------


-- |Deletes the given file. Raises `eISDIR`
-- if run on a directory. Does not follow symbolic links.
--
-- Throws:
--
--    - `InappropriateType` for wrong file type (directory)
--    - `NoSuchThing` if the file does not exist
--    - `PermissionDenied` if the directory cannot be read
deleteFile :: Path b -> IO ()
deleteFile :: Path b -> IO ()
deleteFile (MkPath p :: ByteString
p) = ByteString -> IO ()
removeLink ByteString
p


-- |Deletes the given directory, which must be empty, never symlinks.
--
-- Throws:
--
--    - `InappropriateType` for wrong file type (symlink to directory)
--    - `InappropriateType` for wrong file type (regular file)
--    - `NoSuchThing` if directory does not exist
--    - `UnsatisfiedConstraints` if directory is not empty
--    - `PermissionDenied` if we can't open or write to parent directory
--
-- Notes: calls `rmdir`
deleteDir :: Path b -> IO ()
deleteDir :: Path b -> IO ()
deleteDir (MkPath p :: ByteString
p) = ByteString -> IO ()
removeDirectory ByteString
p


-- |Deletes the given directory recursively. Does not follow symbolic
-- links. Tries `deleteDir` first before attemtping a recursive
-- deletion.
--
-- On directory contents this behaves like `easyDelete`
-- and thus will ignore any file type that is not `RegularFile`,
-- `SymbolicLink` or `Directory`.
--
-- Safety/reliability concerns:
--
--    * not atomic
--    * examines filetypes explicitly
--
-- Throws:
--
--    - `InappropriateType` for wrong file type (symlink to directory)
--    - `InappropriateType` for wrong file type (regular file)
--    - `NoSuchThing` if directory does not exist
--    - `PermissionDenied` if we can't open or write to parent directory
deleteDirRecursive :: Path b -> IO ()
deleteDirRecursive :: Path b -> IO ()
deleteDirRecursive p :: Path b
p =
  [Errno] -> IO () -> IO () -> IO ()
forall a. [Errno] -> IO a -> IO a -> IO a
catchErrno [Errno
eNOTEMPTY, Errno
eEXIST]
             (Path b -> IO ()
forall b. Path b -> IO ()
deleteDir Path b
p)
    (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [Path b]
files <- Path b -> IO [Path b]
forall b. Path b -> IO [Path b]
getDirsFiles Path b
p
      [Path b] -> (Path b -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Path b]
files ((Path b -> IO ()) -> IO ()) -> (Path b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \file :: Path b
file -> do
        FileType
ftype <- Path b -> IO FileType
forall b. Path b -> IO FileType
getFileType Path b
file
        case FileType
ftype of
          SymbolicLink -> Path b -> IO ()
forall b. Path b -> IO ()
deleteFile Path b
file
          Directory    -> Path b -> IO ()
forall b. Path b -> IO ()
deleteDirRecursive Path b
file
          RegularFile  -> Path b -> IO ()
forall b. Path b -> IO ()
deleteFile Path b
file
          _            -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ByteString -> IO ()
removeDirectory (ByteString -> IO ()) -> (Path b -> ByteString) -> Path b -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b -> ByteString
forall b. Path b -> ByteString
toFilePath (Path b -> IO ()) -> Path b -> IO ()
forall a b. (a -> b) -> a -> b
$ Path b
p


-- |Deletes a file, directory or symlink.
-- In case of directory, performs recursive deletion. In case of
-- a symlink, the symlink file is deleted.
-- Any other file type is ignored.
--
-- Safety/reliability concerns:
--
--    * examines filetypes explicitly
--    * calls `deleteDirRecursive` for directories
easyDelete :: Path b -> IO ()
easyDelete :: Path b -> IO ()
easyDelete p :: Path b
p = do
  FileType
ftype <- Path b -> IO FileType
forall b. Path b -> IO FileType
getFileType Path b
p
  case FileType
ftype of
    SymbolicLink -> Path b -> IO ()
forall b. Path b -> IO ()
deleteFile Path b
p
    Directory    -> Path b -> IO ()
forall b. Path b -> IO ()
deleteDirRecursive Path b
p
    RegularFile  -> Path b -> IO ()
forall b. Path b -> IO ()
deleteFile Path b
p
    _            -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()




    --------------------
    --[ File Opening ]--
    --------------------


-- |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 (MkPath fp :: ByteString
fp) =
  IO () -> IO ProcessID
SPP.forkProcess (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ ByteString
-> Bool
-> [ByteString]
-> Maybe [(ByteString, ByteString)]
-> IO ()
forall a.
ByteString
-> Bool -> [ByteString] -> Maybe [(ByteString, ByteString)] -> IO a
SPP.executeFile "xdg-open" Bool
True [ByteString
fp] Maybe [(ByteString, ByteString)]
forall a. Maybe a
Nothing


-- |Executes a program with the given arguments. This forks a process.
executeFile :: Path b          -- ^ program
            -> [ByteString]    -- ^ arguments
            -> IO ProcessID
executeFile :: Path b -> [ByteString] -> IO ProcessID
executeFile (MkPath fp :: ByteString
fp) args :: [ByteString]
args =
  IO () -> IO ProcessID
SPP.forkProcess (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ ByteString
-> Bool
-> [ByteString]
-> Maybe [(ByteString, ByteString)]
-> IO ()
forall a.
ByteString
-> Bool -> [ByteString] -> Maybe [(ByteString, ByteString)] -> IO a
SPP.executeFile ByteString
fp Bool
True [ByteString]
args Maybe [(ByteString, ByteString)]
forall a. Maybe a
Nothing




    ---------------------
    --[ File Creation ]--
    ---------------------


-- |Create an empty regular file at the given directory with the given
-- filename.
--
-- Throws:
--
--    - `PermissionDenied` if output directory cannot be written to
--    - `AlreadyExists` if destination already exists
--    - `NoSuchThing` if any of the parent components of the path
--      do not exist
createRegularFile :: FileMode -> Path b -> IO ()
createRegularFile :: FileMode -> Path b -> IO ()
createRegularFile fm :: FileMode
fm (MkPath destBS :: ByteString
destBS) =
  IO Fd -> (Fd -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ByteString -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
SPI.openFd ByteString
destBS OpenMode
SPI.WriteOnly (FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
fm)
                      (OpenFileFlags
SPI.defaultFileFlags { exclusive :: Bool
exclusive = Bool
True }))
          Fd -> IO ()
SPI.closeFd
          (\_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())


-- |Create an empty directory at the given directory with the given filename.
--
-- Throws:
--
--    - `PermissionDenied` if output directory cannot be written to
--    - `AlreadyExists` if destination already exists
--    - `NoSuchThing` if any of the parent components of the path
--      do not exist
createDir :: FileMode -> Path b -> IO ()
createDir :: FileMode -> Path b -> IO ()
createDir fm :: FileMode
fm (MkPath destBS :: ByteString
destBS) = ByteString -> FileMode -> IO ()
createDirectory ByteString
destBS FileMode
fm


-- |Create an empty directory at the given directory with the given filename.
-- All parent directories are created with the same filemode. This
-- basically behaves like:
--
-- @
--   mkdir -p \/some\/dir
-- @
--
-- Safety/reliability concerns:
--
--    * not atomic
--
-- Throws:
--
--    - `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
--
-- Note: calls `getcwd` if the input path is a relative path
createDirRecursive :: FileMode -> Path b -> IO ()
createDirRecursive :: FileMode -> Path b -> IO ()
createDirRecursive fm :: FileMode
fm p :: Path b
p =
  Path b -> IO (Path Abs)
forall b. Path b -> IO (Path Abs)
toAbs Path b
p IO (Path Abs) -> (Path Abs -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs -> IO ()
go
  where
    go :: Path Abs -> IO ()
    go :: Path Abs -> IO ()
go dest :: Path Abs
dest@(MkPath destBS :: ByteString
destBS) = do
      IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
catchIOError (ByteString -> FileMode -> IO ()
createDirectory ByteString
destBS FileMode
fm) ((IOException -> IO ()) -> IO ())
-> (IOException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \e :: IOException
e -> do
        Errno
errno <- IO Errno
getErrno
        case Errno
errno of
             en :: Errno
en | Errno
en Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eEXIST -> IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Path Abs -> IO Bool
forall b. Path b -> IO Bool
doesDirectoryExist Path Abs
dest) (IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e)
                | Errno
en Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eNOENT -> FileMode -> Path Abs -> IO ()
forall b. FileMode -> Path b -> IO ()
createDirRecursive FileMode
fm (Path Abs -> Path Abs
dirname Path Abs
dest)
                                  IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> FileMode -> IO ()
createDirectory ByteString
destBS FileMode
fm
                | Bool
otherwise    -> IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e


-- |Create a symlink.
--
-- Throws:
--
--    - `PermissionDenied` if output directory cannot be written to
--    - `AlreadyExists` if destination file already exists
--    - `NoSuchThing` if any of the parent components of the path
--      do not exist
--
-- Note: calls `symlink`
createSymlink :: Path b     -- ^ destination file
              -> ByteString -- ^ path the symlink points to
              -> IO ()
createSymlink :: Path b -> ByteString -> IO ()
createSymlink (MkPath destBS :: ByteString
destBS) sympoint :: ByteString
sympoint
  = ByteString -> ByteString -> IO ()
createSymbolicLink ByteString
sympoint ByteString
destBS



    ----------------------------
    --[ File Renaming/Moving ]--
    ----------------------------


-- |Rename a given file with the provided filename. Destination and source
-- must be on the same device, otherwise `eXDEV` will be raised.
--
-- Does not follow symbolic links, but renames the symbolic link file.
--
-- Safety/reliability concerns:
--
--    * has a separate set of exception handling, apart from the syscall
--
-- Throws:
--
--     - `NoSuchThing` if source file does not exist
--     - `PermissionDenied` if output directory cannot be written to
--     - `PermissionDenied` if source directory cannot be opened
--     - `UnsupportedOperation` if source and destination are on different
--       devices
--     - `AlreadyExists` if destination already exists
--     - `SameFile` if destination and source are the same file
--       (`HPathIOException`)
--
-- Note: calls `rename` (but does not allow to rename over existing files)
renameFile :: Path b1 -> Path b2 -> IO ()
renameFile :: Path b1 -> Path b2 -> IO ()
renameFile fromf :: Path b1
fromf@(MkPath fromfBS :: ByteString
fromfBS) tof :: Path b2
tof@(MkPath tofBS :: ByteString
tofBS) = do
  Path b1 -> Path b2 -> IO ()
forall b1 b2. Path b1 -> Path b2 -> IO ()
throwSameFile Path b1
fromf Path b2
tof
  Path b2 -> IO ()
forall b. Path b -> IO ()
throwFileDoesExist Path b2
tof
  Path b2 -> IO ()
forall b. Path b -> IO ()
throwDirDoesExist Path b2
tof
  ByteString -> ByteString -> IO ()
rename ByteString
fromfBS ByteString
tofBS


-- |Move a file. This also works across devices by copy-delete fallback.
-- And also works on directories.
--
-- Does not follow symbolic links, but renames the symbolic link file.
--
--
-- Safety/reliability concerns:
--
--    * `Overwrite` mode is not atomic
--    * copy-delete fallback is inherently non-atomic
--    * since this function calls `easyCopy` and `easyDelete` as a fallback
--      to `renameFile`, file types that are not `RegularFile`, `SymbolicLink`
--      or `Directory` may be ignored
--    * for `Overwrite` mode, the destination will be deleted (not recursively)
--      before moving
--
-- Throws:
--
--     - `NoSuchThing` if source file does not exist
--     - `PermissionDenied` if output directory cannot be written to
--     - `PermissionDenied` if source directory cannot be opened
--     - `SameFile` if destination and source are the same file
--       (`HPathIOException`)
--
-- Throws in `Strict` mode only:
--
--    - `AlreadyExists` if destination already exists
--
-- Notes:
--
--    - calls `rename` (but does not allow to rename over existing files)
--    - calls `getcwd` in Overwrite mode if destination is a relative path
moveFile :: Path b1   -- ^ file to move
         -> Path b2   -- ^ destination
         -> CopyMode
         -> IO ()
moveFile :: Path b1 -> Path b2 -> CopyMode -> IO ()
moveFile from :: Path b1
from to :: Path b2
to cm :: CopyMode
cm = do
  Path b1 -> Path b2 -> IO ()
forall b1 b2. Path b1 -> Path b2 -> IO ()
throwSameFile Path b1
from Path b2
to
  case CopyMode
cm of
    Strict -> [Errno] -> IO () -> IO () -> IO ()
forall a. [Errno] -> IO a -> IO a -> IO a
catchErrno [Errno
eXDEV] (Path b1 -> Path b2 -> IO ()
forall b1 b2. Path b1 -> Path b2 -> IO ()
renameFile Path b1
from Path b2
to) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Path b1 -> Path b2 -> CopyMode -> RecursiveErrorMode -> IO ()
forall b1 b2.
Path b1 -> Path b2 -> CopyMode -> RecursiveErrorMode -> IO ()
easyCopy Path b1
from Path b2
to CopyMode
Strict RecursiveErrorMode
FailEarly
                Path b1 -> IO ()
forall b. Path b -> IO ()
easyDelete Path b1
from
    Overwrite -> do
      FileType
ft <- Path b1 -> IO FileType
forall b. Path b -> IO FileType
getFileType Path b1
from
      Bool
writable <- Path b2 -> IO (Path Abs)
forall b. Path b -> IO (Path Abs)
toAbs Path b2
to IO (Path Abs) -> (Path Abs -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs -> IO Bool
forall b. Path b -> IO Bool
isWritable
      case FileType
ft of
        RegularFile -> do
          Bool
exists <- Path b2 -> IO Bool
forall b. Path b -> IO Bool
doesFileExist Path b2
to
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
exists Bool -> Bool -> Bool
&& Bool
writable) (Path b2 -> IO ()
forall b. Path b -> IO ()
deleteFile Path b2
to)
        SymbolicLink -> do
          Bool
exists <- Path b2 -> IO Bool
forall b. Path b -> IO Bool
doesFileExist Path b2
to
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
exists Bool -> Bool -> Bool
&& Bool
writable) (Path b2 -> IO ()
forall b. Path b -> IO ()
deleteFile Path b2
to)
        Directory -> do
          Bool
exists <- Path b2 -> IO Bool
forall b. Path b -> IO Bool
doesDirectoryExist Path b2
to
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
exists Bool -> Bool -> Bool
&& Bool
writable) (Path b2 -> IO ()
forall b. Path b -> IO ()
deleteDir Path b2
to)
        _ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Path b1 -> Path b2 -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
moveFile Path b1
from Path b2
to CopyMode
Strict





    --------------------
    --[ File Reading ]--
    --------------------


-- |Read the given file at once into memory as a strict ByteString.
-- Symbolic links are followed, no sanity checks on file size
-- or file type. File must exist.
--
-- Note: the size of the file is determined in advance, as to only
-- have one allocation.
--
-- Safety/reliability concerns:
--
--    * since amount of bytes to read is determined in advance,
--      the file might be read partially only if something else is
--      appending to it while reading
--    * the whole file is read into memory!
--
-- 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
readFile :: Path b -> IO ByteString
readFile :: Path b -> IO ByteString
readFile (MkPath fp :: ByteString
fp) =
  IO Fd -> (Fd -> IO ()) -> (Fd -> IO ByteString) -> IO ByteString
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ByteString -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd ByteString
fp OpenMode
SPI.ReadOnly [] Maybe FileMode
forall a. Maybe a
Nothing) (Fd -> IO ()
SPI.closeFd) ((Fd -> IO ByteString) -> IO ByteString)
-> (Fd -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \fd :: Fd
fd -> do
    FileStatus
stat <- Fd -> IO FileStatus
PF.getFdStatus Fd
fd
    let fsize :: FileOffset
fsize = FileStatus -> FileOffset
PF.fileSize FileStatus
stat
    Fd -> ByteCount -> IO ByteString
SPB.fdRead Fd
fd (FileOffset -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
fsize)


-- |Read the given file in chunks of size `8192` into memory until
-- `fread` returns 0. Returns a lazy ByteString, because it uses
-- Builders under the hood.
--
-- Safety/reliability concerns:
--
--    * the whole file is read into memory!
--
-- 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
readFileEOF :: Path b -> IO L.ByteString
readFileEOF :: Path b -> IO ByteString
readFileEOF (MkPath fp :: ByteString
fp) =
  IO Fd -> (Fd -> IO ()) -> (Fd -> IO ByteString) -> IO ByteString
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ByteString -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd ByteString
fp OpenMode
SPI.ReadOnly [] Maybe FileMode
forall a. Maybe a
Nothing) (Fd -> IO ()
SPI.closeFd) ((Fd -> IO ByteString) -> IO ByteString)
-> (Fd -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \fd :: Fd
fd ->
    Int -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (ByteCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bufSize) ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \buf :: Ptr Word8
buf -> Fd -> Ptr Word8 -> Builder -> IO ByteString
read' Fd
fd Ptr Word8
buf Builder
forall a. Monoid a => a
mempty
  where
    bufSize :: CSize
    bufSize :: ByteCount
bufSize = 8192
    read' :: Fd -> Ptr Word8 -> Builder -> IO L.ByteString
    read' :: Fd -> Ptr Word8 -> Builder -> IO ByteString
read' fd :: Fd
fd buf :: Ptr Word8
buf builder :: Builder
builder = do
        ByteCount
size <- Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
SPB.fdReadBuf Fd
fd Ptr Word8
buf ByteCount
bufSize
        if ByteCount
size ByteCount -> ByteCount -> Bool
forall a. Eq a => a -> a -> Bool
== 0
          then ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString Builder
builder
          else do
            ByteString
readBS <- Ptr Word8 -> Int -> IO () -> IO ByteString
unsafePackCStringFinalizer Ptr Word8
buf
                                                 (ByteCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
size)
                                                 (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
            Fd -> Ptr Word8 -> Builder -> IO ByteString
read' Fd
fd Ptr Word8
buf (Builder
builder Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
readBS)




    --------------------
    --[ File Writing ]--
    --------------------


-- |Write a given ByteString to a file, truncating the file beforehand.
-- The file must exist. 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
writeFile :: Path b -> ByteString -> IO ()
writeFile :: Path b -> ByteString -> IO ()
writeFile (MkPath fp :: ByteString
fp) bs :: ByteString
bs =
  IO Fd -> (Fd -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ByteString -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd ByteString
fp OpenMode
SPI.WriteOnly [Flags
SPDF.oTrunc] Maybe FileMode
forall a. Maybe a
Nothing) (Fd -> IO ()
SPI.closeFd) ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \fd :: Fd
fd -> 
    IO ByteCount -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ByteCount -> IO ()) -> IO ByteCount -> IO ()
forall a b. (a -> b) -> a -> b
$ Fd -> ByteString -> IO ByteCount
SPB.fdWrite Fd
fd ByteString
bs


-- |Append a given ByteString to a file.
-- The file must exist. 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
appendFile :: Path b -> ByteString -> IO ()
appendFile :: Path b -> ByteString -> IO ()
appendFile (MkPath fp :: ByteString
fp) bs :: ByteString
bs =
  IO Fd -> (Fd -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ByteString -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd ByteString
fp OpenMode
SPI.WriteOnly [Flags
SPDF.oAppend] Maybe FileMode
forall a. Maybe a
Nothing)
          (Fd -> IO ()
SPI.closeFd) ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \fd :: Fd
fd -> IO ByteCount -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ByteCount -> IO ()) -> IO ByteCount -> IO ()
forall a b. (a -> b) -> a -> b
$ Fd -> ByteString -> IO ByteCount
SPB.fdWrite Fd
fd ByteString
bs




    -----------------------
    --[ File Permissions]--
    -----------------------


-- |Default permissions for a new file.
newFilePerms :: FileMode
newFilePerms :: FileMode
newFilePerms
  =                  FileMode
ownerWriteMode
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
ownerReadMode
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
groupWriteMode
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
groupReadMode
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
otherWriteMode
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
otherReadMode


-- |Default permissions for a new directory.
newDirPerms :: FileMode
newDirPerms :: FileMode
newDirPerms
  =                  FileMode
ownerModes
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
groupExecuteMode
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
groupReadMode
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
otherExecuteMode
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
otherReadMode



    -------------------------
    --[ Directory reading ]--
    -------------------------


-- |Gets all filenames of the given directory. This excludes "." and "..".
-- This version does not follow symbolic links.
--
-- The contents are not sorted and there is no guarantee on the ordering.
--
-- Throws:
--
--     - `NoSuchThing` if directory does not exist
--     - `InappropriateType` if file type is wrong (file)
--     - `InappropriateType` if file type is wrong (symlink to file)
--     - `InappropriateType` if file type is wrong (symlink to dir)
--     - `PermissionDenied` if directory cannot be opened
getDirsFiles :: Path b        -- ^ dir to read
             -> IO [Path b]
getDirsFiles :: Path b -> IO [Path b]
getDirsFiles p :: Path b
p@(MkPath fp :: ByteString
fp) = do
  Fd
fd <- ByteString -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd ByteString
fp OpenMode
SPI.ReadOnly [Flags
SPDF.oNofollow] Maybe FileMode
forall a. Maybe a
Nothing
  [Path b] -> IO [Path b]
forall (m :: * -> *) a. Monad m => a -> m a
return
    ([Path b] -> IO [Path b])
-> ([(DirType, ByteString)] -> [Path b])
-> [(DirType, ByteString)]
-> IO [Path b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Path b)] -> [Path b]
forall a. [Maybe a] -> [a]
catMaybes
    ([Maybe (Path b)] -> [Path b])
-> ([(DirType, ByteString)] -> [Maybe (Path b)])
-> [(DirType, ByteString)]
-> [Path b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   ((DirType, ByteString) -> Maybe (Path b))
-> [(DirType, ByteString)] -> [Maybe (Path b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: (DirType, ByteString)
x -> Path b -> Path Fn -> Path b
forall r b. RelC r => Path b -> Path r -> Path b
(</>) Path b
p (Path Fn -> Path b) -> Maybe (Path Fn) -> Maybe (Path b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Maybe (Path Fn)
parseMaybe (ByteString -> Maybe (Path Fn))
-> ((DirType, ByteString) -> ByteString)
-> (DirType, ByteString)
-> Maybe (Path Fn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DirType, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((DirType, ByteString) -> Maybe (Path Fn))
-> (DirType, ByteString) -> Maybe (Path Fn)
forall a b. (a -> b) -> a -> b
$ (DirType, ByteString)
x))
    ([(DirType, ByteString)] -> IO [Path b])
-> IO [(DirType, ByteString)] -> IO [Path b]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Fd -> IO [(DirType, ByteString)]
getDirectoryContents' Fd
fd
  where
    parseMaybe :: ByteString -> Maybe (Path Fn)
    parseMaybe :: ByteString -> Maybe (Path Fn)
parseMaybe = ByteString -> Maybe (Path Fn)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Fn)
parseFn




    ---------------------------
    --[ FileType operations ]--
    ---------------------------


-- |Get the file type of the file located at the given path. Does
-- not follow symbolic links.
--
-- Throws:
--
--    - `NoSuchThing` if the file does not exist
--    - `PermissionDenied` if any part of the path is not accessible
getFileType :: Path b -> IO FileType
getFileType :: Path b -> IO FileType
getFileType (MkPath fp :: ByteString
fp) = do
  FileStatus
fs <- ByteString -> IO FileStatus
PF.getSymbolicLinkStatus ByteString
fp
  FileStatus -> IO FileType
decide FileStatus
fs
  where
    decide :: FileStatus -> IO FileType
decide fs :: FileStatus
fs
      | FileStatus -> Bool
PF.isDirectory FileStatus
fs       = FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
Directory
      | FileStatus -> Bool
PF.isRegularFile FileStatus
fs     = FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
RegularFile
      | FileStatus -> Bool
PF.isSymbolicLink FileStatus
fs    = FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
SymbolicLink
      | FileStatus -> Bool
PF.isBlockDevice FileStatus
fs     = FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
BlockDevice
      | FileStatus -> Bool
PF.isCharacterDevice FileStatus
fs = FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
CharacterDevice
      | FileStatus -> Bool
PF.isNamedPipe FileStatus
fs       = FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
NamedPipe
      | FileStatus -> Bool
PF.isSocket FileStatus
fs          = FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
Socket
      | Bool
otherwise               = IOException -> IO FileType
forall a. IOException -> IO a
ioError (IOException -> IO FileType) -> IOException -> IO FileType
forall a b. (a -> b) -> a -> b
$ String -> IOException
userError "No filetype?!"



    --------------
    --[ Others ]--
    --------------



-- |Applies `realpath` on the given path.
--
-- Throws:
--
--    - `NoSuchThing` if the file at the given path does not exist
--    - `NoSuchThing` if the symlink is broken
canonicalizePath :: Path b -> IO (Path Abs)
canonicalizePath :: Path b -> IO (Path Abs)
canonicalizePath (MkPath l :: ByteString
l) = do
  ByteString
nl <- ByteString -> IO ByteString
SPDT.realpath ByteString
l
  Path Abs -> IO (Path Abs)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs -> IO (Path Abs)) -> Path Abs -> IO (Path Abs)
forall a b. (a -> b) -> a -> b
$ ByteString -> Path Abs
forall b. ByteString -> Path b
MkPath ByteString
nl


-- |Converts any path to an absolute path.
-- This is done in the following way:
--
--    - if the path is already an absolute one, just return it
--    - if it's a relative path, prepend the current directory to it
toAbs :: Path b -> IO (Path Abs)
toAbs :: Path b -> IO (Path Abs)
toAbs (MkPath bs :: ByteString
bs) = do
  let mabs :: Maybe (Path Abs)
mabs = ByteString -> Maybe (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ByteString
bs :: Maybe (Path Abs)
  case Maybe (Path Abs)
mabs of
    Just a :: Path Abs
a -> Path Abs -> IO (Path Abs)
forall (m :: * -> *) a. Monad m => a -> m a
return Path Abs
a
    Nothing  -> do
      Path Abs
cwd <- IO ByteString
getWorkingDirectory IO ByteString -> (ByteString -> IO (Path Abs)) -> IO (Path Abs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs
      Path Rel
rel <- ByteString -> IO (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel ByteString
bs -- we know it must be relative now
      Path Abs -> IO (Path Abs)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs -> IO (Path Abs)) -> Path Abs -> IO (Path Abs)
forall a b. (a -> b) -> a -> b
$ Path Abs
cwd Path Abs -> Path Rel -> Path Abs
forall r b. RelC r => Path b -> Path r -> Path b
</> Path Rel
rel