{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Provides a static effect for "System.Posix.Files".
--
-- @since 0.1
module Effectful.Posix.Files.Static
  ( -- * Effect
    PosixFiles,
    setFileMode,
    setFdMode,
    setFileCreationMask,
    fileAccess,
    fileExist,
    getFileStatus,
    getFdStatus,
    getSymbolicLinkStatus,
    createNamedPipe,
    createDevice,
    createLink,
    removeLink,
    createSymbolicLink,
    readSymbolicLink,
    rename,
    setOwnerAndGroup,
    setFdOwnerAndGroup,
    setSymbolicLinkOwnerAndGroup,
    setFileTimes,
    touchFile,
    setFileSize,
    setFdSize,
    getPathVar,
    getFdPathVar,

    -- ** Handler
    runPosixFiles,

    -- * PathType
    PathType (..),
    displayPathType,

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

import Control.Monad (unless)
import Data.Functor ((<&>))
import Effectful
  ( Dispatch (Static),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    type (:>),
  )
import Effectful.Dispatch.Static
  ( HasCallStack,
    SideEffects (WithSideEffects),
    StaticRep,
    evalStaticRep,
    unsafeEff_,
  )
import FileSystem.IO qualified as FS.IO
import FileSystem.PathType
  ( PathType
      ( PathTypeDirectory,
        PathTypeFile,
        PathTypeOther,
        PathTypeSymbolicLink
      ),
    displayPathType,
  )
import GHC.IO.Exception (IOErrorType (InappropriateType))
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,
  )

-- | Provides a static effect for "System.Posix.Files".
--
-- @since 0.1
data PosixFiles :: Effect

type instance DispatchOf PosixFiles = Static WithSideEffects

data instance StaticRep PosixFiles = MkPosixFiles

-- | Runs a PosixFiles effect.
--
-- @since 0.1
runPosixFiles ::
  (HasCallStack, IOE :> es) =>
  Eff (PosixFiles : es) a ->
  Eff es a
runPosixFiles :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
Eff (PosixFiles : es) a -> Eff es a
runPosixFiles = StaticRep PosixFiles -> Eff (PosixFiles : es) a -> Eff es a
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep StaticRep PosixFiles
MkPosixFiles

-- | Lifted 'PFiles.setFileMode'.
--
-- @since 0.1
setFileMode ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  FileMode ->
  Eff es ()
setFileMode :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> FileMode -> Eff es ()
setFileMode PosixPath
p = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (FileMode -> IO ()) -> FileMode -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> FileMode -> IO ()
PFiles.setFileMode PosixPath
p

-- | Lifted 'PFiles.setFdMode'.
--
-- @since 0.1
setFdMode ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  Fd ->
  FileMode ->
  Eff es ()
setFdMode :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
Fd -> FileMode -> Eff es ()
setFdMode Fd
p = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (FileMode -> IO ()) -> FileMode -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> FileMode -> IO ()
PFiles.setFdMode Fd
p

-- | Lifted 'PFiles.setFileCreationMask'.
--
-- @since 0.1
setFileCreationMask ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  FileMode ->
  Eff es FileMode
setFileCreationMask :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
FileMode -> Eff es FileMode
setFileCreationMask = IO FileMode -> Eff es FileMode
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO FileMode -> Eff es FileMode)
-> (FileMode -> IO FileMode) -> FileMode -> Eff es FileMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileMode -> IO FileMode
PFiles.setFileCreationMask

-- | Lifted 'PFiles.fileAccess'.
--
-- @since 0.1
fileAccess ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  Bool ->
  Bool ->
  Bool ->
  Eff es Bool
fileAccess :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> Bool -> Bool -> Bool -> Eff es Bool
fileAccess PosixPath
p Bool
b Bool
c = IO Bool -> Eff es Bool
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Bool -> Eff es Bool)
-> (Bool -> IO Bool) -> Bool -> Eff es Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> Bool -> Bool -> Bool -> IO Bool
PFiles.fileAccess PosixPath
p Bool
b Bool
c

-- | Lifted 'PFiles.fileExist'.
--
-- @since 0.1
fileExist ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  Eff es Bool
fileExist :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> Eff es Bool
fileExist = IO Bool -> Eff es Bool
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Bool -> Eff es Bool)
-> (PosixPath -> IO Bool) -> PosixPath -> Eff es Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> IO Bool
PFiles.fileExist

-- | Lifted 'PFiles.getFileStatus'.
--
-- @since 0.1
getFileStatus ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  Eff es FileStatus
getFileStatus :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> Eff es FileStatus
getFileStatus = IO FileStatus -> Eff es FileStatus
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO FileStatus -> Eff es FileStatus)
-> (PosixPath -> IO FileStatus) -> PosixPath -> Eff es FileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> IO FileStatus
PFiles.getFileStatus

-- | Lifted 'PFiles.getFdStatus'.
--
-- @since 0.1
getFdStatus ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  Fd ->
  Eff es FileStatus
getFdStatus :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
Fd -> Eff es FileStatus
getFdStatus = IO FileStatus -> Eff es FileStatus
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO FileStatus -> Eff es FileStatus)
-> (Fd -> IO FileStatus) -> Fd -> Eff es FileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> IO FileStatus
PFiles.getFdStatus

-- | Lifted 'PFiles.getSymbolicLinkStatus'.
--
-- @since 0.1
getSymbolicLinkStatus ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  Eff es FileStatus
getSymbolicLinkStatus :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> Eff es FileStatus
getSymbolicLinkStatus = IO FileStatus -> Eff es FileStatus
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO FileStatus -> Eff es FileStatus)
-> (PosixPath -> IO FileStatus) -> PosixPath -> Eff es FileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> IO FileStatus
PFiles.getSymbolicLinkStatus

-- | Lifted 'PFiles.createNamedPipe'.
--
-- @since 0.1
createNamedPipe ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  FileMode ->
  Eff es ()
createNamedPipe :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> FileMode -> Eff es ()
createNamedPipe PosixPath
p = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (FileMode -> IO ()) -> FileMode -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> FileMode -> IO ()
PFiles.createNamedPipe PosixPath
p

-- | Lifted 'PFiles.createDevice'.
--
-- @since 0.1
createDevice ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  FileMode ->
  DeviceID ->
  Eff es ()
createDevice :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> FileMode -> DeviceID -> Eff es ()
createDevice PosixPath
p FileMode
m = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (DeviceID -> IO ()) -> DeviceID -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> FileMode -> DeviceID -> IO ()
PFiles.createDevice PosixPath
p FileMode
m

-- | Lifted 'PFiles.createLink'.
--
-- @since 0.1
createLink ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  PosixPath ->
  Eff es ()
createLink :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> PosixPath -> Eff es ()
createLink PosixPath
p = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (PosixPath -> IO ()) -> PosixPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> PosixPath -> IO ()
PFiles.createLink PosixPath
p

-- | Lifted 'PFiles.removeLink'.
--
-- @since 0.1
removeLink ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  Eff es ()
removeLink :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> Eff es ()
removeLink = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (PosixPath -> IO ()) -> PosixPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> IO ()
PFiles.removeLink

-- | Lifted 'PFiles.createSymbolicLink'.
--
-- @since 0.1
createSymbolicLink ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  PosixPath ->
  Eff es ()
createSymbolicLink :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> PosixPath -> Eff es ()
createSymbolicLink PosixPath
p = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (PosixPath -> IO ()) -> PosixPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> PosixPath -> IO ()
PFiles.createSymbolicLink PosixPath
p

-- | Lifted 'PFiles.readSymbolicLink'.
--
-- @since 0.1
readSymbolicLink ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  Eff es PosixPath
readSymbolicLink :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> Eff es PosixPath
readSymbolicLink = IO PosixPath -> Eff es PosixPath
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO PosixPath -> Eff es PosixPath)
-> (PosixPath -> IO PosixPath) -> PosixPath -> Eff es PosixPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> IO PosixPath
PFiles.readSymbolicLink

-- | Lifted 'PFiles.rename'.
--
-- @since 0.1
rename ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  PosixPath ->
  Eff es ()
rename :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> PosixPath -> Eff es ()
rename PosixPath
p = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (PosixPath -> IO ()) -> PosixPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> PosixPath -> IO ()
PFiles.rename PosixPath
p

-- | Lifted 'PFiles.setOwnerAndGroup'.
--
-- @since 0.1
setOwnerAndGroup ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  UserID ->
  GroupID ->
  Eff es ()
setOwnerAndGroup :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> UserID -> GroupID -> Eff es ()
setOwnerAndGroup PosixPath
p UserID
uid = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> (GroupID -> IO ()) -> GroupID -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> UserID -> GroupID -> IO ()
PFiles.setOwnerAndGroup PosixPath
p UserID
uid

-- | Lifted 'PFiles.setFdOwnerAndGroup'.
--
-- @since 0.1
setFdOwnerAndGroup ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  Fd ->
  UserID ->
  GroupID ->
  Eff es ()
setFdOwnerAndGroup :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
Fd -> UserID -> GroupID -> Eff es ()
setFdOwnerAndGroup Fd
fd UserID
uid = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> (GroupID -> IO ()) -> GroupID -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> UserID -> GroupID -> IO ()
PFiles.setFdOwnerAndGroup Fd
fd UserID
uid

-- | Lifted 'PFiles.setSymbolicLinkOwnerAndGroup'.
--
-- @since 0.1
setSymbolicLinkOwnerAndGroup ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  UserID ->
  GroupID ->
  Eff es ()
setSymbolicLinkOwnerAndGroup :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> UserID -> GroupID -> Eff es ()
setSymbolicLinkOwnerAndGroup PosixPath
p UserID
uid = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> (GroupID -> IO ()) -> GroupID -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> UserID -> GroupID -> IO ()
PFiles.setSymbolicLinkOwnerAndGroup PosixPath
p UserID
uid

-- | Lifted 'PFiles.setFileTimes'.
--
-- @since 0.1
setFileTimes ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  EpochTime ->
  EpochTime ->
  Eff es ()
setFileTimes :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> EpochTime -> EpochTime -> Eff es ()
setFileTimes PosixPath
p EpochTime
t = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (EpochTime -> IO ()) -> EpochTime -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> EpochTime -> EpochTime -> IO ()
PFiles.setFileTimes PosixPath
p EpochTime
t

-- | Lifted 'PFiles.touchFile'.
--
-- @since 0.1
touchFile ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  Eff es ()
touchFile :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> Eff es ()
touchFile = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (PosixPath -> IO ()) -> PosixPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> IO ()
PFiles.touchFile

-- | Lifted 'PFiles.setFileSize'.
--
-- @since 0.1
setFileSize ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  FileOffset ->
  Eff es ()
setFileSize :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> FileOffset -> Eff es ()
setFileSize PosixPath
p = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (FileOffset -> IO ()) -> FileOffset -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> FileOffset -> IO ()
PFiles.setFileSize PosixPath
p

-- | Lifted 'PFiles.setFdSize'.
--
-- @since 0.1
setFdSize ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  Fd ->
  FileOffset ->
  Eff es ()
setFdSize :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
Fd -> FileOffset -> Eff es ()
setFdSize Fd
fd = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (FileOffset -> IO ()) -> FileOffset -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> FileOffset -> IO ()
PFiles.setFdSize Fd
fd

-- | Lifted 'PFiles.getPathVar'.
--
-- @since 0.1
getPathVar ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  PosixPath ->
  PathVar ->
  Eff es Limit
getPathVar :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> PathVar -> Eff es Limit
getPathVar PosixPath
p = IO Limit -> Eff es Limit
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Limit -> Eff es Limit)
-> (PathVar -> IO Limit) -> PathVar -> Eff es Limit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> PathVar -> IO Limit
PFiles.getPathVar PosixPath
p

-- | Lifted 'PFiles.getFdPathVar'.
--
-- @since 0.1
getFdPathVar ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  Fd ->
  PathVar ->
  Eff es Limit
getFdPathVar :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
Fd -> PathVar -> Eff es Limit
getFdPathVar Fd
fd = IO Limit -> Eff es Limit
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Limit -> Eff es Limit)
-> (PathVar -> IO Limit) -> PathVar -> Eff es Limit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> PathVar -> IO Limit
PFiles.getFdPathVar Fd
fd

-- | Throws 'IOException' if the path does not exist or the expected path type
-- does not match actual.
--
-- @since 0.1
throwIfWrongPathType ::
  ( HasCallStack,
    PosixFiles :> es
  ) =>
  String ->
  PathType ->
  PosixPath ->
  Eff es ()
throwIfWrongPathType :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
String -> PathType -> PosixPath -> Eff es ()
throwIfWrongPathType String
location PathType
expected PosixPath
path = do
  actual <- PosixPath -> Eff es PathType
forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> Eff es PathType
getPathType PosixPath
path

  let 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
          ]

  unless (expected == actual) $
    FS.IO.throwPathIOError
      (OsString path)
      location
      InappropriateType
      err

-- | 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,
    PosixFiles :> es
  ) =>
  PathType ->
  PosixPath ->
  Eff es Bool
isPathType :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PathType -> PosixPath -> Eff es Bool
isPathType PathType
expected = (PathType -> Bool) -> Eff es PathType -> Eff es Bool
forall a b. (a -> b) -> Eff es a -> Eff es 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) (Eff es PathType -> Eff es Bool)
-> (PosixPath -> Eff es PathType) -> PosixPath -> Eff es Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> Eff es PathType
forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> Eff es PathType
getPathType

-- | 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,
    PosixFiles :> es
  ) =>
  PosixPath ->
  Eff es PathType
getPathType :: forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> Eff es PathType
getPathType PosixPath
path = do
  PosixPath -> Eff es FileStatus
forall (es :: [Effect]).
(HasCallStack, PosixFiles :> es) =>
PosixPath -> Eff es FileStatus
getSymbolicLinkStatus PosixPath
path Eff es FileStatus -> (FileStatus -> PathType) -> Eff es 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