{-# OPTIONS_GHC -Wno-unused-imports #-}

-- NOTE: [Unused FilePath]
--
-- -Wno-unused-imports due to the "unused" System.FilePath import
-- below. We import it because in case we are using the new os-string
-- package, we need to ensure we are using filepath >= 1.5, as lower
-- versions provide their own incompatible os-string. But filepath is
-- a transitive dep, so the only way to do this is add an "unused" dependency
-- in the cabal file.
--
-- We attempted to disable the warning more appropriately with
--
--   ghc-options: -Wno-unused-packages
--
-- in the cabal file, but this didn't work for some reason. Hence this
-- workaround here. We should be able to remove all of this once nix can
-- use GHC 9.10.
--
-- See TODO: [FilePath vs. OsString upgrade].

-- | Provides the 'MonadPosix' typeclass.
--
-- @since 0.1
module Effects.System.Posix
  ( -- * Effect
    MonadPosix (..),

    -- * PathType
    PathType (..),

    -- ** Functions
    displayPathType,
    throwIfWrongPathType,
    isPathType,
    getPathType,
  )
where

import Control.Monad (unless)
import Control.Monad.Catch (MonadCatch)
import Control.Monad.Trans.Class (MonadTrans (lift))
import Control.Monad.Trans.Reader (ReaderT)
import Data.Functor ((<&>))
import FileSystem.IO qualified as FS.IO
import FileSystem.PathType
  ( PathType
      ( PathTypeDirectory,
        PathTypeFile,
        PathTypeOther,
        PathTypeSymbolicLink
      ),
    displayPathType,
  )
import GHC.IO.Exception (IOErrorType (InappropriateType))
import GHC.Stack (HasCallStack)
import System.FilePath qualified
import System.OsString.Internal.Types (OsString (OsString))
import System.Posix.Files.PosixString (FileStatus, PathVar)
import System.Posix.Files.PosixString qualified as PFiles
import System.Posix.PosixString (PosixPath)
import System.Posix.Types
  ( DeviceID,
    EpochTime,
    Fd,
    FileMode,
    FileOffset,
    GroupID,
    Limit,
    UserID,
  )

{- HLINT ignore "Redundant bracket" -}

-- | Class for unix effects.
--
-- @since 0.1
class (Monad m) => MonadPosix m where
  -- System.Posix.Files

  -- | @since 0.1
  setFileMode :: (HasCallStack) => PosixPath -> FileMode -> m ()

  -- | @since 0.1
  setFdMode :: (HasCallStack) => Fd -> FileMode -> m ()

  -- | @since 0.1
  setFileCreationMask :: (HasCallStack) => FileMode -> m FileMode

  -- | @since 0.1
  fileAccess :: (HasCallStack) => PosixPath -> Bool -> Bool -> Bool -> m Bool

  -- | @since 0.1
  fileExist :: (HasCallStack) => PosixPath -> m Bool

  -- | @since 0.1
  getFileStatus :: (HasCallStack) => PosixPath -> m FileStatus

  -- | @since 0.1
  getFdStatus :: (HasCallStack) => Fd -> m FileStatus

  -- | @since 0.1
  getSymbolicLinkStatus :: (HasCallStack) => PosixPath -> m FileStatus

  -- | @since 0.1
  createNamedPipe :: (HasCallStack) => PosixPath -> FileMode -> m ()

  -- | @since 0.1
  createDevice :: (HasCallStack) => PosixPath -> FileMode -> DeviceID -> m ()

  -- | @since 0.1
  createLink :: (HasCallStack) => PosixPath -> PosixPath -> m ()

  -- | @since 0.1
  removeLink :: (HasCallStack) => PosixPath -> m ()

  -- | @since 0.1
  createSymbolicLink :: (HasCallStack) => PosixPath -> PosixPath -> m ()

  -- | @since 0.1
  readSymbolicLink :: (HasCallStack) => PosixPath -> m PosixPath

  -- | @since 0.1
  rename :: (HasCallStack) => PosixPath -> PosixPath -> m ()

  -- | @since 0.1
  setOwnerAndGroup :: (HasCallStack) => PosixPath -> UserID -> GroupID -> m ()

  -- | @since 0.1
  setFdOwnerAndGroup :: (HasCallStack) => Fd -> UserID -> GroupID -> m ()

  -- | @since 0.1
  setSymbolicLinkOwnerAndGroup :: (HasCallStack) => PosixPath -> UserID -> GroupID -> m ()

  -- | @since 0.1
  setFileTimes :: (HasCallStack) => PosixPath -> EpochTime -> EpochTime -> m ()

  -- | @since 0.1
  touchFile :: (HasCallStack) => PosixPath -> m ()

  -- | @since 0.1
  setFileSize :: (HasCallStack) => PosixPath -> FileOffset -> m ()

  -- | @since 0.1
  setFdSize :: (HasCallStack) => Fd -> FileOffset -> m ()

  -- | @since 0.1
  getPathVar :: (HasCallStack) => PosixPath -> PathVar -> m Limit

  -- | @since 0.1
  getFdPathVar :: (HasCallStack) => Fd -> PathVar -> m Limit

-- | @since 0.1
instance MonadPosix IO where
  setFileMode :: HasCallStack => PosixPath -> FileMode -> IO ()
setFileMode = PosixPath -> FileMode -> IO ()
PFiles.setFileMode
  {-# INLINEABLE setFileMode #-}
  setFdMode :: HasCallStack => Fd -> FileMode -> IO ()
setFdMode = Fd -> FileMode -> IO ()
PFiles.setFdMode
  {-# INLINEABLE setFdMode #-}
  setFileCreationMask :: HasCallStack => FileMode -> IO FileMode
setFileCreationMask = FileMode -> IO FileMode
PFiles.setFileCreationMask
  {-# INLINEABLE setFileCreationMask #-}
  fileAccess :: HasCallStack => PosixPath -> Bool -> Bool -> Bool -> IO Bool
fileAccess = PosixPath -> Bool -> Bool -> Bool -> IO Bool
PFiles.fileAccess
  {-# INLINEABLE fileAccess #-}
  fileExist :: HasCallStack => PosixPath -> IO Bool
fileExist = PosixPath -> IO Bool
PFiles.fileExist
  {-# INLINEABLE fileExist #-}
  getFileStatus :: HasCallStack => PosixPath -> IO FileStatus
getFileStatus = PosixPath -> IO FileStatus
PFiles.getFileStatus
  {-# INLINEABLE getFileStatus #-}
  getFdStatus :: HasCallStack => Fd -> IO FileStatus
getFdStatus = Fd -> IO FileStatus
PFiles.getFdStatus
  {-# INLINEABLE getFdStatus #-}
  getSymbolicLinkStatus :: HasCallStack => PosixPath -> IO FileStatus
getSymbolicLinkStatus = PosixPath -> IO FileStatus
PFiles.getSymbolicLinkStatus
  {-# INLINEABLE getSymbolicLinkStatus #-}
  createNamedPipe :: HasCallStack => PosixPath -> FileMode -> IO ()
createNamedPipe = PosixPath -> FileMode -> IO ()
PFiles.createNamedPipe
  {-# INLINEABLE createNamedPipe #-}
  createDevice :: HasCallStack => PosixPath -> FileMode -> DeviceID -> IO ()
createDevice = PosixPath -> FileMode -> DeviceID -> IO ()
PFiles.createDevice
  {-# INLINEABLE createDevice #-}
  createLink :: HasCallStack => PosixPath -> PosixPath -> IO ()
createLink = PosixPath -> PosixPath -> IO ()
PFiles.createLink
  {-# INLINEABLE createLink #-}
  removeLink :: HasCallStack => PosixPath -> IO ()
removeLink = PosixPath -> IO ()
PFiles.removeLink
  {-# INLINEABLE removeLink #-}
  createSymbolicLink :: HasCallStack => PosixPath -> PosixPath -> IO ()
createSymbolicLink = PosixPath -> PosixPath -> IO ()
PFiles.createSymbolicLink
  {-# INLINEABLE createSymbolicLink #-}
  readSymbolicLink :: HasCallStack => PosixPath -> IO PosixPath
readSymbolicLink = PosixPath -> IO PosixPath
PFiles.readSymbolicLink
  {-# INLINEABLE readSymbolicLink #-}
  rename :: HasCallStack => PosixPath -> PosixPath -> IO ()
rename = PosixPath -> PosixPath -> IO ()
PFiles.rename
  {-# INLINEABLE rename #-}
  setOwnerAndGroup :: HasCallStack => PosixPath -> UserID -> GroupID -> IO ()
setOwnerAndGroup = PosixPath -> UserID -> GroupID -> IO ()
PFiles.setOwnerAndGroup
  {-# INLINEABLE setOwnerAndGroup #-}
  setFdOwnerAndGroup :: HasCallStack => Fd -> UserID -> GroupID -> IO ()
setFdOwnerAndGroup = Fd -> UserID -> GroupID -> IO ()
PFiles.setFdOwnerAndGroup
  {-# INLINEABLE setFdOwnerAndGroup #-}
  setSymbolicLinkOwnerAndGroup :: HasCallStack => PosixPath -> UserID -> GroupID -> IO ()
setSymbolicLinkOwnerAndGroup = PosixPath -> UserID -> GroupID -> IO ()
PFiles.setSymbolicLinkOwnerAndGroup
  {-# INLINEABLE setSymbolicLinkOwnerAndGroup #-}
  setFileTimes :: HasCallStack => PosixPath -> EpochTime -> EpochTime -> IO ()
setFileTimes = PosixPath -> EpochTime -> EpochTime -> IO ()
PFiles.setFileTimes
  {-# INLINEABLE setFileTimes #-}
  touchFile :: HasCallStack => PosixPath -> IO ()
touchFile = PosixPath -> IO ()
PFiles.touchFile
  {-# INLINEABLE touchFile #-}
  setFileSize :: HasCallStack => PosixPath -> FileOffset -> IO ()
setFileSize = PosixPath -> FileOffset -> IO ()
PFiles.setFileSize
  {-# INLINEABLE setFileSize #-}
  setFdSize :: HasCallStack => Fd -> FileOffset -> IO ()
setFdSize = Fd -> FileOffset -> IO ()
PFiles.setFdSize
  {-# INLINEABLE setFdSize #-}
  getPathVar :: HasCallStack => PosixPath -> PathVar -> IO Limit
getPathVar = PosixPath -> PathVar -> IO Limit
PFiles.getPathVar
  {-# INLINEABLE getPathVar #-}
  getFdPathVar :: HasCallStack => Fd -> PathVar -> IO Limit
getFdPathVar = Fd -> PathVar -> IO Limit
PFiles.getFdPathVar
  {-# INLINEABLE getFdPathVar #-}

-- | @since 0.1
instance (MonadPosix m) => MonadPosix (ReaderT e m) where
  setFileMode :: HasCallStack => PosixPath -> FileMode -> ReaderT e m ()
setFileMode PosixPath
p = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (FileMode -> m ()) -> FileMode -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> FileMode -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> FileMode -> m ()
setFileMode PosixPath
p
  {-# INLINEABLE setFileMode #-}
  setFdMode :: HasCallStack => Fd -> FileMode -> ReaderT e m ()
setFdMode Fd
fd = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (FileMode -> m ()) -> FileMode -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> FileMode -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
Fd -> FileMode -> m ()
setFdMode Fd
fd
  {-# INLINEABLE setFdMode #-}
  setFileCreationMask :: HasCallStack => FileMode -> ReaderT e m FileMode
setFileCreationMask = m FileMode -> ReaderT e m FileMode
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FileMode -> ReaderT e m FileMode)
-> (FileMode -> m FileMode) -> FileMode -> ReaderT e m FileMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileMode -> m FileMode
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
FileMode -> m FileMode
setFileCreationMask
  {-# INLINEABLE setFileCreationMask #-}
  fileAccess :: HasCallStack =>
PosixPath -> Bool -> Bool -> Bool -> ReaderT e m Bool
fileAccess PosixPath
p Bool
a Bool
b = m Bool -> ReaderT e m Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ReaderT e m Bool)
-> (Bool -> m Bool) -> Bool -> ReaderT e m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> Bool -> Bool -> Bool -> m Bool
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> Bool -> Bool -> Bool -> m Bool
fileAccess PosixPath
p Bool
a Bool
b
  {-# INLINEABLE fileAccess #-}
  fileExist :: HasCallStack => PosixPath -> ReaderT e m Bool
fileExist = m Bool -> ReaderT e m Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ReaderT e m Bool)
-> (PosixPath -> m Bool) -> PosixPath -> ReaderT e m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> m Bool
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> m Bool
fileExist
  {-# INLINEABLE fileExist #-}
  getFileStatus :: HasCallStack => PosixPath -> ReaderT e m FileStatus
getFileStatus = m FileStatus -> ReaderT e m FileStatus
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FileStatus -> ReaderT e m FileStatus)
-> (PosixPath -> m FileStatus)
-> PosixPath
-> ReaderT e m FileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> m FileStatus
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> m FileStatus
getFileStatus
  {-# INLINEABLE getFileStatus #-}
  getFdStatus :: HasCallStack => Fd -> ReaderT e m FileStatus
getFdStatus = m FileStatus -> ReaderT e m FileStatus
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FileStatus -> ReaderT e m FileStatus)
-> (Fd -> m FileStatus) -> Fd -> ReaderT e m FileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> m FileStatus
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
Fd -> m FileStatus
getFdStatus
  {-# INLINEABLE getFdStatus #-}
  getSymbolicLinkStatus :: HasCallStack => PosixPath -> ReaderT e m FileStatus
getSymbolicLinkStatus = m FileStatus -> ReaderT e m FileStatus
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FileStatus -> ReaderT e m FileStatus)
-> (PosixPath -> m FileStatus)
-> PosixPath
-> ReaderT e m FileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> m FileStatus
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> m FileStatus
getSymbolicLinkStatus
  {-# INLINEABLE getSymbolicLinkStatus #-}
  createNamedPipe :: HasCallStack => PosixPath -> FileMode -> ReaderT e m ()
createNamedPipe PosixPath
p = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (FileMode -> m ()) -> FileMode -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> FileMode -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> FileMode -> m ()
createNamedPipe PosixPath
p
  {-# INLINEABLE createNamedPipe #-}
  createDevice :: HasCallStack => PosixPath -> FileMode -> DeviceID -> ReaderT e m ()
createDevice PosixPath
p FileMode
m = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (DeviceID -> m ()) -> DeviceID -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> FileMode -> DeviceID -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> FileMode -> DeviceID -> m ()
createDevice PosixPath
p FileMode
m
  {-# INLINEABLE createDevice #-}
  createLink :: HasCallStack => PosixPath -> PosixPath -> ReaderT e m ()
createLink PosixPath
p = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (PosixPath -> m ()) -> PosixPath -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> PosixPath -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> PosixPath -> m ()
createLink PosixPath
p
  {-# INLINEABLE createLink #-}
  removeLink :: HasCallStack => PosixPath -> ReaderT e m ()
removeLink = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (PosixPath -> m ()) -> PosixPath -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> m ()
removeLink
  {-# INLINEABLE removeLink #-}
  createSymbolicLink :: HasCallStack => PosixPath -> PosixPath -> ReaderT e m ()
createSymbolicLink PosixPath
p = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (PosixPath -> m ()) -> PosixPath -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> PosixPath -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> PosixPath -> m ()
createSymbolicLink PosixPath
p
  {-# INLINEABLE createSymbolicLink #-}
  readSymbolicLink :: HasCallStack => PosixPath -> ReaderT e m PosixPath
readSymbolicLink = m PosixPath -> ReaderT e m PosixPath
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m PosixPath -> ReaderT e m PosixPath)
-> (PosixPath -> m PosixPath) -> PosixPath -> ReaderT e m PosixPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> m PosixPath
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> m PosixPath
readSymbolicLink
  {-# INLINEABLE readSymbolicLink #-}
  rename :: HasCallStack => PosixPath -> PosixPath -> ReaderT e m ()
rename PosixPath
p = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (PosixPath -> m ()) -> PosixPath -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> PosixPath -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> PosixPath -> m ()
rename PosixPath
p
  {-# INLINEABLE rename #-}
  setOwnerAndGroup :: HasCallStack => PosixPath -> UserID -> GroupID -> ReaderT e m ()
setOwnerAndGroup PosixPath
p UserID
u = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (GroupID -> m ()) -> GroupID -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> UserID -> GroupID -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> UserID -> GroupID -> m ()
setOwnerAndGroup PosixPath
p UserID
u
  {-# INLINEABLE setOwnerAndGroup #-}
  setFdOwnerAndGroup :: HasCallStack => Fd -> UserID -> GroupID -> ReaderT e m ()
setFdOwnerAndGroup Fd
fd UserID
u = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (GroupID -> m ()) -> GroupID -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> UserID -> GroupID -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
Fd -> UserID -> GroupID -> m ()
setFdOwnerAndGroup Fd
fd UserID
u
  {-# INLINEABLE setFdOwnerAndGroup #-}
  setSymbolicLinkOwnerAndGroup :: HasCallStack => PosixPath -> UserID -> GroupID -> ReaderT e m ()
setSymbolicLinkOwnerAndGroup PosixPath
p UserID
u = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (GroupID -> m ()) -> GroupID -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> UserID -> GroupID -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> UserID -> GroupID -> m ()
setSymbolicLinkOwnerAndGroup PosixPath
p UserID
u
  {-# INLINEABLE setSymbolicLinkOwnerAndGroup #-}
  setFileTimes :: HasCallStack =>
PosixPath -> EpochTime -> EpochTime -> ReaderT e m ()
setFileTimes PosixPath
p EpochTime
t = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (EpochTime -> m ()) -> EpochTime -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> EpochTime -> EpochTime -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> EpochTime -> EpochTime -> m ()
setFileTimes PosixPath
p EpochTime
t
  {-# INLINEABLE setFileTimes #-}
  touchFile :: HasCallStack => PosixPath -> ReaderT e m ()
touchFile = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (PosixPath -> m ()) -> PosixPath -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> m ()
touchFile
  {-# INLINEABLE touchFile #-}
  setFileSize :: HasCallStack => PosixPath -> FileOffset -> ReaderT e m ()
setFileSize PosixPath
p = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (FileOffset -> m ()) -> FileOffset -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> FileOffset -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> FileOffset -> m ()
setFileSize PosixPath
p
  {-# INLINEABLE setFileSize #-}
  setFdSize :: HasCallStack => Fd -> FileOffset -> ReaderT e m ()
setFdSize Fd
fd = m () -> ReaderT e m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT e m ())
-> (FileOffset -> m ()) -> FileOffset -> ReaderT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> FileOffset -> m ()
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
Fd -> FileOffset -> m ()
setFdSize Fd
fd
  {-# INLINEABLE setFdSize #-}
  getPathVar :: HasCallStack => PosixPath -> PathVar -> ReaderT e m Limit
getPathVar PosixPath
p = m Limit -> ReaderT e m Limit
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Limit -> ReaderT e m Limit)
-> (PathVar -> m Limit) -> PathVar -> ReaderT e m Limit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> PathVar -> m Limit
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> PathVar -> m Limit
getPathVar PosixPath
p
  {-# INLINEABLE getPathVar #-}
  getFdPathVar :: HasCallStack => Fd -> PathVar -> ReaderT e m Limit
getFdPathVar Fd
fd = m Limit -> ReaderT e m Limit
forall (m :: * -> *) a. Monad m => m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Limit -> ReaderT e m Limit)
-> (PathVar -> m Limit) -> PathVar -> ReaderT e m Limit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> PathVar -> m Limit
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
Fd -> PathVar -> m Limit
getFdPathVar Fd
fd
  {-# INLINEABLE getFdPathVar #-}

-- | Throws 'IOException' if the path does not exist or the expected path type
-- does not match actual.
--
-- @since 0.1
throwIfWrongPathType ::
  ( HasCallStack,
    MonadCatch m,
    MonadPosix m
  ) =>
  String ->
  PathType ->
  PosixPath ->
  m ()
throwIfWrongPathType :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPosix m) =>
String -> PathType -> PosixPath -> m ()
throwIfWrongPathType String
location PathType
expected PosixPath
path = do
  PathType
actual <- PosixPath -> m PathType
forall (m :: * -> *).
(HasCallStack, MonadPosix m) =>
PosixPath -> m PathType
getPathType PosixPath
path

  let err :: String
err =
        [String] -> String
forall a. Monoid a => [a] -> a
mconcat
          [ String
"Expected path to have type ",
            PathType -> String
forall a. IsString a => PathType -> a
displayPathType PathType
expected,
            String
", but detected ",
            PathType -> String
forall a. IsString a => PathType -> a
displayPathType PathType
actual
          ]

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PathType
expected PathType -> PathType -> Bool
forall a. Eq a => a -> a -> Bool
== PathType
actual) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    OsPath -> String -> IOErrorType -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
OsPath -> String -> IOErrorType -> String -> m a
FS.IO.throwPathIOError
      (PosixPath -> OsPath
OsString PosixPath
path)
      String
location
      IOErrorType
InappropriateType
      String
err
{-# INLINEABLE throwIfWrongPathType #-}

-- | Checks that the path type matches the expectation. Throws
-- 'IOException' if the path does not exist or the type cannot be detected.
--
-- @since 0.1
isPathType ::
  ( HasCallStack,
    MonadPosix m
  ) =>
  PathType ->
  PosixPath ->
  m Bool
isPathType :: forall (m :: * -> *).
(HasCallStack, MonadPosix m) =>
PathType -> PosixPath -> m Bool
isPathType PathType
expected = (PathType -> Bool) -> m PathType -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PathType -> PathType -> Bool
forall a. Eq a => a -> a -> Bool
== PathType
expected) (m PathType -> m Bool)
-> (PosixPath -> m PathType) -> PosixPath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> m PathType
forall (m :: * -> *).
(HasCallStack, MonadPosix m) =>
PosixPath -> m PathType
getPathType
{-# INLINEABLE isPathType #-}

-- | Returns the type for a given path without following symlinks.
-- Throws 'IOException' if the path does not exist or the type cannot be
-- detected.
--
-- @since 0.1
getPathType ::
  ( HasCallStack,
    MonadPosix m
  ) =>
  PosixPath ->
  m PathType
getPathType :: forall (m :: * -> *).
(HasCallStack, MonadPosix m) =>
PosixPath -> m PathType
getPathType PosixPath
path =
  -- NOTE: We use getSymbolicLinkStatus instead of getFileStatus because
  -- the latter follows symlinks, which we do not want.
  PosixPath -> m FileStatus
forall (m :: * -> *).
(MonadPosix m, HasCallStack) =>
PosixPath -> m FileStatus
getSymbolicLinkStatus PosixPath
path m FileStatus -> (FileStatus -> PathType) -> m PathType
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \FileStatus
status ->
    if
      | FileStatus -> Bool
PFiles.isSymbolicLink FileStatus
status -> PathType
PathTypeSymbolicLink
      | FileStatus -> Bool
PFiles.isDirectory FileStatus
status -> PathType
PathTypeDirectory
      | FileStatus -> Bool
PFiles.isRegularFile FileStatus
status -> PathType
PathTypeFile
      | Bool
otherwise -> PathType
PathTypeOther
{-# INLINEABLE getPathType #-}