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

-- | Provides the MonadPathReader effect.
--
-- @since 0.1
module Effects.FileSystem.PathReader
  ( -- * Effect
    MonadPathReader (..),
    OsPath,

    -- ** Functions
    findFile,
    findFiles,

    -- * XDG Utils
    getXdgData,
    getXdgConfig,
    getXdgCache,
    getXdgState,

    -- * Path Types
    PathType (..),

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

    -- * Misc
    listDirectoryRecursive,
    listDirectoryRecursiveSymbolicLink,
    doesSymbolicLinkExist,
    pathIsSymbolicDirectoryLink,
    pathIsSymbolicFileLink,

    -- * Re-exports
    XdgDirectory (..),
    XdgDirectoryList (..),
    Permissions (..),
    UTCTime (..),
  )
where

import Control.Monad (unless, (>=>))
import Control.Monad.Catch (MonadCatch)
import Control.Monad.Catch qualified as Ex
import Control.Monad.Trans.Class (MonadTrans (lift))
import Control.Monad.Trans.Reader (ReaderT (runReaderT), ask)
import Data.Time (UTCTime (UTCTime, utctDay, utctDayTime))
import FileSystem.IO qualified as FS.IO
import FileSystem.OsPath (OsPath, (</>))
import FileSystem.PathType
  ( PathType
      ( PathTypeDirectory,
        PathTypeFile,
        PathTypeOther,
        PathTypeSymbolicLink
      ),
    displayPathType,
  )
import GHC.IO.Exception (IOErrorType (InappropriateType))
import GHC.Stack (HasCallStack)
import System.Directory
  ( Permissions,
    XdgDirectory (XdgCache, XdgConfig, XdgData, XdgState),
    XdgDirectoryList (XdgConfigDirs, XdgDataDirs),
  )
import System.Directory.OsPath qualified as Dir
import System.IO.Error qualified as IO.Error

-- | Represents file-system reader effects.
--
-- @since 0.1
class (Monad m) => MonadPathReader m where
  -- | Lifted 'Dir.listDirectory'.
  --
  -- @since 0.1
  listDirectory :: (HasCallStack) => OsPath -> m [OsPath]

  -- | Lifted 'Dir.getDirectoryContents'.
  --
  -- @since 0.1
  getDirectoryContents :: (HasCallStack) => OsPath -> m [OsPath]

  -- | Lifted 'Dir.getCurrentDirectory'.
  --
  -- @since 0.1
  getCurrentDirectory :: (HasCallStack) => m OsPath

  -- | Lifted 'Dir.getHomeDirectory'.
  --
  -- @since 0.1
  getHomeDirectory :: (HasCallStack) => m OsPath

  -- | Lifted 'Dir.getXdgDirectory'.
  --
  -- @since 0.1
  getXdgDirectory :: (HasCallStack) => XdgDirectory -> OsPath -> m OsPath

  -- | Lifted 'Dir.getXdgDirectoryList'.
  --
  -- @since 0.1
  getXdgDirectoryList :: (HasCallStack) => XdgDirectoryList -> m [OsPath]

  -- | Lifted 'Dir.getAppUserDataDirectory'.
  --
  -- @since 0.1
  getAppUserDataDirectory :: (HasCallStack) => OsPath -> m OsPath

  -- | Lifted 'Dir.getUserDocumentsDirectory'.
  --
  -- @since 0.1
  getUserDocumentsDirectory :: (HasCallStack) => m OsPath

  -- | Lifted 'Dir.getTemporaryDirectory'.
  --
  -- @since 0.1
  getTemporaryDirectory :: (HasCallStack) => m OsPath

  -- | Lifted 'Dir.getFileSize'.
  --
  -- @since 0.1
  getFileSize :: (HasCallStack) => OsPath -> m Integer

  -- | Lifted 'Dir.canonicalizePath'.
  --
  -- @since 0.1
  canonicalizePath :: (HasCallStack) => OsPath -> m OsPath

  -- | Lifted 'Dir.makeAbsolute'.
  --
  -- @since 0.1
  makeAbsolute :: (HasCallStack) => OsPath -> m OsPath

  -- | Lifted 'Dir.makeRelativeToCurrentDirectory'.
  --
  -- @since 0.1
  makeRelativeToCurrentDirectory :: (HasCallStack) => OsPath -> m OsPath

  -- | Lifted 'Dir.doesPathExist'.
  --
  -- @since 0.1
  doesPathExist :: (HasCallStack) => OsPath -> m Bool

  -- | Lifted 'Dir.doesFileExist'.
  --
  -- @since 0.1
  doesFileExist :: (HasCallStack) => OsPath -> m Bool

  -- | Lifted 'Dir.doesDirectoryExist'.
  --
  -- @since 0.1
  doesDirectoryExist :: (HasCallStack) => OsPath -> m Bool

  -- | Lifted 'Dir.findExecutable'.
  --
  -- @since 0.1
  findExecutable :: (HasCallStack) => OsPath -> m (Maybe OsPath)

  -- | Lifted 'Dir.findExecutables'.
  --
  -- @since 0.1
  findExecutables :: (HasCallStack) => OsPath -> m [OsPath]

  -- | Lifted 'Dir.findExecutablesInDirectories'.
  --
  -- @since 0.1
  findExecutablesInDirectories :: (HasCallStack) => [OsPath] -> OsPath -> m [OsPath]

  -- | Lifted 'Dir.findFileWith'.
  --
  -- @since 0.1
  findFileWith :: (HasCallStack) => (OsPath -> m Bool) -> [OsPath] -> OsPath -> m (Maybe OsPath)

  -- | Lifted 'Dir.findFilesWith'.
  --
  -- @since 0.1
  findFilesWith :: (HasCallStack) => (OsPath -> m Bool) -> [OsPath] -> OsPath -> m [OsPath]

  -- | Lifted 'Dir.pathIsSymbolicLink'.
  --
  -- @since 0.1
  pathIsSymbolicLink :: (HasCallStack) => OsPath -> m Bool

  -- | Lifted 'Dir.getSymbolicLinkTarget'.
  --
  -- @since 0.1
  getSymbolicLinkTarget :: (HasCallStack) => OsPath -> m OsPath

  -- | Lifted 'Dir.getPermissions'.
  --
  -- @since 0.1
  getPermissions :: (HasCallStack) => OsPath -> m Permissions

  -- | Lifted 'Dir.getAccessTime'.
  --
  -- @since 0.1
  getAccessTime :: (HasCallStack) => OsPath -> m UTCTime

  -- | Lifted 'Dir.getModificationTime'.
  --
  -- @since 0.1
  getModificationTime :: (HasCallStack) => OsPath -> m UTCTime

instance MonadPathReader IO where
  listDirectory :: HasCallStack => OsPath -> IO [OsPath]
listDirectory = OsPath -> IO [OsPath]
Dir.listDirectory
  {-# INLINEABLE listDirectory #-}
  getDirectoryContents :: HasCallStack => OsPath -> IO [OsPath]
getDirectoryContents = OsPath -> IO [OsPath]
Dir.getDirectoryContents
  {-# INLINEABLE getDirectoryContents #-}
  getCurrentDirectory :: HasCallStack => IO OsPath
getCurrentDirectory = IO OsPath
Dir.getCurrentDirectory
  {-# INLINEABLE getCurrentDirectory #-}
  getHomeDirectory :: HasCallStack => IO OsPath
getHomeDirectory = IO OsPath
Dir.getHomeDirectory
  {-# INLINEABLE getHomeDirectory #-}
  getXdgDirectory :: HasCallStack => XdgDirectory -> OsPath -> IO OsPath
getXdgDirectory = XdgDirectory -> OsPath -> IO OsPath
Dir.getXdgDirectory
  {-# INLINEABLE getXdgDirectory #-}
  getXdgDirectoryList :: HasCallStack => XdgDirectoryList -> IO [OsPath]
getXdgDirectoryList = XdgDirectoryList -> IO [OsPath]
Dir.getXdgDirectoryList
  {-# INLINEABLE getXdgDirectoryList #-}
  getAppUserDataDirectory :: HasCallStack => OsPath -> IO OsPath
getAppUserDataDirectory = OsPath -> IO OsPath
Dir.getAppUserDataDirectory
  {-# INLINEABLE getAppUserDataDirectory #-}
  getUserDocumentsDirectory :: HasCallStack => IO OsPath
getUserDocumentsDirectory = IO OsPath
Dir.getUserDocumentsDirectory
  {-# INLINEABLE getUserDocumentsDirectory #-}
  getTemporaryDirectory :: HasCallStack => IO OsPath
getTemporaryDirectory = IO OsPath
Dir.getTemporaryDirectory
  {-# INLINEABLE getTemporaryDirectory #-}
  getFileSize :: HasCallStack => OsPath -> IO Integer
getFileSize = OsPath -> IO Integer
Dir.getFileSize
  {-# INLINEABLE getFileSize #-}
  canonicalizePath :: HasCallStack => OsPath -> IO OsPath
canonicalizePath = OsPath -> IO OsPath
Dir.canonicalizePath
  {-# INLINEABLE canonicalizePath #-}
  makeAbsolute :: HasCallStack => OsPath -> IO OsPath
makeAbsolute = OsPath -> IO OsPath
Dir.makeAbsolute
  {-# INLINEABLE makeAbsolute #-}
  makeRelativeToCurrentDirectory :: HasCallStack => OsPath -> IO OsPath
makeRelativeToCurrentDirectory = OsPath -> IO OsPath
Dir.makeRelativeToCurrentDirectory
  {-# INLINEABLE makeRelativeToCurrentDirectory #-}
  doesPathExist :: HasCallStack => OsPath -> IO Bool
doesPathExist = OsPath -> IO Bool
Dir.doesPathExist
  {-# INLINEABLE doesPathExist #-}
  doesFileExist :: HasCallStack => OsPath -> IO Bool
doesFileExist = OsPath -> IO Bool
Dir.doesFileExist
  {-# INLINEABLE doesFileExist #-}
  doesDirectoryExist :: HasCallStack => OsPath -> IO Bool
doesDirectoryExist = OsPath -> IO Bool
Dir.doesDirectoryExist
  {-# INLINEABLE doesDirectoryExist #-}
  findExecutable :: HasCallStack => OsPath -> IO (Maybe OsPath)
findExecutable = OsPath -> IO (Maybe OsPath)
Dir.findExecutable
  {-# INLINEABLE findExecutable #-}
  findExecutables :: HasCallStack => OsPath -> IO [OsPath]
findExecutables = OsPath -> IO [OsPath]
Dir.findExecutables
  {-# INLINEABLE findExecutables #-}
  findExecutablesInDirectories :: HasCallStack => [OsPath] -> OsPath -> IO [OsPath]
findExecutablesInDirectories = [OsPath] -> OsPath -> IO [OsPath]
Dir.findExecutablesInDirectories
  {-# INLINEABLE findExecutablesInDirectories #-}
  findFileWith :: HasCallStack =>
(OsPath -> IO Bool) -> [OsPath] -> OsPath -> IO (Maybe OsPath)
findFileWith = (OsPath -> IO Bool) -> [OsPath] -> OsPath -> IO (Maybe OsPath)
Dir.findFileWith
  {-# INLINEABLE findFileWith #-}
  findFilesWith :: HasCallStack =>
(OsPath -> IO Bool) -> [OsPath] -> OsPath -> IO [OsPath]
findFilesWith = (OsPath -> IO Bool) -> [OsPath] -> OsPath -> IO [OsPath]
Dir.findFilesWith
  {-# INLINEABLE findFilesWith #-}
  pathIsSymbolicLink :: HasCallStack => OsPath -> IO Bool
pathIsSymbolicLink = OsPath -> IO Bool
Dir.pathIsSymbolicLink
  {-# INLINEABLE pathIsSymbolicLink #-}
  getSymbolicLinkTarget :: HasCallStack => OsPath -> IO OsPath
getSymbolicLinkTarget = OsPath -> IO OsPath
Dir.getSymbolicLinkTarget
  {-# INLINEABLE getSymbolicLinkTarget #-}
  getPermissions :: HasCallStack => OsPath -> IO Permissions
getPermissions = OsPath -> IO Permissions
Dir.getPermissions
  {-# INLINEABLE getPermissions #-}
  getAccessTime :: HasCallStack => OsPath -> IO UTCTime
getAccessTime = OsPath -> IO UTCTime
Dir.getAccessTime
  {-# INLINEABLE getAccessTime #-}
  getModificationTime :: HasCallStack => OsPath -> IO UTCTime
getModificationTime = OsPath -> IO UTCTime
Dir.getModificationTime
  {-# INLINEABLE getModificationTime #-}

instance (MonadPathReader m) => MonadPathReader (ReaderT env m) where
  listDirectory :: HasCallStack => OsPath -> ReaderT env m [OsPath]
listDirectory = m [OsPath] -> ReaderT env m [OsPath]
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [OsPath] -> ReaderT env m [OsPath])
-> (OsPath -> m [OsPath]) -> OsPath -> ReaderT env m [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m [OsPath]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m [OsPath]
listDirectory
  {-# INLINEABLE listDirectory #-}
  getDirectoryContents :: HasCallStack => OsPath -> ReaderT env m [OsPath]
getDirectoryContents = m [OsPath] -> ReaderT env m [OsPath]
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [OsPath] -> ReaderT env m [OsPath])
-> (OsPath -> m [OsPath]) -> OsPath -> ReaderT env m [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m [OsPath]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m [OsPath]
getDirectoryContents
  {-# INLINEABLE getDirectoryContents #-}
  getCurrentDirectory :: HasCallStack => ReaderT env m OsPath
getCurrentDirectory = m OsPath -> ReaderT env m OsPath
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m OsPath
forall (m :: * -> *). (MonadPathReader m, HasCallStack) => m OsPath
getCurrentDirectory
  {-# INLINEABLE getCurrentDirectory #-}
  getHomeDirectory :: HasCallStack => ReaderT env m OsPath
getHomeDirectory = m OsPath -> ReaderT env m OsPath
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m OsPath
forall (m :: * -> *). (MonadPathReader m, HasCallStack) => m OsPath
getHomeDirectory
  {-# INLINEABLE getHomeDirectory #-}
  getXdgDirectory :: HasCallStack => XdgDirectory -> OsPath -> ReaderT env m OsPath
getXdgDirectory XdgDirectory
d = m OsPath -> ReaderT env m OsPath
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m OsPath -> ReaderT env m OsPath)
-> (OsPath -> m OsPath) -> OsPath -> ReaderT env m OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XdgDirectory -> OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
XdgDirectory -> OsPath -> m OsPath
getXdgDirectory XdgDirectory
d
  {-# INLINEABLE getXdgDirectory #-}
  getXdgDirectoryList :: HasCallStack => XdgDirectoryList -> ReaderT env m [OsPath]
getXdgDirectoryList = m [OsPath] -> ReaderT env m [OsPath]
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [OsPath] -> ReaderT env m [OsPath])
-> (XdgDirectoryList -> m [OsPath])
-> XdgDirectoryList
-> ReaderT env m [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XdgDirectoryList -> m [OsPath]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
XdgDirectoryList -> m [OsPath]
getXdgDirectoryList
  {-# INLINEABLE getXdgDirectoryList #-}
  getAppUserDataDirectory :: HasCallStack => OsPath -> ReaderT env m OsPath
getAppUserDataDirectory = m OsPath -> ReaderT env m OsPath
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m OsPath -> ReaderT env m OsPath)
-> (OsPath -> m OsPath) -> OsPath -> ReaderT env m OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m OsPath
getAppUserDataDirectory
  {-# INLINEABLE getAppUserDataDirectory #-}
  getUserDocumentsDirectory :: HasCallStack => ReaderT env m OsPath
getUserDocumentsDirectory = m OsPath -> ReaderT env m OsPath
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m OsPath
forall (m :: * -> *). (MonadPathReader m, HasCallStack) => m OsPath
getUserDocumentsDirectory
  {-# INLINEABLE getUserDocumentsDirectory #-}
  getTemporaryDirectory :: HasCallStack => ReaderT env m OsPath
getTemporaryDirectory = m OsPath -> ReaderT env m OsPath
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m OsPath
forall (m :: * -> *). (MonadPathReader m, HasCallStack) => m OsPath
getTemporaryDirectory
  {-# INLINEABLE getTemporaryDirectory #-}
  getFileSize :: HasCallStack => OsPath -> ReaderT env m Integer
getFileSize = m Integer -> ReaderT env m Integer
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Integer -> ReaderT env m Integer)
-> (OsPath -> m Integer) -> OsPath -> ReaderT env m Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m Integer
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Integer
getFileSize
  {-# INLINEABLE getFileSize #-}
  canonicalizePath :: HasCallStack => OsPath -> ReaderT env m OsPath
canonicalizePath = m OsPath -> ReaderT env m OsPath
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m OsPath -> ReaderT env m OsPath)
-> (OsPath -> m OsPath) -> OsPath -> ReaderT env m OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m OsPath
canonicalizePath
  {-# INLINEABLE canonicalizePath #-}
  makeAbsolute :: HasCallStack => OsPath -> ReaderT env m OsPath
makeAbsolute = m OsPath -> ReaderT env m OsPath
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m OsPath -> ReaderT env m OsPath)
-> (OsPath -> m OsPath) -> OsPath -> ReaderT env m OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m OsPath
makeAbsolute
  {-# INLINEABLE makeAbsolute #-}
  makeRelativeToCurrentDirectory :: HasCallStack => OsPath -> ReaderT env m OsPath
makeRelativeToCurrentDirectory = m OsPath -> ReaderT env m OsPath
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m OsPath -> ReaderT env m OsPath)
-> (OsPath -> m OsPath) -> OsPath -> ReaderT env m OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m OsPath
makeRelativeToCurrentDirectory
  {-# INLINEABLE makeRelativeToCurrentDirectory #-}
  doesPathExist :: HasCallStack => OsPath -> ReaderT env m Bool
doesPathExist = m Bool -> ReaderT env m Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ReaderT env m Bool)
-> (OsPath -> m Bool) -> OsPath -> ReaderT env m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesPathExist
  {-# INLINEABLE doesPathExist #-}
  doesFileExist :: HasCallStack => OsPath -> ReaderT env m Bool
doesFileExist = m Bool -> ReaderT env m Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ReaderT env m Bool)
-> (OsPath -> m Bool) -> OsPath -> ReaderT env m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesFileExist
  {-# INLINEABLE doesFileExist #-}
  doesDirectoryExist :: HasCallStack => OsPath -> ReaderT env m Bool
doesDirectoryExist = m Bool -> ReaderT env m Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ReaderT env m Bool)
-> (OsPath -> m Bool) -> OsPath -> ReaderT env m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist
  {-# INLINEABLE doesDirectoryExist #-}
  findExecutable :: HasCallStack => OsPath -> ReaderT env m (Maybe OsPath)
findExecutable = m (Maybe OsPath) -> ReaderT env m (Maybe OsPath)
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe OsPath) -> ReaderT env m (Maybe OsPath))
-> (OsPath -> m (Maybe OsPath))
-> OsPath
-> ReaderT env m (Maybe OsPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m (Maybe OsPath)
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m (Maybe OsPath)
findExecutable
  {-# INLINEABLE findExecutable #-}
  findExecutables :: HasCallStack => OsPath -> ReaderT env m [OsPath]
findExecutables = m [OsPath] -> ReaderT env m [OsPath]
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [OsPath] -> ReaderT env m [OsPath])
-> (OsPath -> m [OsPath]) -> OsPath -> ReaderT env m [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m [OsPath]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m [OsPath]
findExecutables
  {-# INLINEABLE findExecutables #-}
  findExecutablesInDirectories :: HasCallStack => [OsPath] -> OsPath -> ReaderT env m [OsPath]
findExecutablesInDirectories [OsPath]
ps = m [OsPath] -> ReaderT env m [OsPath]
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [OsPath] -> ReaderT env m [OsPath])
-> (OsPath -> m [OsPath]) -> OsPath -> ReaderT env m [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OsPath] -> OsPath -> m [OsPath]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
[OsPath] -> OsPath -> m [OsPath]
findExecutablesInDirectories [OsPath]
ps
  {-# INLINEABLE findExecutablesInDirectories #-}
  findFileWith :: HasCallStack =>
(OsPath -> ReaderT env m Bool)
-> [OsPath] -> OsPath -> ReaderT env m (Maybe OsPath)
findFileWith OsPath -> ReaderT env m Bool
action [OsPath]
ps OsPath
fileName =
    ReaderT env m env
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT env m env
-> (env -> ReaderT env m (Maybe OsPath))
-> ReaderT env m (Maybe OsPath)
forall a b.
ReaderT env m a -> (a -> ReaderT env m b) -> ReaderT env m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Maybe OsPath) -> ReaderT env m (Maybe OsPath)
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe OsPath) -> ReaderT env m (Maybe OsPath))
-> (env -> m (Maybe OsPath)) -> env -> ReaderT env m (Maybe OsPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \env
e -> (OsPath -> m Bool) -> [OsPath] -> OsPath -> m (Maybe OsPath)
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
(OsPath -> m Bool) -> [OsPath] -> OsPath -> m (Maybe OsPath)
findFileWith ((ReaderT env m Bool -> env -> m Bool
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` env
e) (ReaderT env m Bool -> m Bool)
-> (OsPath -> ReaderT env m Bool) -> OsPath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> ReaderT env m Bool
action) [OsPath]
ps OsPath
fileName
  {-# INLINEABLE findFileWith #-}
  findFilesWith :: HasCallStack =>
(OsPath -> ReaderT env m Bool)
-> [OsPath] -> OsPath -> ReaderT env m [OsPath]
findFilesWith OsPath -> ReaderT env m Bool
action [OsPath]
ps OsPath
fileName =
    ReaderT env m env
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT env m env
-> (env -> ReaderT env m [OsPath]) -> ReaderT env m [OsPath]
forall a b.
ReaderT env m a -> (a -> ReaderT env m b) -> ReaderT env m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m [OsPath] -> ReaderT env m [OsPath]
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [OsPath] -> ReaderT env m [OsPath])
-> (env -> m [OsPath]) -> env -> ReaderT env m [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \env
e -> (OsPath -> m Bool) -> [OsPath] -> OsPath -> m [OsPath]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
(OsPath -> m Bool) -> [OsPath] -> OsPath -> m [OsPath]
findFilesWith ((ReaderT env m Bool -> env -> m Bool
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` env
e) (ReaderT env m Bool -> m Bool)
-> (OsPath -> ReaderT env m Bool) -> OsPath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> ReaderT env m Bool
action) [OsPath]
ps OsPath
fileName
  {-# INLINEABLE findFilesWith #-}
  pathIsSymbolicLink :: HasCallStack => OsPath -> ReaderT env m Bool
pathIsSymbolicLink = m Bool -> ReaderT env m Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ReaderT env m Bool)
-> (OsPath -> m Bool) -> OsPath -> ReaderT env m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
pathIsSymbolicLink
  {-# INLINEABLE pathIsSymbolicLink #-}
  getSymbolicLinkTarget :: HasCallStack => OsPath -> ReaderT env m OsPath
getSymbolicLinkTarget = m OsPath -> ReaderT env m OsPath
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m OsPath -> ReaderT env m OsPath)
-> (OsPath -> m OsPath) -> OsPath -> ReaderT env m OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m OsPath
getSymbolicLinkTarget
  {-# INLINEABLE getSymbolicLinkTarget #-}
  getPermissions :: HasCallStack => OsPath -> ReaderT env m Permissions
getPermissions = m Permissions -> ReaderT env m Permissions
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Permissions -> ReaderT env m Permissions)
-> (OsPath -> m Permissions) -> OsPath -> ReaderT env m Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m Permissions
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Permissions
getPermissions
  {-# INLINEABLE getPermissions #-}
  getAccessTime :: HasCallStack => OsPath -> ReaderT env m UTCTime
getAccessTime = m UTCTime -> ReaderT env m UTCTime
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m UTCTime -> ReaderT env m UTCTime)
-> (OsPath -> m UTCTime) -> OsPath -> ReaderT env m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m UTCTime
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m UTCTime
getAccessTime
  {-# INLINEABLE getAccessTime #-}
  getModificationTime :: HasCallStack => OsPath -> ReaderT env m UTCTime
getModificationTime = m UTCTime -> ReaderT env m UTCTime
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m UTCTime -> ReaderT env m UTCTime)
-> (OsPath -> m UTCTime) -> OsPath -> ReaderT env m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m UTCTime
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m UTCTime
getModificationTime
  {-# INLINEABLE getModificationTime #-}

-- | Search through the given list of directories for the given file.
--
-- The behavior is equivalent to 'findFileWith', returning only the first
-- occurrence. Details can be found in the documentation of 'findFileWith'.
--
-- @since 0.1
findFile :: (HasCallStack, MonadPathReader m) => [OsPath] -> OsPath -> m (Maybe OsPath)
findFile :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
[OsPath] -> OsPath -> m (Maybe OsPath)
findFile = (OsPath -> m Bool) -> [OsPath] -> OsPath -> m (Maybe OsPath)
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
(OsPath -> m Bool) -> [OsPath] -> OsPath -> m (Maybe OsPath)
findFileWith (\OsPath
_ -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
{-# INLINEABLE findFile #-}

-- | Search through the given list of directories for the given file and
-- returns all paths where the given file exists.
--
-- The behavior is equivalent to 'findFilesWith'. Details can be found in the
-- documentation of 'findFilesWith'.
--
-- @since 0.1
findFiles :: (HasCallStack, MonadPathReader m) => [OsPath] -> OsPath -> m [OsPath]
findFiles :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
[OsPath] -> OsPath -> m [OsPath]
findFiles = (OsPath -> m Bool) -> [OsPath] -> OsPath -> m [OsPath]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
(OsPath -> m Bool) -> [OsPath] -> OsPath -> m [OsPath]
findFilesWith (\OsPath
_ -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
{-# INLINEABLE findFiles #-}

-- | Retrieves the XDG data directory e.g. @~/.local\/share@.
--
-- @since 0.1
getXdgData :: (HasCallStack, MonadPathReader m) => OsPath -> m OsPath
getXdgData :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath -> m OsPath
getXdgData = XdgDirectory -> OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
XdgDirectory -> OsPath -> m OsPath
getXdgDirectory XdgDirectory
XdgData
{-# INLINEABLE getXdgData #-}

-- | Retrieves the XDG config directory e.g. @~/.config@.
--
-- @since 0.1
getXdgConfig :: (HasCallStack, MonadPathReader m) => OsPath -> m OsPath
getXdgConfig :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath -> m OsPath
getXdgConfig = XdgDirectory -> OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
XdgDirectory -> OsPath -> m OsPath
getXdgDirectory XdgDirectory
XdgConfig
{-# INLINEABLE getXdgConfig #-}

-- | Retrieves the XDG cache directory e.g. @~/.cache@.
--
-- @since 0.1
getXdgCache :: (HasCallStack, MonadPathReader m) => OsPath -> m OsPath
getXdgCache :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath -> m OsPath
getXdgCache = XdgDirectory -> OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
XdgDirectory -> OsPath -> m OsPath
getXdgDirectory XdgDirectory
XdgCache
{-# INLINEABLE getXdgCache #-}

-- | Retrieves the XDG state directory e.g. @~/.local\/state@.
--
-- @since 0.1
getXdgState :: (HasCallStack, MonadPathReader m) => OsPath -> m OsPath
getXdgState :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath -> m OsPath
getXdgState = XdgDirectory -> OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
XdgDirectory -> OsPath -> m OsPath
getXdgDirectory XdgDirectory
XdgState
{-# INLINEABLE getXdgState #-}

-- | Retrieves the recursive directory contents; splits the sub folders and
-- directories apart.
--
-- @since 0.1
listDirectoryRecursive ::
  forall m.
  ( HasCallStack,
    MonadPathReader m
  ) =>
  -- | Root path.
  OsPath ->
  -- | (files, directories)
  m ([OsPath], [OsPath])
listDirectoryRecursive :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath -> m ([OsPath], [OsPath])
listDirectoryRecursive OsPath
root = [OsPath] -> m ([OsPath], [OsPath])
recurseDirs [OsPath
emptyPath]
  where
    recurseDirs :: [OsPath] -> m ([OsPath], [OsPath])
    recurseDirs :: [OsPath] -> m ([OsPath], [OsPath])
recurseDirs [] = ([OsPath], [OsPath]) -> m ([OsPath], [OsPath])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
    recurseDirs (OsPath
d : [OsPath]
ds) = do
      ([OsPath]
files, [OsPath]
dirs) <- OsPath
-> OsPath
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> m ([OsPath], [OsPath])
forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath
-> OsPath
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> m ([OsPath], [OsPath])
splitPaths OsPath
root OsPath
d [] [] ([OsPath] -> m ([OsPath], [OsPath]))
-> m [OsPath] -> m ([OsPath], [OsPath])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< OsPath -> m [OsPath]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m [OsPath]
listDirectory (OsPath
root OsPath -> OsPath -> OsPath
</> OsPath
d)
      ([OsPath]
files', [OsPath]
dirs') <- [OsPath] -> m ([OsPath], [OsPath])
recurseDirs ([OsPath]
dirs [OsPath] -> [OsPath] -> [OsPath]
forall a. [a] -> [a] -> [a]
++ [OsPath]
ds)
      ([OsPath], [OsPath]) -> m ([OsPath], [OsPath])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OsPath]
files [OsPath] -> [OsPath] -> [OsPath]
forall a. [a] -> [a] -> [a]
++ [OsPath]
files', [OsPath]
dirs [OsPath] -> [OsPath] -> [OsPath]
forall a. [a] -> [a] -> [a]
++ [OsPath]
dirs')
    emptyPath :: OsPath
emptyPath = OsPath
forall a. Monoid a => a
mempty
{-# INLINEABLE listDirectoryRecursive #-}

splitPaths ::
  forall m.
  ( HasCallStack,
    MonadPathReader m
  ) =>
  OsPath ->
  OsPath ->
  [OsPath] ->
  [OsPath] ->
  [OsPath] ->
  m ([OsPath], [OsPath])
splitPaths :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath
-> OsPath
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> m ([OsPath], [OsPath])
splitPaths OsPath
root OsPath
d = [OsPath] -> [OsPath] -> [OsPath] -> m ([OsPath], [OsPath])
go
  where
    go :: [OsPath] -> [OsPath] -> [OsPath] -> m ([OsPath], [OsPath])
    go :: [OsPath] -> [OsPath] -> [OsPath] -> m ([OsPath], [OsPath])
go [OsPath]
files [OsPath]
dirs [] = ([OsPath], [OsPath]) -> m ([OsPath], [OsPath])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OsPath] -> [OsPath]
forall a. [a] -> [a]
reverse [OsPath]
files, [OsPath] -> [OsPath]
forall a. [a] -> [a]
reverse [OsPath]
dirs)
    go [OsPath]
files [OsPath]
dirs (OsPath
p : [OsPath]
ps) = do
      let dirEntry :: OsPath
dirEntry = OsPath
d OsPath -> OsPath -> OsPath
</> OsPath
p
      Bool
isDir <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist (OsPath
root OsPath -> OsPath -> OsPath
</> OsPath
dirEntry)
      if Bool
isDir
        then [OsPath] -> [OsPath] -> [OsPath] -> m ([OsPath], [OsPath])
go [OsPath]
files (OsPath
dirEntry OsPath -> [OsPath] -> [OsPath]
forall a. a -> [a] -> [a]
: [OsPath]
dirs) [OsPath]
ps
        else [OsPath] -> [OsPath] -> [OsPath] -> m ([OsPath], [OsPath])
go (OsPath
dirEntry OsPath -> [OsPath] -> [OsPath]
forall a. a -> [a] -> [a]
: [OsPath]
files) [OsPath]
dirs [OsPath]
ps
{-# INLINEABLE splitPaths #-}

-- | Like 'listDirectoryRecursive' except symbolic links are not traversed
-- i.e. they are returned separately.
--
-- @since 0.1
listDirectoryRecursiveSymbolicLink ::
  forall m.
  ( HasCallStack,
    MonadCatch m,
    MonadPathReader m
  ) =>
  -- | Root path.
  OsPath ->
  -- | (files, directories, symbolic links)
  m ([OsPath], [OsPath], [OsPath])
listDirectoryRecursiveSymbolicLink :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> m ([OsPath], [OsPath], [OsPath])
listDirectoryRecursiveSymbolicLink OsPath
root = [OsPath] -> m ([OsPath], [OsPath], [OsPath])
recurseDirs [OsPath
emptyPath]
  where
    recurseDirs :: [OsPath] -> m ([OsPath], [OsPath], [OsPath])
    recurseDirs :: [OsPath] -> m ([OsPath], [OsPath], [OsPath])
recurseDirs [] = ([OsPath], [OsPath], [OsPath]) -> m ([OsPath], [OsPath], [OsPath])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], [])
    recurseDirs (OsPath
d : [OsPath]
ds) = do
      ([OsPath]
files, [OsPath]
dirs, [OsPath]
symlinks) <-
        OsPath
-> OsPath
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> m ([OsPath], [OsPath], [OsPath])
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath
-> OsPath
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> m ([OsPath], [OsPath], [OsPath])
splitPathsSymboliclink OsPath
root OsPath
d [] [] [] ([OsPath] -> m ([OsPath], [OsPath], [OsPath]))
-> m [OsPath] -> m ([OsPath], [OsPath], [OsPath])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< OsPath -> m [OsPath]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m [OsPath]
listDirectory (OsPath
root OsPath -> OsPath -> OsPath
</> OsPath
d)
      ([OsPath]
files', [OsPath]
dirs', [OsPath]
symlinks') <- [OsPath] -> m ([OsPath], [OsPath], [OsPath])
recurseDirs ([OsPath]
dirs [OsPath] -> [OsPath] -> [OsPath]
forall a. [a] -> [a] -> [a]
++ [OsPath]
ds)
      ([OsPath], [OsPath], [OsPath]) -> m ([OsPath], [OsPath], [OsPath])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OsPath]
files [OsPath] -> [OsPath] -> [OsPath]
forall a. [a] -> [a] -> [a]
++ [OsPath]
files', [OsPath]
dirs [OsPath] -> [OsPath] -> [OsPath]
forall a. [a] -> [a] -> [a]
++ [OsPath]
dirs', [OsPath]
symlinks [OsPath] -> [OsPath] -> [OsPath]
forall a. [a] -> [a] -> [a]
++ [OsPath]
symlinks')
    emptyPath :: OsPath
emptyPath = OsPath
forall a. Monoid a => a
mempty
{-# INLINEABLE listDirectoryRecursiveSymbolicLink #-}

splitPathsSymboliclink ::
  forall m.
  ( HasCallStack,
    MonadCatch m,
    MonadPathReader m
  ) =>
  OsPath ->
  OsPath ->
  [OsPath] ->
  [OsPath] ->
  [OsPath] ->
  [OsPath] ->
  m ([OsPath], [OsPath], [OsPath])
splitPathsSymboliclink :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath
-> OsPath
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> m ([OsPath], [OsPath], [OsPath])
splitPathsSymboliclink OsPath
root OsPath
d = [OsPath]
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> m ([OsPath], [OsPath], [OsPath])
go
  where
    go :: [OsPath] -> [OsPath] -> [OsPath] -> [OsPath] -> m ([OsPath], [OsPath], [OsPath])
    go :: [OsPath]
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> m ([OsPath], [OsPath], [OsPath])
go [OsPath]
files [OsPath]
dirs [OsPath]
symlinks [] = ([OsPath], [OsPath], [OsPath]) -> m ([OsPath], [OsPath], [OsPath])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OsPath] -> [OsPath]
forall a. [a] -> [a]
reverse [OsPath]
files, [OsPath] -> [OsPath]
forall a. [a] -> [a]
reverse [OsPath]
dirs, [OsPath]
symlinks)
    go [OsPath]
files [OsPath]
dirs [OsPath]
symlinks (OsPath
p : [OsPath]
ps) = do
      let dirEntry :: OsPath
dirEntry = OsPath
d OsPath -> OsPath -> OsPath
</> OsPath
p
          fullPath :: OsPath
fullPath = OsPath
root OsPath -> OsPath -> OsPath
</> OsPath
dirEntry

      Bool
isSymlink <- OsPath -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> m Bool
doesSymbolicLinkExist OsPath
fullPath
      if Bool
isSymlink
        then [OsPath]
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> m ([OsPath], [OsPath], [OsPath])
go [OsPath]
files [OsPath]
dirs (OsPath
dirEntry OsPath -> [OsPath] -> [OsPath]
forall a. a -> [a] -> [a]
: [OsPath]
symlinks) [OsPath]
ps
        else do
          Bool
isDir <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist OsPath
fullPath
          if Bool
isDir
            then [OsPath]
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> m ([OsPath], [OsPath], [OsPath])
go [OsPath]
files (OsPath
dirEntry OsPath -> [OsPath] -> [OsPath]
forall a. a -> [a] -> [a]
: [OsPath]
dirs) [OsPath]
symlinks [OsPath]
ps
            else [OsPath]
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> m ([OsPath], [OsPath], [OsPath])
go (OsPath
dirEntry OsPath -> [OsPath] -> [OsPath]
forall a. a -> [a] -> [a]
: [OsPath]
files) [OsPath]
dirs [OsPath]
symlinks [OsPath]
ps
{-# INLINEABLE splitPathsSymboliclink #-}

{- ORMOLU_DISABLE -}

-- | Returns true if the path is a symbolic link. Does not traverse the link.
--
-- @since 0.1
doesSymbolicLinkExist ::
  ( HasCallStack,
    MonadCatch m,
    MonadPathReader m
  ) =>
  OsPath ->
  m Bool
doesSymbolicLinkExist :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> m Bool
doesSymbolicLinkExist OsPath
p =
  -- pathIsSymbolicLink throws an exception if the path does not exist,
  -- so we need to handle this. Note that the obvious alternative, prefacing
  -- the call with doesPathExist does not work, as that operates on the link
  -- target. doesFileExist also behaves this way.
  OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
pathIsSymbolicLink OsPath
p m Bool -> (IOError -> m Bool) -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (IOError -> m a) -> m a
`Ex.catchIOError` \IOError
_ -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
{-# INLINEABLE doesSymbolicLinkExist #-}

{- ORMOLU_ENABLE -}

-- | Like 'pathIsSymbolicDirectoryLink' but for files.
--
-- @since 0.1
pathIsSymbolicFileLink ::
  ( HasCallStack,
    MonadPathReader m
  ) =>
  OsPath ->
  m Bool
pathIsSymbolicFileLink :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath -> m Bool
pathIsSymbolicFileLink = OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m OsPath
getSymbolicLinkTarget (OsPath -> m OsPath) -> (OsPath -> m Bool) -> OsPath -> m Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesFileExist
{-# INLINEABLE pathIsSymbolicFileLink #-}

-- | Returns true if @p@ is a symbolic link and it points to an extant
-- directory. Throws an exception if the path is not a symbolic link or the
-- target does not exist.
--
-- This function and 'pathIsSymbolicFileLink' are intended to distinguish file
-- and directory links on Windows. This matters for knowing when to use:
--
--     - @createFileLink@ vs. @createDirectoryLink@
--     - @removeFile@ vs. @removeDirectoryLink@
--
-- Suppose we want to copy an arbitrary path @p@. We first determine that
-- @p@ is a symlink via 'doesSymbolicLinkExist'. If
-- 'pathIsSymbolicDirectoryLink' returns true then we know we should use
-- "Effects.FileSystem.PathWriter"'s @createDirectoryLink@. Otherwise we can
-- fall back to @createFileLink@.
--
-- Because this relies on the symlink's target, this is best effort, and it is
-- possible 'pathIsSymbolicDirectoryLink' and 'pathIsSymbolicFileLink' both
-- return false.
--
-- Note that Posix makes no distinction between file and directory symbolic
-- links. Thus if your system only has to work on Posix, you probably don't
-- need this function.
--
-- @since 0.1
pathIsSymbolicDirectoryLink ::
  ( HasCallStack,
    MonadPathReader m
  ) =>
  OsPath ->
  m Bool
pathIsSymbolicDirectoryLink :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath -> m Bool
pathIsSymbolicDirectoryLink = OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m OsPath
getSymbolicLinkTarget (OsPath -> m OsPath) -> (OsPath -> m Bool) -> OsPath -> m Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist
{-# INLINEABLE pathIsSymbolicDirectoryLink #-}

-- | Throws 'IOException' if the path does not exist or the expected path type
-- does not match actual.
--
-- For a faster version in terms of Posix(Compat), see effects-unix(-compat).
--
-- @since 0.1
throwIfWrongPathType ::
  ( HasCallStack,
    MonadCatch m,
    MonadPathReader m
  ) =>
  -- | The location for the thrown exception (e.g. function name)
  String ->
  -- | Expected path type
  PathType ->
  -- | Path
  OsPath ->
  m ()
throwIfWrongPathType :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
String -> PathType -> OsPath -> m ()
throwIfWrongPathType String
location PathType
expected OsPath
path = do
  PathType
actual <- OsPath -> m PathType
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> m PathType
getPathType OsPath
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
      OsPath
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.
--
-- For a faster version in terms of Posix(Compat), see effects-unix(-compat).
--
-- @since 0.1
isPathType ::
  ( HasCallStack,
    MonadCatch m,
    MonadPathReader m
  ) =>
  -- | Expected path type.
  PathType ->
  -- Path.
  OsPath ->
  m Bool
isPathType :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
PathType -> OsPath -> 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)
-> (OsPath -> m PathType) -> OsPath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m PathType
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> 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.
--
-- For a faster version in terms of PosixCompat, see effects-unix-compat.
--
-- @since 0.1
getPathType ::
  ( HasCallStack,
    MonadCatch m,
    MonadPathReader m
  ) =>
  OsPath ->
  m PathType
getPathType :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> m PathType
getPathType OsPath
path = do
  -- This needs to be first as does(Directory|File|Path)Exist acts on the target.
  Bool
symlinkExists <- OsPath -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> m Bool
doesSymbolicLinkExist OsPath
path
  if Bool
symlinkExists
    then PathType -> m PathType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PathType
PathTypeSymbolicLink
    else do
      Bool
dirExists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist OsPath
path
      if Bool
dirExists
        then PathType -> m PathType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PathType
PathTypeDirectory
        else do
          Bool
fileExists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesFileExist OsPath
path
          if Bool
fileExists
            then PathType -> m PathType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PathType
PathTypeFile
            else do
              Bool
pathExists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesPathExist OsPath
path
              if Bool
pathExists
                then PathType -> m PathType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PathType
PathTypeOther
                else
                  OsPath -> String -> IOErrorType -> String -> m PathType
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
OsPath -> String -> IOErrorType -> String -> m a
FS.IO.throwPathIOError
                    OsPath
path
                    String
"getPathType"
                    IOErrorType
IO.Error.doesNotExistErrorType
                    String
"path does not exist"
{-# INLINEABLE getPathType #-}