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

-- | Provides a static effect for the readable portion of "System.Directory"'s
-- interface. For the static interface of the entire "System.Directory"
-- interface, see
-- https://hackage.haskell.org/package/effectful-2.2.2.0/docs/Effectful-FileSystem.html.
--
-- @since 0.1
module Effectful.FileSystem.PathReader.Static
  ( -- * Effect
    PathReader,

    -- ** Functions
    listDirectory,
    getDirectoryContents,
    getCurrentDirectory,
    getHomeDirectory,
    getXdgDirectory,
    getXdgDirectoryList,
    getAppUserDataDirectory,
    getUserDocumentsDirectory,
    getTemporaryDirectory,
    getFileSize,
    canonicalizePath,
    makeAbsolute,
    makeRelativeToCurrentDirectory,
    doesPathExist,
    doesFileExist,
    doesDirectoryExist,
    findExecutable,
    findExecutables,
    findExecutablesInDirectories,
    findFileWith,
    findFilesWith,
    pathIsSymbolicLink,
    getSymbolicLinkTarget,
    getPermissions,
    getAccessTime,
    getModificationTime,

    -- ** Handlers
    runPathReader,

    -- * Functions
    findFile,
    findFiles,

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

    -- * Path Types
    PathType (..),

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

    -- * Tilde expansion
    expandTilde,
    forExpandedTilde,
    onExpandedTilde,

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

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

import Control.Category ((>>>))
import Control.Monad (unless, (>=>))
import Data.Time (UTCTime (UTCTime, utctDay, utctDayTime))
import Effectful
  ( Dispatch (Static),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    type (:>),
  )
import Effectful.Dispatch.Static
  ( HasCallStack,
    SideEffects (WithSideEffects),
    StaticRep,
    evalStaticRep,
    seqUnliftIO,
    unsafeEff,
    unsafeEff_,
  )
import Effectful.Exception (catchIO)
import FileSystem.IO qualified as IO
import FileSystem.OsPath
  ( OsPath,
    OsPathOrEmpty (OsPathEmpty, OsPathNonEmpty),
    TildePrefixState
      ( TildePrefixStateNone,
        TildePrefixStateStripped
      ),
    (</>),
  )
import FileSystem.OsPath qualified as OsP
import FileSystem.PathType
  ( PathType
      ( PathTypeDirectory,
        PathTypeFile,
        PathTypeOther,
        PathTypeSymbolicLink
      ),
  )
import FileSystem.PathType qualified as PathType
import GHC.IO.Exception (IOErrorType (InappropriateType))
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

-- | Static effect for reading paths.
--
-- @since 0.1
data PathReader :: Effect

type instance DispatchOf PathReader = Static WithSideEffects

data instance StaticRep PathReader = MkPathReader

-- | Runs an 'PathReader' effect in IO.
--
-- @since 0.1
runPathReader ::
  ( HasCallStack,
    IOE :> es
  ) =>
  Eff (PathReader : es) a ->
  Eff es a
runPathReader :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
Eff (PathReader : es) a -> Eff es a
runPathReader = StaticRep PathReader -> Eff (PathReader : 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 PathReader
MkPathReader

-- | 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,
    PathReader :> es
  ) =>
  [OsPath] ->
  OsPath ->
  Eff es (Maybe OsPath)
findFile :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
[OsPath] -> OsPath -> Eff es (Maybe OsPath)
findFile = (OsPath -> Eff es Bool)
-> [OsPath] -> OsPath -> Eff es (Maybe OsPath)
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
(OsPath -> Eff es Bool)
-> [OsPath] -> OsPath -> Eff es (Maybe OsPath)
findFileWith (\OsPath
_ -> Bool -> Eff es Bool
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)

-- | 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,
    PathReader :> es
  ) =>
  [OsPath] ->
  OsPath ->
  Eff es [OsPath]
findFiles :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
[OsPath] -> OsPath -> Eff es [OsPath]
findFiles = (OsPath -> Eff es Bool) -> [OsPath] -> OsPath -> Eff es [OsPath]
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
(OsPath -> Eff es Bool) -> [OsPath] -> OsPath -> Eff es [OsPath]
findFilesWith (\OsPath
_ -> Bool -> Eff es Bool
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)

-- | Lifted 'Dir.listDirectory'.
--
-- @since 0.1
listDirectory ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es [OsPath]
listDirectory :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es [OsPath]
listDirectory = IO [OsPath] -> Eff es [OsPath]
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO [OsPath] -> Eff es [OsPath])
-> (OsPath -> IO [OsPath]) -> OsPath -> Eff es [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO [OsPath]
Dir.listDirectory

-- | Lifted 'Dir.getDirectoryContents'.
--
-- @since 0.1
getDirectoryContents ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es [OsPath]
getDirectoryContents :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es [OsPath]
getDirectoryContents = IO [OsPath] -> Eff es [OsPath]
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO [OsPath] -> Eff es [OsPath])
-> (OsPath -> IO [OsPath]) -> OsPath -> Eff es [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO [OsPath]
Dir.getDirectoryContents

-- | Lifted 'Dir.getCurrentDirectory'.
--
-- @since 0.1
getCurrentDirectory ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  Eff es OsPath
getCurrentDirectory :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
Eff es OsPath
getCurrentDirectory = IO OsPath -> Eff es OsPath
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO OsPath
Dir.getCurrentDirectory

-- | Lifted 'Dir.getHomeDirectory'.
--
-- @since 0.1
getHomeDirectory ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  Eff es OsPath
getHomeDirectory :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
Eff es OsPath
getHomeDirectory = IO OsPath -> Eff es OsPath
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO OsPath
Dir.getHomeDirectory

-- | Lifted 'Dir.getXdgDirectory'.
--
-- @since 0.1
getXdgDirectory ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  XdgDirectory ->
  OsPath ->
  Eff es OsPath
getXdgDirectory :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
XdgDirectory -> OsPath -> Eff es OsPath
getXdgDirectory XdgDirectory
xdg = IO OsPath -> Eff es OsPath
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO OsPath -> Eff es OsPath)
-> (OsPath -> IO OsPath) -> OsPath -> Eff es OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XdgDirectory -> OsPath -> IO OsPath
Dir.getXdgDirectory XdgDirectory
xdg

-- | Lifted 'Dir.getXdgDirectoryList'.
--
-- @since 0.1
getXdgDirectoryList ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  XdgDirectoryList ->
  Eff es [OsPath]
getXdgDirectoryList :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
XdgDirectoryList -> Eff es [OsPath]
getXdgDirectoryList = IO [OsPath] -> Eff es [OsPath]
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO [OsPath] -> Eff es [OsPath])
-> (XdgDirectoryList -> IO [OsPath])
-> XdgDirectoryList
-> Eff es [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XdgDirectoryList -> IO [OsPath]
Dir.getXdgDirectoryList

-- | Lifted 'Dir.getAppUserDataDirectory'.
--
-- @since 0.1
getAppUserDataDirectory ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es OsPath
getAppUserDataDirectory :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es OsPath
getAppUserDataDirectory = IO OsPath -> Eff es OsPath
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO OsPath -> Eff es OsPath)
-> (OsPath -> IO OsPath) -> OsPath -> Eff es OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO OsPath
Dir.getAppUserDataDirectory

-- | Lifted 'Dir.getUserDocumentsDirectory'.
--
-- @since 0.1
getUserDocumentsDirectory ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  Eff es OsPath
getUserDocumentsDirectory :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
Eff es OsPath
getUserDocumentsDirectory = IO OsPath -> Eff es OsPath
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO OsPath
Dir.getUserDocumentsDirectory

-- | Lifted 'Dir.getTemporaryDirectory'.
--
-- @since 0.1
getTemporaryDirectory ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  Eff es OsPath
getTemporaryDirectory :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
Eff es OsPath
getTemporaryDirectory = IO OsPath -> Eff es OsPath
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO OsPath
Dir.getTemporaryDirectory

-- | Lifted 'Dir.getFileSize'.
--
-- @since 0.1
getFileSize ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es Integer
getFileSize :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Integer
getFileSize = IO Integer -> Eff es Integer
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Integer -> Eff es Integer)
-> (OsPath -> IO Integer) -> OsPath -> Eff es Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO Integer
Dir.getFileSize

-- | Lifted 'Dir.canonicalizePath'.
--
-- @since 0.1
canonicalizePath ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es OsPath
canonicalizePath :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es OsPath
canonicalizePath = IO OsPath -> Eff es OsPath
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO OsPath -> Eff es OsPath)
-> (OsPath -> IO OsPath) -> OsPath -> Eff es OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO OsPath
Dir.canonicalizePath

-- | Lifted 'Dir.makeAbsolute'.
--
-- @since 0.1
makeAbsolute ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es OsPath
makeAbsolute :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es OsPath
makeAbsolute = IO OsPath -> Eff es OsPath
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO OsPath -> Eff es OsPath)
-> (OsPath -> IO OsPath) -> OsPath -> Eff es OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO OsPath
Dir.makeAbsolute

-- | Lifted 'Dir.makeRelativeToCurrentDirectory'.
--
-- @since 0.1
makeRelativeToCurrentDirectory ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es OsPath
makeRelativeToCurrentDirectory :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es OsPath
makeRelativeToCurrentDirectory = IO OsPath -> Eff es OsPath
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO OsPath -> Eff es OsPath)
-> (OsPath -> IO OsPath) -> OsPath -> Eff es OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO OsPath
Dir.makeRelativeToCurrentDirectory

-- | Lifted 'Dir.doesPathExist'.
--
-- @since 0.1
doesPathExist ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es Bool
doesPathExist :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
doesPathExist = IO Bool -> Eff es Bool
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Bool -> Eff es Bool)
-> (OsPath -> IO Bool) -> OsPath -> Eff es Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO Bool
Dir.doesPathExist

-- | Lifted 'Dir.doesFileExist'.
--
-- @since 0.1
doesFileExist ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es Bool
doesFileExist :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
doesFileExist = IO Bool -> Eff es Bool
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Bool -> Eff es Bool)
-> (OsPath -> IO Bool) -> OsPath -> Eff es Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO Bool
Dir.doesFileExist

-- | Lifted 'Dir.doesDirectoryExist'.
--
-- @since 0.1
doesDirectoryExist ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es Bool
doesDirectoryExist :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
doesDirectoryExist = IO Bool -> Eff es Bool
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Bool -> Eff es Bool)
-> (OsPath -> IO Bool) -> OsPath -> Eff es Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO Bool
Dir.doesDirectoryExist

-- | Lifted 'Dir.findExecutable'.
--
-- @since 0.1
findExecutable ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es (Maybe OsPath)
findExecutable :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es (Maybe OsPath)
findExecutable = IO (Maybe OsPath) -> Eff es (Maybe OsPath)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Maybe OsPath) -> Eff es (Maybe OsPath))
-> (OsPath -> IO (Maybe OsPath)) -> OsPath -> Eff es (Maybe OsPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO (Maybe OsPath)
Dir.findExecutable

-- | Lifted 'Dir.findExecutables'.
--
-- @since 0.1
findExecutables ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es [OsPath]
findExecutables :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es [OsPath]
findExecutables = IO [OsPath] -> Eff es [OsPath]
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO [OsPath] -> Eff es [OsPath])
-> (OsPath -> IO [OsPath]) -> OsPath -> Eff es [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO [OsPath]
Dir.findExecutables

-- | Lifted 'Dir.findExecutablesInDirectories'.
--
-- @since 0.1
findExecutablesInDirectories ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  [OsPath] ->
  OsPath ->
  Eff es [OsPath]
findExecutablesInDirectories :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
[OsPath] -> OsPath -> Eff es [OsPath]
findExecutablesInDirectories [OsPath]
ps =
  IO [OsPath] -> Eff es [OsPath]
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO [OsPath] -> Eff es [OsPath])
-> (OsPath -> IO [OsPath]) -> OsPath -> Eff es [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OsPath] -> OsPath -> IO [OsPath]
Dir.findExecutablesInDirectories [OsPath]
ps

-- | Lifted 'Dir.findFileWith'.
--
-- @since 0.1
findFileWith ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  (OsPath -> Eff es Bool) ->
  [OsPath] ->
  OsPath ->
  Eff es (Maybe OsPath)
findFileWith :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
(OsPath -> Eff es Bool)
-> [OsPath] -> OsPath -> Eff es (Maybe OsPath)
findFileWith OsPath -> Eff es Bool
f [OsPath]
ps OsPath
s =
  (Env es -> IO (Maybe OsPath)) -> Eff es (Maybe OsPath)
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO (Maybe OsPath)) -> Eff es (Maybe OsPath))
-> (Env es -> IO (Maybe OsPath)) -> Eff es (Maybe OsPath)
forall a b. (a -> b) -> a -> b
$ \Env es
env -> Env es
-> ((forall r. Eff es r -> IO r) -> IO (Maybe OsPath))
-> IO (Maybe OsPath)
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
env (((forall r. Eff es r -> IO r) -> IO (Maybe OsPath))
 -> IO (Maybe OsPath))
-> ((forall r. Eff es r -> IO r) -> IO (Maybe OsPath))
-> IO (Maybe OsPath)
forall a b. (a -> b) -> a -> b
$
    \forall r. Eff es r -> IO r
runInIO -> (OsPath -> IO Bool) -> [OsPath] -> OsPath -> IO (Maybe OsPath)
Dir.findFileWith (Eff es Bool -> IO Bool
forall r. Eff es r -> IO r
runInIO (Eff es Bool -> IO Bool)
-> (OsPath -> Eff es Bool) -> OsPath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Eff es Bool
f) [OsPath]
ps OsPath
s

-- | Lifted 'Dir.findFilesWith'.
--
-- @since 0.1
findFilesWith ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  (OsPath -> Eff es Bool) ->
  [OsPath] ->
  OsPath ->
  Eff es [OsPath]
findFilesWith :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
(OsPath -> Eff es Bool) -> [OsPath] -> OsPath -> Eff es [OsPath]
findFilesWith OsPath -> Eff es Bool
f [OsPath]
ps OsPath
s =
  (Env es -> IO [OsPath]) -> Eff es [OsPath]
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO [OsPath]) -> Eff es [OsPath])
-> (Env es -> IO [OsPath]) -> Eff es [OsPath]
forall a b. (a -> b) -> a -> b
$ \Env es
env -> Env es
-> ((forall r. Eff es r -> IO r) -> IO [OsPath]) -> IO [OsPath]
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
env (((forall r. Eff es r -> IO r) -> IO [OsPath]) -> IO [OsPath])
-> ((forall r. Eff es r -> IO r) -> IO [OsPath]) -> IO [OsPath]
forall a b. (a -> b) -> a -> b
$
    \forall r. Eff es r -> IO r
runInIO -> (OsPath -> IO Bool) -> [OsPath] -> OsPath -> IO [OsPath]
Dir.findFilesWith (Eff es Bool -> IO Bool
forall r. Eff es r -> IO r
runInIO (Eff es Bool -> IO Bool)
-> (OsPath -> Eff es Bool) -> OsPath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Eff es Bool
f) [OsPath]
ps OsPath
s

-- | Lifted 'Dir.pathIsSymbolicLink'.
--
-- @since 0.1
pathIsSymbolicLink ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es Bool
pathIsSymbolicLink :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
pathIsSymbolicLink = IO Bool -> Eff es Bool
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Bool -> Eff es Bool)
-> (OsPath -> IO Bool) -> OsPath -> Eff es Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO Bool
Dir.pathIsSymbolicLink

-- | Lifted 'Dir.getSymbolicLinkTarget'.
--
-- @since 0.1
getSymbolicLinkTarget ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es OsPath
getSymbolicLinkTarget :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es OsPath
getSymbolicLinkTarget = IO OsPath -> Eff es OsPath
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO OsPath -> Eff es OsPath)
-> (OsPath -> IO OsPath) -> OsPath -> Eff es OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO OsPath
Dir.getSymbolicLinkTarget

-- | Lifted 'Dir.getPermissions'.
--
-- @since 0.1
getPermissions ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es Permissions
getPermissions :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Permissions
getPermissions = IO Permissions -> Eff es Permissions
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Permissions -> Eff es Permissions)
-> (OsPath -> IO Permissions) -> OsPath -> Eff es Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO Permissions
Dir.getPermissions

-- | Lifted 'Dir.getAccessTime'.
--
-- @since 0.1
getAccessTime ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es UTCTime
getAccessTime :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es UTCTime
getAccessTime = IO UTCTime -> Eff es UTCTime
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO UTCTime -> Eff es UTCTime)
-> (OsPath -> IO UTCTime) -> OsPath -> Eff es UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO UTCTime
Dir.getAccessTime

-- | Lifted 'Dir.getModificationTime'.
--
-- @since 0.1
getModificationTime ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es UTCTime
getModificationTime :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es UTCTime
getModificationTime = IO UTCTime -> Eff es UTCTime
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO UTCTime -> Eff es UTCTime)
-> (OsPath -> IO UTCTime) -> OsPath -> Eff es UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO UTCTime
Dir.getModificationTime

-- | Retrieves the XDG data directory e.g. @~/.local\/share@.
--
-- @since 0.1
getXdgData ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es OsPath
getXdgData :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es OsPath
getXdgData = XdgDirectory -> OsPath -> Eff es OsPath
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
XdgDirectory -> OsPath -> Eff es OsPath
getXdgDirectory XdgDirectory
XdgData

-- | Retrieves the XDG config directory e.g. @~/.config@.
--
-- @since 0.1
getXdgConfig ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es OsPath
getXdgConfig :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es OsPath
getXdgConfig = XdgDirectory -> OsPath -> Eff es OsPath
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
XdgDirectory -> OsPath -> Eff es OsPath
getXdgDirectory XdgDirectory
XdgConfig

-- | Retrieves the XDG cache directory e.g. @~/.cache@.
--
-- @since 0.1
getXdgCache ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es OsPath
getXdgCache :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es OsPath
getXdgCache = XdgDirectory -> OsPath -> Eff es OsPath
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
XdgDirectory -> OsPath -> Eff es OsPath
getXdgDirectory XdgDirectory
XdgCache

-- | Retrieves the XDG state directory e.g. @~/.local\/state@.
--
-- @since 0.1
getXdgState ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es OsPath
getXdgState :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es OsPath
getXdgState = XdgDirectory -> OsPath -> Eff es OsPath
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
XdgDirectory -> OsPath -> Eff es OsPath
getXdgDirectory XdgDirectory
XdgState

-- | Returns true if the path is a symbolic link. Does not traverse the link.
--
-- @since 0.1
doesSymbolicLinkExist ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es Bool
doesSymbolicLinkExist :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es 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 -> Eff es Bool
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
pathIsSymbolicLink OsPath
p Eff es Bool -> (IOException -> Eff es Bool) -> Eff es Bool
forall (es :: [Effect]) a.
Eff es a -> (IOException -> Eff es a) -> Eff es a
`catchIO` \IOException
_ -> Bool -> Eff es Bool
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

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

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

splitPaths ::
  forall es.
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  OsPath ->
  [OsPath] ->
  [OsPath] ->
  [OsPath] ->
  Eff es ([OsPath], [OsPath])
splitPaths :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath
-> OsPath
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> Eff es ([OsPath], [OsPath])
splitPaths OsPath
root OsPath
d = [OsPath] -> [OsPath] -> [OsPath] -> Eff es ([OsPath], [OsPath])
go
  where
    go :: [OsPath] -> [OsPath] -> [OsPath] -> Eff es ([OsPath], [OsPath])
    go :: [OsPath] -> [OsPath] -> [OsPath] -> Eff es ([OsPath], [OsPath])
go [OsPath]
files [OsPath]
dirs [] = ([OsPath], [OsPath]) -> Eff es ([OsPath], [OsPath])
forall a. a -> Eff es 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
      isDir <- OsPath -> Eff es Bool
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
doesDirectoryExist (OsPath
root OsPath -> OsPath -> OsPath
</> OsPath
dirEntry)
      if isDir
        then go files (dirEntry : dirs) ps
        else go (dirEntry : files) dirs ps

splitPathsSymboliclink ::
  forall es.
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  OsPath ->
  [OsPath] ->
  [OsPath] ->
  [OsPath] ->
  [OsPath] ->
  Eff es ([OsPath], [OsPath], [OsPath])
splitPathsSymboliclink :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath
-> OsPath
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> Eff es ([OsPath], [OsPath], [OsPath])
splitPathsSymboliclink OsPath
root OsPath
d = [OsPath]
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> Eff es ([OsPath], [OsPath], [OsPath])
go
  where
    go :: [OsPath] -> [OsPath] -> [OsPath] -> [OsPath] -> Eff es ([OsPath], [OsPath], [OsPath])
    go :: [OsPath]
-> [OsPath]
-> [OsPath]
-> [OsPath]
-> Eff es ([OsPath], [OsPath], [OsPath])
go [OsPath]
files [OsPath]
dirs [OsPath]
symlinks [] = ([OsPath], [OsPath], [OsPath])
-> Eff es ([OsPath], [OsPath], [OsPath])
forall a. a -> Eff es 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

      isSymlink <- OsPath -> Eff es Bool
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
doesSymbolicLinkExist OsPath
fullPath
      if isSymlink
        then go files dirs (dirEntry : symlinks) ps
        else do
          isDir <- doesDirectoryExist fullPath
          if isDir
            then go files (dirEntry : dirs) symlinks ps
            else go (dirEntry : files) dirs symlinks ps

-- | Like 'pathIsSymbolicDirectoryLink' but for files.
--
-- @since 0.1
pathIsSymbolicFileLink ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es Bool
pathIsSymbolicFileLink :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
pathIsSymbolicFileLink = OsPath -> Eff es OsPath
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es OsPath
getSymbolicLinkTarget (OsPath -> Eff es OsPath)
-> (OsPath -> Eff es Bool) -> OsPath -> Eff es Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> OsPath -> Eff es Bool
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
doesFileExist

-- | 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,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es Bool
pathIsSymbolicDirectoryLink :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
pathIsSymbolicDirectoryLink = OsPath -> Eff es OsPath
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es OsPath
getSymbolicLinkTarget (OsPath -> Eff es OsPath)
-> (OsPath -> Eff es Bool) -> OsPath -> Eff es Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> OsPath -> Eff es Bool
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
doesDirectoryExist

-- | Throws 'IOException' if the path does not exist or the expected path type
-- does not match actual.
--
-- @since 0.1
throwIfWrongPathType ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  -- | The location for the thrown exception (e.g. function name)
  String ->
  -- | Expected path type
  PathType ->
  -- | Path
  OsPath ->
  Eff es ()
throwIfWrongPathType :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
String -> PathType -> OsPath -> Eff es ()
throwIfWrongPathType String
location PathType
expected OsPath
path = do
  actual <- OsPath -> Eff es PathType
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es PathType
getPathType OsPath
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
PathType.displayPathType PathType
expected,
            String
", but detected ",
            PathType -> String
forall a. IsString a => PathType -> a
PathType.displayPathType PathType
actual
          ]

  unless (expected == actual) $
    IO.throwPathIOError
      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,
    PathReader :> es
  ) =>
  -- | Expected path type.
  PathType ->
  -- Path.
  OsPath ->
  Eff es Bool
isPathType :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
PathType -> OsPath -> 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)
-> (OsPath -> Eff es PathType) -> OsPath -> Eff es Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Eff es PathType
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> 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,
    PathReader :> es
  ) =>
  OsPath ->
  Eff es PathType
getPathType :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es PathType
getPathType OsPath
path = do
  -- This needs to be first as does(Directory|File|Path)Exist acts on the target.
  symlinkExists <- OsPath -> Eff es Bool
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
doesSymbolicLinkExist OsPath
path
  if symlinkExists
    then pure PathTypeSymbolicLink
    else do
      dirExists <- doesDirectoryExist path
      if dirExists
        then pure PathTypeDirectory
        else do
          fileExists <- doesFileExist path
          if fileExists
            then pure PathTypeFile
            else do
              pathExists <- doesPathExist path
              if pathExists
                then pure PathTypeOther
                else
                  IO.throwPathIOError
                    path
                    "getPathType"
                    IO.Error.doesNotExistErrorType
                    "path does not exist"

-- | 'onExpandedTilde' that simply returns the expanded path.
--
-- @since 0.1
expandTilde ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  -- | Path to potentially expand.
  OsPath ->
  Eff es OsPath
expandTilde :: forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es OsPath
expandTilde = (OsPath -> Eff es OsPath) -> OsPath -> Eff es OsPath
forall (es :: [Effect]) a.
(HasCallStack, PathReader :> es) =>
(OsPath -> Eff es a) -> OsPath -> Eff es a
onExpandedTilde OsPath -> Eff es OsPath
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Flipped 'onExpandedTilde'.
--
-- @since 0.1
forExpandedTilde ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  -- | Path to potentially expand.
  OsPath ->
  -- | Action to run on the expanded path.
  (OsPath -> Eff es a) ->
  Eff es a
forExpandedTilde :: forall (es :: [Effect]) a.
(HasCallStack, PathReader :> es) =>
OsPath -> (OsPath -> Eff es a) -> Eff es a
forExpandedTilde = ((OsPath -> Eff es a) -> OsPath -> Eff es a)
-> OsPath -> (OsPath -> Eff es a) -> Eff es a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (OsPath -> Eff es a) -> OsPath -> Eff es a
forall (es :: [Effect]) a.
(HasCallStack, PathReader :> es) =>
(OsPath -> Eff es a) -> OsPath -> Eff es a
onExpandedTilde

-- | Expands a "tilde prefix" (~) with the home directory, running the
-- action on the result. Throws an exception if the 'OsPath' contains any
-- other tildes i.e. the only expansions we allow are:
--
-- - @"~/..."@
-- - @"~"@
-- - @"~\\..."@ (windows only)
--
-- If the path contains no tildes, it is handled normally.
--
-- @since 0.1
onExpandedTilde ::
  ( HasCallStack,
    PathReader :> es
  ) =>
  -- | Action to run on the expanded path.
  (OsPath -> Eff es a) ->
  -- | Path to potentially expand.
  OsPath ->
  Eff es a
onExpandedTilde :: forall (es :: [Effect]) a.
(HasCallStack, PathReader :> es) =>
(OsPath -> Eff es a) -> OsPath -> Eff es a
onExpandedTilde OsPath -> Eff es a
onPath =
  OsPath -> TildePrefixState
OsP.toTildePrefixState (OsPath -> TildePrefixState)
-> (TildePrefixState -> Eff es a) -> OsPath -> Eff es a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    TildePrefixStateNone OsPath
p -> OsPath -> Eff es a
onPath OsPath
p
    TildePrefixStateStripped OsPathOrEmpty
pne ->
      Eff es OsPath
forall (es :: [Effect]).
(HasCallStack, PathReader :> es) =>
Eff es OsPath
getHomeDirectory Eff es OsPath -> (OsPath -> Eff es a) -> Eff es a
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \OsPath
d -> case OsPathOrEmpty
pne of
        OsPathOrEmpty
OsPathEmpty -> OsPath -> Eff es a
onPath OsPath
d
        OsPathNonEmpty OsPath
p -> OsPath -> Eff es a
onPath (OsPath -> Eff es a) -> OsPath -> Eff es a
forall a b. (a -> b) -> a -> b
$ OsPath
d OsPath -> OsPath -> OsPath
</> OsPath
p