-- |
-- Module      :  System.Posix.RawFilePath.Directory
-- Copyright   :  © 2020 Julian Ospald
-- License     :  BSD3
--
-- Maintainer  :  Julian Ospald <hasufell@posteo.de>
-- Stability   :  experimental
-- Portability :  portable
--
-- This module provides IO related file operations like
-- copy, delete, move and so on, similar to the 'directory' package.
--
-- 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.
--
-- Import as:
-- > import System.Posix.RawFilePath.Directory

{-# LANGUAGE CPP              #-}
{-# LANGUAGE FlexibleContexts #-} -- streamly

module System.Posix.RawFilePath.Directory
  (
  -- * Types
    FileType(..)
  , RecursiveErrorMode(..)
  , CopyMode(..)
  -- * File copying
  , copyDirRecursive
  , recreateSymlink
  , copyFile
  , easyCopy
  -- * File deletion
  , deleteFile
  , deleteDir
  , deleteDirRecursive
  , easyDelete
  -- * File opening
  , openFile
  , executeFile
  -- * File creation
  , createRegularFile
  , createDir
  , createDirIfMissing
  , createDirRecursive
  , createSymlink
  -- * File renaming/moving
  , renameFile
  , moveFile
  -- * File reading
  , readFile
  , readFileStrict
  , readFileStream
  -- * File writing
  , writeFile
  , writeFileL
  , appendFile
  -- * File permissions
  , newFilePerms
  , newDirPerms
  -- * File checks
  , doesExist
  , doesFileExist
  , doesDirectoryExist
  , isReadable
  , isWritable
  , isExecutable
  , canOpenDirectory
  -- * File times
  , getModificationTime
  , setModificationTime
  , setModificationTimeHiRes
  -- * Directory reading
  , getDirsFiles
  , getDirsFiles'
  , getDirsFilesStream
  -- * Filetype operations
  , getFileType
  -- * Others
  , canonicalizePath
  , toAbs
  )
where


import           Control.Exception.Safe         ( IOException
                                                , MonadCatch
                                                , MonadMask
                                                , bracket
                                                , bracketOnError
                                                , onException
                                                , throwIO
                                                , finally
                                                )
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail             as Fail
#else
import qualified Control.Monad                  as Fail
#endif
import           Control.Monad                  ( unless
                                                , void
                                                , when
                                                )
import           Control.Monad.IfElse           ( unlessM )
import           Control.Monad.IO.Class         ( liftIO )
import qualified Data.ByteString               as BS
import           Data.ByteString                ( ByteString )
import qualified Data.ByteString.Lazy          as L
import qualified Data.ByteString.UTF8          as UTF8
import           Data.Foldable                  ( for_ )
import           Data.IORef                     ( IORef
                                                , modifyIORef
                                                , newIORef
                                                , readIORef
                                                )
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           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.External.Posix.DirStream
                                               as SD
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
#if MIN_VERSION_streamly(0,8,0)
import qualified Streamly.Internal.Data.Array.Stream.Foreign
                                               as AS
#else
import qualified Streamly.Internal.Memory.ArrayStream
                                               as AS
#endif
import qualified Streamly.Prelude              as S
import qualified System.IO                     as SIO
import           System.IO.Error                ( catchIOError
                                                , ioeGetErrorType
                                                )
import           System.Posix.FilePath
import           System.Posix.ByteString        ( exclusive )
import           System.Posix.RawFilePath.Directory.Errors
import           System.Posix.Directory.ByteString
                                                ( createDirectory
                                                , closeDirStream
                                                , getWorkingDirectory
                                                , openDirStream
                                                , removeDirectory
                                                )
import           System.Posix.Files.ByteString  ( createSymbolicLink
                                                , fileAccess
                                                , 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.RawFilePath.Directory.Traversals
                                               as SPDT
import qualified System.Posix.Foreign          as SPDF
import qualified System.Posix.Process.ByteString
                                               as SPP
import           System.Posix.Types             ( FileMode
                                                , ProcessID
                                                , EpochTime
                                                )
import           System.Posix.Time





    -------------
    --[ 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
copyDirRecursive :: RawFilePath  -- ^ source dir
                 -> RawFilePath  -- ^ destination (parent dirs
                                 --   are not automatically created)
                 -> CopyMode
                 -> RecursiveErrorMode
                 -> IO ()
copyDirRecursive :: RawFilePath
-> RawFilePath -> CopyMode -> RecursiveErrorMode -> IO ()
copyDirRecursive RawFilePath
fromp RawFilePath
destdirp CopyMode
cm 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
  RawFilePath -> RawFilePath -> IO ()
throwSameFile RawFilePath
fromp RawFilePath
destdirp
  RawFilePath -> RawFilePath -> IO ()
throwDestinationInSource RawFilePath
fromp RawFilePath
destdirp
  IORef [(RecursiveFailureHint, IOException)]
-> RawFilePath -> RawFilePath -> IO ()
go IORef [(RecursiveFailureHint, IOException)]
ce RawFilePath
fromp RawFilePath
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 (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m 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
#if MIN_VERSION_base(4,9,0)
  basename :: Fail.MonadFail m => RawFilePath -> m RawFilePath
#else
  basename :: Fail.Monad m => RawFilePath -> m RawFilePath
#endif
  basename :: RawFilePath -> m RawFilePath
basename RawFilePath
x =
    let b :: RawFilePath
b = RawFilePath -> RawFilePath
takeBaseName RawFilePath
x
    in  if RawFilePath -> Bool
BS.null RawFilePath
b then String -> m RawFilePath
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String
"No base name" :: String) else RawFilePath -> m RawFilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure RawFilePath
b

  go :: IORef [(RecursiveFailureHint, IOException)]
     -> RawFilePath
     -> RawFilePath
     -> IO ()
  go :: IORef [(RecursiveFailureHint, IOException)]
-> RawFilePath -> RawFilePath -> IO ()
go IORef [(RecursiveFailureHint, IOException)]
ce RawFilePath
from RawFilePath
destdir = do

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

    -- get the contents of the source dir
    [RawFilePath]
contents <- RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)]
-> [RawFilePath]
-> IO [RawFilePath]
-> IO [RawFilePath]
forall a.
RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)] -> a -> IO a -> IO a
handleIOE (RawFilePath -> RawFilePath -> RecursiveFailureHint
ReadContentsFailed RawFilePath
from RawFilePath
destdir) IORef [(RecursiveFailureHint, IOException)]
ce [] (IO [RawFilePath] -> IO [RawFilePath])
-> IO [RawFilePath] -> IO [RawFilePath]
forall a b. (a -> b) -> a -> b
$ do
      [RawFilePath]
contents <- RawFilePath -> IO [RawFilePath]
getDirsFiles RawFilePath
from

      -- create the destination dir and
      -- only return contents if we succeed
      RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)]
-> [RawFilePath]
-> IO [RawFilePath]
-> IO [RawFilePath]
forall a.
RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)] -> a -> IO a -> IO a
handleIOE (RawFilePath -> RawFilePath -> RecursiveFailureHint
CreateDirFailed RawFilePath
from RawFilePath
destdir) IORef [(RecursiveFailureHint, IOException)]
ce [] (IO [RawFilePath] -> IO [RawFilePath])
-> IO [RawFilePath] -> IO [RawFilePath]
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
<$> RawFilePath -> IO FileStatus
PF.getSymbolicLinkStatus RawFilePath
from
        case CopyMode
cm of
          CopyMode
Strict    -> RawFilePath -> FileMode -> IO ()
createDirectory RawFilePath
destdir FileMode
fmode'
          CopyMode
Overwrite -> IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
catchIOError (RawFilePath -> FileMode -> IO ()
createDirectory RawFilePath
destdir FileMode
fmode') ((IOException -> IO ()) -> IO ())
-> (IOException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IOException
e ->
            case IOException -> IOErrorType
ioeGetErrorType IOException
e of
              IOErrorType
AlreadyExists -> RawFilePath -> FileMode -> IO ()
setFileMode RawFilePath
destdir FileMode
fmode'
              IOErrorType
_             -> IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e
        [RawFilePath] -> IO [RawFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [RawFilePath]
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
    [RawFilePath] -> (RawFilePath -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [RawFilePath]
contents ((RawFilePath -> IO ()) -> IO ())
-> (RawFilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \RawFilePath
f -> do
      FileType
ftype   <- RawFilePath -> IO FileType
getFileType RawFilePath
f
      RawFilePath
newdest <- (RawFilePath
destdir RawFilePath -> RawFilePath -> RawFilePath
</>) (RawFilePath -> RawFilePath) -> IO RawFilePath -> IO RawFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawFilePath -> IO RawFilePath
forall (m :: * -> *). MonadFail m => RawFilePath -> m RawFilePath
basename RawFilePath
f
      case FileType
ftype of
        FileType
SymbolicLink ->
          RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)]
-> ()
-> IO ()
-> IO ()
forall a.
RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)] -> a -> IO a -> IO a
handleIOE (RawFilePath -> RawFilePath -> RecursiveFailureHint
RecreateSymlinkFailed RawFilePath
f RawFilePath
newdest) IORef [(RecursiveFailureHint, IOException)]
ce ()
            (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ RawFilePath -> RawFilePath -> CopyMode -> IO ()
recreateSymlink RawFilePath
f RawFilePath
newdest CopyMode
cm
        FileType
Directory -> IORef [(RecursiveFailureHint, IOException)]
-> RawFilePath -> RawFilePath -> IO ()
go IORef [(RecursiveFailureHint, IOException)]
ce RawFilePath
f RawFilePath
newdest
        FileType
RegularFile ->
          RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)]
-> ()
-> IO ()
-> IO ()
forall a.
RecursiveFailureHint
-> IORef [(RecursiveFailureHint, IOException)] -> a -> IO a -> IO a
handleIOE (RawFilePath -> RawFilePath -> RecursiveFailureHint
CopyFileFailed RawFilePath
f RawFilePath
newdest) IORef [(RecursiveFailureHint, IOException)]
ce () (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ RawFilePath -> RawFilePath -> CopyMode -> IO ()
copyFile RawFilePath
f RawFilePath
newdest CopyMode
cm
        FileType
_ -> () -> 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 RecursiveFailureHint
hint IORef [(RecursiveFailureHint, IOException)]
ce a
def = case RecursiveErrorMode
rm of
    RecursiveErrorMode
FailEarly -> (IOException -> IO a) -> IO a -> IO a
forall a. (IOException -> IO a) -> IO a -> IO a
handleIOError IOException -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO
    RecursiveErrorMode
CollectFailures ->
      (IOException -> IO a) -> IO a -> IO a
forall a. (IOException -> IO a) -> IO a -> IO a
handleIOError (\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`
recreateSymlink :: RawFilePath   -- ^ the old symlink file
                -> RawFilePath   -- ^ destination file
                -> CopyMode
                -> IO ()
recreateSymlink :: RawFilePath -> RawFilePath -> CopyMode -> IO ()
recreateSymlink RawFilePath
symsource RawFilePath
newsym CopyMode
cm = do
  RawFilePath -> RawFilePath -> IO ()
throwSameFile RawFilePath
symsource RawFilePath
newsym
  RawFilePath
sympoint <- RawFilePath -> IO RawFilePath
readSymbolicLink RawFilePath
symsource
  case CopyMode
cm of
    CopyMode
Strict    -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    CopyMode
Overwrite -> do
      Bool
writable <- do
        Bool
e <- RawFilePath -> IO Bool
doesExist RawFilePath
newsym
        if Bool
e then RawFilePath -> IO Bool
isWritable RawFilePath
newsym else Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      Bool
isfile <- RawFilePath -> IO Bool
doesFileExist RawFilePath
newsym
      Bool
isdir  <- RawFilePath -> IO Bool
doesDirectoryExist RawFilePath
newsym
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
writable Bool -> Bool -> Bool
&& Bool
isfile) (RawFilePath -> IO ()
deleteFile RawFilePath
newsym)
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
writable Bool -> Bool -> Bool
&& Bool
isdir)  (RawFilePath -> IO ()
deleteDir RawFilePath
newsym)
  RawFilePath -> RawFilePath -> IO ()
createSymbolicLink RawFilePath
sympoint RawFilePath
newsym


-- |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
copyFile :: RawFilePath   -- ^ source file
         -> RawFilePath   -- ^ destination file
         -> CopyMode
         -> IO ()
copyFile :: RawFilePath -> RawFilePath -> CopyMode -> IO ()
copyFile RawFilePath
from RawFilePath
to CopyMode
cm = do
  RawFilePath -> RawFilePath -> IO ()
throwSameFile RawFilePath
from RawFilePath
to
  IO (Fd, Handle)
-> ((Fd, Handle) -> IO ()) -> ((Fd, Handle) -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
      (do
        Fd
fd     <- RawFilePath -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd RawFilePath
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)
      )
      (\(Fd
_, Handle
handle) -> Handle -> IO ()
SIO.hClose Handle
handle)
    (((Fd, Handle) -> IO ()) -> IO ())
-> ((Fd, Handle) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Fd
fromFd, 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
                CopyMode
Strict    -> Flags
SPDF.oExcl
                CopyMode
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     <- RawFilePath -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd RawFilePath
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)
            )
            (\(Fd
_, Handle
handle) -> Handle -> IO ()
SIO.hClose Handle
handle)
            (\(Fd
_, 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
                CopyMode
Strict    -> RawFilePath -> IO ()
deleteFile RawFilePath
to
                CopyMode
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
$ \(Fd
_, 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 (Handle
fH, 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 (Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
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
easyCopy :: RawFilePath
         -> RawFilePath
         -> CopyMode
         -> RecursiveErrorMode
         -> IO ()
easyCopy :: RawFilePath
-> RawFilePath -> CopyMode -> RecursiveErrorMode -> IO ()
easyCopy RawFilePath
from RawFilePath
to CopyMode
cm RecursiveErrorMode
rm = do
  FileType
ftype <- RawFilePath -> IO FileType
getFileType RawFilePath
from
  case FileType
ftype of
    FileType
SymbolicLink -> RawFilePath -> RawFilePath -> CopyMode -> IO ()
recreateSymlink RawFilePath
from RawFilePath
to CopyMode
cm
    FileType
RegularFile  -> RawFilePath -> RawFilePath -> CopyMode -> IO ()
copyFile RawFilePath
from RawFilePath
to CopyMode
cm
    FileType
Directory    -> RawFilePath
-> RawFilePath -> CopyMode -> RecursiveErrorMode -> IO ()
copyDirRecursive RawFilePath
from RawFilePath
to CopyMode
cm RecursiveErrorMode
rm
    FileType
_            -> () -> 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
--
-- Notes: calls `unlink`
deleteFile :: RawFilePath -> IO ()
deleteFile :: RawFilePath -> IO ()
deleteFile = RawFilePath -> IO ()
removeLink


-- |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 :: RawFilePath -> IO ()
deleteDir :: RawFilePath -> IO ()
deleteDir = RawFilePath -> IO ()
removeDirectory


-- |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 :: RawFilePath -> IO ()
deleteDirRecursive :: RawFilePath -> IO ()
deleteDirRecursive RawFilePath
p = [Errno] -> IO () -> IO () -> IO ()
forall a. [Errno] -> IO a -> IO a -> IO a
catchErrno [Errno
eNOTEMPTY, Errno
eEXIST] (RawFilePath -> IO ()
deleteDir RawFilePath
p) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  [RawFilePath]
files <- RawFilePath -> IO [RawFilePath]
getDirsFiles RawFilePath
p
  [RawFilePath] -> (RawFilePath -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [RawFilePath]
files ((RawFilePath -> IO ()) -> IO ())
-> (RawFilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \RawFilePath
file -> do
    FileType
ftype <- RawFilePath -> IO FileType
getFileType RawFilePath
file
    case FileType
ftype of
      FileType
SymbolicLink -> RawFilePath -> IO ()
deleteFile RawFilePath
file
      FileType
Directory    -> RawFilePath -> IO ()
deleteDirRecursive RawFilePath
file
      FileType
RegularFile  -> RawFilePath -> IO ()
deleteFile RawFilePath
file
      FileType
_            -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  RawFilePath -> IO ()
removeDirectory RawFilePath
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 :: RawFilePath -> IO ()
easyDelete :: RawFilePath -> IO ()
easyDelete RawFilePath
p = do
  FileType
ftype <- RawFilePath -> IO FileType
getFileType RawFilePath
p
  case FileType
ftype of
    FileType
SymbolicLink -> RawFilePath -> IO ()
deleteFile RawFilePath
p
    FileType
Directory    -> RawFilePath -> IO ()
deleteDirRecursive RawFilePath
p
    FileType
RegularFile  -> RawFilePath -> IO ()
deleteFile RawFilePath
p
    FileType
_            -> () -> 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 :: RawFilePath -> IO ProcessID
openFile :: RawFilePath -> IO ProcessID
openFile RawFilePath
fp = IO () -> IO ProcessID
SPP.forkProcess
  (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ RawFilePath
-> Bool
-> [RawFilePath]
-> Maybe [(RawFilePath, RawFilePath)]
-> IO ()
forall a.
RawFilePath
-> Bool
-> [RawFilePath]
-> Maybe [(RawFilePath, RawFilePath)]
-> IO a
SPP.executeFile (String -> RawFilePath
UTF8.fromString String
"xdg-open") Bool
True [RawFilePath
fp] Maybe [(RawFilePath, RawFilePath)]
forall a. Maybe a
Nothing


-- |Executes a program with the given arguments. This forks a process.
executeFile :: RawFilePath     -- ^ program
            -> [ByteString]    -- ^ arguments
            -> IO ProcessID
executeFile :: RawFilePath -> [RawFilePath] -> IO ProcessID
executeFile RawFilePath
fp [RawFilePath]
args = IO () -> IO ProcessID
SPP.forkProcess (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ RawFilePath
-> Bool
-> [RawFilePath]
-> Maybe [(RawFilePath, RawFilePath)]
-> IO ()
forall a.
RawFilePath
-> Bool
-> [RawFilePath]
-> Maybe [(RawFilePath, RawFilePath)]
-> IO a
SPP.executeFile RawFilePath
fp Bool
True [RawFilePath]
args Maybe [(RawFilePath, RawFilePath)]
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 -> RawFilePath -> IO ()
createRegularFile :: FileMode -> RawFilePath -> IO ()
createRegularFile FileMode
fm RawFilePath
destBS = IO Fd -> (Fd -> IO ()) -> (Fd -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
  (RawFilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
SPI.openFd RawFilePath
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
  (\Fd
_ -> () -> 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 -> RawFilePath -> IO ()
createDir :: FileMode -> RawFilePath -> IO ()
createDir FileMode
fm RawFilePath
destBS = RawFilePath -> FileMode -> IO ()
createDirectory RawFilePath
destBS FileMode
fm

-- |Create an empty directory at the given directory with the given filename.
--
-- Throws:
--
--    - `PermissionDenied` if output directory cannot be written to
--    - `NoSuchThing` if any of the parent components of the path
--      do not exist
createDirIfMissing :: FileMode -> RawFilePath -> IO ()
createDirIfMissing :: FileMode -> RawFilePath -> IO ()
createDirIfMissing FileMode
fm RawFilePath
destBS =
  IOErrorType -> IO () -> IO ()
hideError IOErrorType
AlreadyExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ RawFilePath -> FileMode -> IO ()
createDirectory RawFilePath
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
createDirRecursive :: FileMode -> RawFilePath -> IO ()
createDirRecursive :: FileMode -> RawFilePath -> IO ()
createDirRecursive FileMode
fm RawFilePath
p = RawFilePath -> IO ()
go RawFilePath
p
 where
  go :: RawFilePath -> IO ()
  go :: RawFilePath -> IO ()
go RawFilePath
dest = do
    IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
catchIOError (RawFilePath -> FileMode -> IO ()
createDirectory RawFilePath
dest FileMode
fm) ((IOException -> IO ()) -> IO ())
-> (IOException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IOException
e -> do
      Errno
errno <- IO Errno
getErrno
      case Errno
errno of
        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 (RawFilePath -> IO Bool
doesDirectoryExist RawFilePath
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
          -> RawFilePath -> IO ()
go (RawFilePath -> RawFilePath
takeDirectory (RawFilePath -> RawFilePath) -> RawFilePath -> RawFilePath
forall a b. (a -> b) -> a -> b
$ RawFilePath -> RawFilePath
dropTrailingPathSeparator RawFilePath
dest)
            IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FileMode -> RawFilePath -> IO ()
createDir FileMode
fm RawFilePath
dest
          | 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 :: RawFilePath     -- ^ destination file
              -> RawFilePath     -- ^ path the symlink points to
              -> IO ()
createSymlink :: RawFilePath -> RawFilePath -> IO ()
createSymlink RawFilePath
destBS RawFilePath
sympoint = RawFilePath -> RawFilePath -> IO ()
createSymbolicLink RawFilePath
sympoint RawFilePath
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 :: RawFilePath -> RawFilePath -> IO ()
renameFile :: RawFilePath -> RawFilePath -> IO ()
renameFile RawFilePath
fromf RawFilePath
tof = do
  RawFilePath -> RawFilePath -> IO ()
throwSameFile RawFilePath
fromf RawFilePath
tof
  RawFilePath -> IO ()
throwFileDoesExist RawFilePath
tof
  RawFilePath -> IO ()
throwDirDoesExist RawFilePath
tof
  RawFilePath -> RawFilePath -> IO ()
rename RawFilePath
fromf RawFilePath
tof


-- |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)
moveFile :: RawFilePath   -- ^ file to move
         -> RawFilePath   -- ^ destination
         -> CopyMode
         -> IO ()
moveFile :: RawFilePath -> RawFilePath -> CopyMode -> IO ()
moveFile RawFilePath
from RawFilePath
to CopyMode
cm = do
  RawFilePath -> RawFilePath -> IO ()
throwSameFile RawFilePath
from RawFilePath
to
  case CopyMode
cm of
    CopyMode
Strict -> [Errno] -> IO () -> IO () -> IO ()
forall a. [Errno] -> IO a -> IO a -> IO a
catchErrno [Errno
eXDEV] (RawFilePath -> RawFilePath -> IO ()
renameFile RawFilePath
from RawFilePath
to) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      RawFilePath
-> RawFilePath -> CopyMode -> RecursiveErrorMode -> IO ()
easyCopy RawFilePath
from RawFilePath
to CopyMode
Strict RecursiveErrorMode
FailEarly
      RawFilePath -> IO ()
easyDelete RawFilePath
from
    CopyMode
Overwrite -> do
      FileType
ft       <- RawFilePath -> IO FileType
getFileType RawFilePath
from
      Bool
writable <- do
        Bool
e <- RawFilePath -> IO Bool
doesFileExist RawFilePath
to
        if Bool
e then RawFilePath -> IO Bool
isWritable RawFilePath
to else Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

      case FileType
ft of
        FileType
RegularFile -> do
          Bool
exists <- RawFilePath -> IO Bool
doesFileExist RawFilePath
to
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
exists Bool -> Bool -> Bool
&& Bool
writable) (RawFilePath -> IO ()
deleteFile RawFilePath
to)
        FileType
SymbolicLink -> do
          Bool
exists <- RawFilePath -> IO Bool
doesFileExist RawFilePath
to
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
exists Bool -> Bool -> Bool
&& Bool
writable) (RawFilePath -> IO ()
deleteFile RawFilePath
to)
        FileType
Directory -> do
          Bool
exists <- RawFilePath -> IO Bool
doesDirectoryExist RawFilePath
to
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
exists Bool -> Bool -> Bool
&& Bool
writable) (RawFilePath -> IO ()
deleteDir RawFilePath
to)
        FileType
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      RawFilePath -> RawFilePath -> CopyMode -> IO ()
moveFile RawFilePath
from RawFilePath
to CopyMode
Strict





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


-- |Read the given file lazily.
--
-- Symbolic links are followed. File must exist.
--
-- 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 :: RawFilePath -> IO L.ByteString
readFile :: RawFilePath -> IO ByteString
readFile RawFilePath
path = do
  SerialT IO (Array Word8)
stream <- RawFilePath -> IO (SerialT IO (Array Word8))
readFileStream RawFilePath
path
  SerialT IO (Array Word8) -> IO ByteString
SL.fromChunksIO SerialT IO (Array Word8)
stream


-- |Read the given file strictly into memory.
--
-- Symbolic links are followed. File must exist.
--
-- 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
readFileStrict :: RawFilePath -> IO BS.ByteString
readFileStrict :: RawFilePath -> IO RawFilePath
readFileStrict RawFilePath
path = do
  SerialT IO (Array Word8)
stream <- RawFilePath -> IO (SerialT IO (Array Word8))
readFileStream RawFilePath
path
  Array Word8 -> RawFilePath
fromArray (Array Word8 -> RawFilePath) -> IO (Array Word8) -> IO RawFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SerialT IO (Array Word8) -> IO (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
SerialT m (Array a) -> m (Array a)
AS.toArray SerialT IO (Array Word8)
stream


-- | Open the given file as a filestream. Once the filestream
-- exits, the filehandle is cleaned up.
--
-- 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
readFileStream :: RawFilePath -> IO (SerialT IO (Array Word8))
readFileStream :: RawFilePath -> IO (SerialT IO (Array Word8))
readFileStream RawFilePath
fp = do
  Fd
fd     <- RawFilePath -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd RawFilePath
fp OpenMode
SPI.ReadOnly [] Maybe FileMode
forall a. Maybe a
Nothing
  Handle
handle <- Fd -> IO Handle
SPI.fdToHandle Fd
fd
  let stream :: SerialT IO (Array Word8)
stream = Unfold IO Handle (Array Word8)
-> Handle -> SerialT IO (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
Unfold m a b -> a -> t m b
S.unfold ((Handle -> IO ())
-> Unfold IO Handle (Array Word8) -> Unfold IO Handle (Array Word8)
forall (m :: * -> *) a c b.
(MonadAsync m, MonadCatch m) =>
(a -> m c) -> Unfold m a b -> Unfold m a b
SU.finally Handle -> IO ()
SIO.hClose Unfold IO Handle (Array Word8)
forall (m :: * -> *). MonadIO m => Unfold m Handle (Array Word8)
FH.readChunks) Handle
handle
  SerialT IO (Array Word8) -> IO (SerialT IO (Array Word8))
forall (f :: * -> *) a. Applicative f => a -> f a
pure SerialT IO (Array Word8)
stream




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


-- |Write a given ByteString to a file, truncating the file beforehand.
-- Follows symlinks.
--
-- Throws:
--
--     - `InappropriateType` if file is not a regular file or a symlink
--     - `PermissionDenied` if we cannot read the file or the directory
--        containting it
--     - `NoSuchThing` if the file does not exist
writeFile :: RawFilePath
          -> Maybe FileMode  -- ^ if Nothing, file must exist
          -> ByteString
          -> IO ()
writeFile :: RawFilePath -> Maybe FileMode -> RawFilePath -> IO ()
writeFile RawFilePath
fp Maybe FileMode
fmode RawFilePath
bs =
  IO Fd -> (Fd -> IO ()) -> (Fd -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (RawFilePath -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd RawFilePath
fp OpenMode
SPI.WriteOnly [Flags
SPDF.oTrunc] Maybe FileMode
fmode) (Fd -> IO ()
SPI.closeFd)
    ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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 -> RawFilePath -> IO ByteCount
SPB.fdWrite Fd
fd RawFilePath
bs


-- |Write a given lazy ByteString to a file, truncating the file beforehand.
-- Follows symlinks.
--
-- Throws:
--
--     - `InappropriateType` if file is not a regular file or a symlink
--     - `PermissionDenied` if we cannot read the file or the directory
--        containting it
--     - `NoSuchThing` if the file does not exist
--
-- Note: uses streamly under the hood
writeFileL :: RawFilePath
           -> Maybe FileMode  -- ^ if Nothing, file must exist
           -> L.ByteString
           -> IO ()
writeFileL :: RawFilePath -> Maybe FileMode -> ByteString -> IO ()
writeFileL RawFilePath
fp Maybe FileMode
fmode ByteString
lbs = do
  Handle
handle <-
    IO Fd -> (Fd -> IO ()) -> (Fd -> IO Handle) -> IO Handle
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError (RawFilePath -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd RawFilePath
fp OpenMode
SPI.WriteOnly [Flags
SPDF.oTrunc] Maybe FileMode
fmode) (Fd -> IO ()
SPI.closeFd)
      ((Fd -> IO Handle) -> IO Handle) -> (Fd -> IO Handle) -> IO Handle
forall a b. (a -> b) -> a -> b
$ Fd -> IO Handle
SPI.fdToHandle
  IO () -> IO () -> IO ()
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
finally (Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
streamlyCopy Handle
handle) (Handle -> IO ()
SIO.hClose Handle
handle)
  where streamlyCopy :: Handle -> m ()
streamlyCopy 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
$ ByteString -> SerialT m (Array Word8)
forall (m :: * -> *).
Monad m =>
ByteString -> SerialT m (Array Word8)
SL.toChunks ByteString
lbs


-- |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 :: RawFilePath -> ByteString -> IO ()
appendFile :: RawFilePath -> RawFilePath -> IO ()
appendFile RawFilePath
fp RawFilePath
bs =
  IO Fd -> (Fd -> IO ()) -> (Fd -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (RawFilePath -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd RawFilePath
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 -> 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 -> RawFilePath -> IO ByteCount
SPB.fdWrite Fd
fd RawFilePath
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




    -------------------
    --[ File checks ]--
    -------------------


-- |Checks if the given file exists.
-- Does not follow symlinks.
--
-- Only eNOENT is catched (and returns False).
doesExist :: RawFilePath -> IO Bool
doesExist :: RawFilePath -> IO Bool
doesExist RawFilePath
bs =
  [Errno] -> IO Bool -> IO Bool -> IO Bool
forall a. [Errno] -> IO a -> IO a -> IO a
catchErrno
      [Errno
eNOENT]
      (do
        FileStatus
_ <- RawFilePath -> IO FileStatus
PF.getSymbolicLinkStatus RawFilePath
bs
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool
True
      )
    (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False


-- |Checks if the given file exists and is not a directory.
-- Does not follow symlinks.
--
-- Only eNOENT is catched (and returns False).
doesFileExist :: RawFilePath -> IO Bool
doesFileExist :: RawFilePath -> IO Bool
doesFileExist RawFilePath
bs =
  [Errno] -> IO Bool -> IO Bool -> IO Bool
forall a. [Errno] -> IO a -> IO a -> IO a
catchErrno
      [Errno
eNOENT]
      (do
        FileStatus
fs <- RawFilePath -> IO FileStatus
PF.getSymbolicLinkStatus RawFilePath
bs
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (FileStatus -> Bool) -> FileStatus -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> Bool
PF.isDirectory (FileStatus -> Bool) -> FileStatus -> Bool
forall a b. (a -> b) -> a -> b
$ FileStatus
fs
      )
    (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False


-- |Checks if the given file exists and is a directory.
-- Does not follow symlinks.
--
-- Only eNOENT is catched (and returns False).
doesDirectoryExist :: RawFilePath -> IO Bool
doesDirectoryExist :: RawFilePath -> IO Bool
doesDirectoryExist RawFilePath
bs =
  [Errno] -> IO Bool -> IO Bool -> IO Bool
forall a. [Errno] -> IO a -> IO a -> IO a
catchErrno
      [Errno
eNOENT]
      (do
        FileStatus
fs <- RawFilePath -> IO FileStatus
PF.getSymbolicLinkStatus RawFilePath
bs
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ FileStatus -> Bool
PF.isDirectory FileStatus
fs
      )
    (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False


-- |Checks whether a file or folder is readable.
--
-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False).
--
-- Throws:
--
--     - `NoSuchThing` if the file does not exist
isReadable :: RawFilePath -> IO Bool
isReadable :: RawFilePath -> IO Bool
isReadable RawFilePath
bs = RawFilePath -> Bool -> Bool -> Bool -> IO Bool
fileAccess RawFilePath
bs Bool
True Bool
False Bool
False

-- |Checks whether a file or folder is writable.
--
-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False).
--
-- Throws:
--
--     - `NoSuchThing` if the file does not exist
isWritable :: RawFilePath -> IO Bool
isWritable :: RawFilePath -> IO Bool
isWritable RawFilePath
bs = RawFilePath -> Bool -> Bool -> Bool -> IO Bool
fileAccess RawFilePath
bs Bool
False Bool
True Bool
False


-- |Checks whether a file or folder is executable.
--
-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False).
--
-- Throws:
--
--     - `NoSuchThing` if the file does not exist
isExecutable :: RawFilePath -> IO Bool
isExecutable :: RawFilePath -> IO Bool
isExecutable RawFilePath
bs = RawFilePath -> Bool -> Bool -> Bool -> IO Bool
fileAccess RawFilePath
bs Bool
False Bool
False Bool
True



-- |Checks whether the directory at the given path exists and can be
-- opened. This invokes `openDirStream` which follows symlinks.
canOpenDirectory :: RawFilePath -> IO Bool
canOpenDirectory :: RawFilePath -> IO Bool
canOpenDirectory RawFilePath
bs = (IOException -> IO Bool) -> IO Bool -> IO Bool
forall a. (IOException -> IO a) -> IO a -> IO a
handleIOError (\IOException
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
  IO DirStream
-> (DirStream -> IO ()) -> (DirStream -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (RawFilePath -> IO DirStream
openDirStream RawFilePath
bs) DirStream -> IO ()
closeDirStream (\DirStream
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True




    ------------------
    --[ File times ]--
    ------------------


getModificationTime :: RawFilePath -> IO UTCTime
getModificationTime :: RawFilePath -> IO UTCTime
getModificationTime RawFilePath
bs = do
  FileStatus
fs <- RawFilePath -> IO FileStatus
PF.getFileStatus RawFilePath
bs
  UTCTime -> IO UTCTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> IO UTCTime) -> UTCTime -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ FileStatus -> POSIXTime
PF.modificationTimeHiRes FileStatus
fs

setModificationTime :: RawFilePath -> EpochTime -> IO ()
setModificationTime :: RawFilePath -> EpochTime -> IO ()
setModificationTime RawFilePath
bs EpochTime
t = do
  -- TODO: setFileTimes doesn't allow to pass NULL to utime
  EpochTime
ctime <- IO EpochTime
epochTime
  RawFilePath -> EpochTime -> EpochTime -> IO ()
PF.setFileTimes RawFilePath
bs EpochTime
ctime EpochTime
t

setModificationTimeHiRes :: RawFilePath -> POSIXTime -> IO ()
setModificationTimeHiRes :: RawFilePath -> POSIXTime -> IO ()
setModificationTimeHiRes RawFilePath
bs POSIXTime
t = do
  -- TODO: setFileTimesHiRes doesn't allow to pass NULL to utimes
  POSIXTime
ctime <- IO POSIXTime
getPOSIXTime
  RawFilePath -> POSIXTime -> POSIXTime -> IO ()
PF.setFileTimesHiRes RawFilePath
bs POSIXTime
ctime POSIXTime
t



    -------------------------
    --[ 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 :: RawFilePath        -- ^ dir to read
             -> IO [RawFilePath]
getDirsFiles :: RawFilePath -> IO [RawFilePath]
getDirsFiles RawFilePath
p = do
  [RawFilePath]
contents <- RawFilePath -> IO [RawFilePath]
getDirsFiles' RawFilePath
p
  [RawFilePath] -> IO [RawFilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([RawFilePath] -> IO [RawFilePath])
-> [RawFilePath] -> IO [RawFilePath]
forall a b. (a -> b) -> a -> b
$ (RawFilePath -> RawFilePath) -> [RawFilePath] -> [RawFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RawFilePath
p RawFilePath -> RawFilePath -> RawFilePath
</>) [RawFilePath]
contents


-- | Like 'getDirsFiles', but returns the filename only, instead
-- of prepending the base path.
getDirsFiles' :: RawFilePath        -- ^ dir to read
              -> IO [RawFilePath]
getDirsFiles' :: RawFilePath -> IO [RawFilePath]
getDirsFiles' RawFilePath
fp = RawFilePath -> IO (SerialT IO RawFilePath)
forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
RawFilePath -> IO (SerialT m RawFilePath)
getDirsFilesStream RawFilePath
fp IO (SerialT IO RawFilePath)
-> (SerialT IO RawFilePath -> IO [RawFilePath]) -> IO [RawFilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SerialT IO RawFilePath -> IO [RawFilePath]
forall (m :: * -> *) a. Monad m => SerialT m a -> m [a]
S.toList


-- | Like 'getDirsFiles'', except returning a Stream.
getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m)
                   => RawFilePath
                   -> IO (SerialT m RawFilePath)
getDirsFilesStream :: RawFilePath -> IO (SerialT m RawFilePath)
getDirsFilesStream RawFilePath
fp = do
  Fd
fd <- RawFilePath -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd RawFilePath
fp OpenMode
SPI.ReadOnly [Flags
SPDF.oNofollow] Maybe FileMode
forall a. Maybe a
Nothing
  DirStream
ds <- Fd -> IO DirStream
SPDT.fdOpendir Fd
fd IO DirStream -> IO () -> IO DirStream
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`onException` Fd -> IO ()
SPI.closeFd Fd
fd
  SerialT m RawFilePath -> IO (SerialT m RawFilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SerialT m RawFilePath -> IO (SerialT m RawFilePath))
-> SerialT m RawFilePath -> IO (SerialT m RawFilePath)
forall a b. (a -> b) -> a -> b
$ ((DirType, RawFilePath) -> RawFilePath)
-> SerialT m (DirType, RawFilePath) -> SerialT m RawFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DirType, RawFilePath) -> RawFilePath
forall a b. (a, b) -> b
snd (SerialT m (DirType, RawFilePath) -> SerialT m RawFilePath)
-> SerialT m (DirType, RawFilePath) -> SerialT m RawFilePath
forall a b. (a -> b) -> a -> b
$ DirStream -> SerialT m (DirType, RawFilePath)
forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
DirStream -> SerialT m (DirType, RawFilePath)
SD.dirContentsStream DirStream
ds




    ---------------------------
    --[ 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 :: RawFilePath -> IO FileType
getFileType :: RawFilePath -> IO FileType
getFileType RawFilePath
fp = do
  FileStatus
fs <- RawFilePath -> IO FileStatus
PF.getSymbolicLinkStatus RawFilePath
fp
  FileStatus -> IO FileType
decide FileStatus
fs
 where
  decide :: FileStatus -> IO FileType
decide 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 String
"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 :: RawFilePath -> IO RawFilePath
canonicalizePath :: RawFilePath -> IO RawFilePath
canonicalizePath = RawFilePath -> IO RawFilePath
SPDT.realpath


-- |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 :: RawFilePath -> IO RawFilePath
toAbs :: RawFilePath -> IO RawFilePath
toAbs RawFilePath
bs = do
  case RawFilePath -> Bool
isAbsolute RawFilePath
bs of
    Bool
True  -> RawFilePath -> IO RawFilePath
forall (m :: * -> *) a. Monad m => a -> m a
return RawFilePath
bs
    Bool
False -> do
      RawFilePath
cwd <- IO RawFilePath
getWorkingDirectory
      RawFilePath -> IO RawFilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (RawFilePath -> IO RawFilePath) -> RawFilePath -> IO RawFilePath
forall a b. (a -> b) -> a -> b
$ RawFilePath
cwd RawFilePath -> RawFilePath -> RawFilePath
</> RawFilePath
bs