{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE DataKinds  #-}
{-# LANGUAGE MultiWayIf  #-}
{-# LANGUAGE CApiFFI #-}

{-|
Module      : GHCup.Utils.File.Posix
Description : File and directory handling for unix
Copyright   : (c) Julian Ospald, 2020
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : POSIX
-}
module GHCup.Prelude.File.Posix where

import           GHCup.Prelude.File.Posix.Traversals

import           Control.Exception.Safe
import           Control.Monad.Reader
import           Foreign.C.String
import           Foreign.C.Error
import           Foreign.C.Types
import           System.IO                      ( hClose, hSetBinaryMode )
import           System.IO.Error      hiding    ( catchIOError )
import           System.FilePath
import           System.Directory               ( removeFile, pathIsSymbolicLink, getSymbolicLinkTarget, doesPathExist )
import           System.Posix.Directory
import           System.Posix.Error             ( throwErrnoPathIfMinus1Retry )
import           System.Posix.Internals         ( withFilePath )
import           System.Posix.Files
import           System.Posix.Types


import qualified System.Posix.Directory        as PD
import qualified System.Posix.Files            as PF
import qualified System.Posix.IO               as SPI
import qualified System.Posix as Posix
import qualified Streamly.FileSystem.Handle    as FH
import qualified Streamly.Internal.FileSystem.Handle
                                               as IFH
import qualified Streamly.Prelude              as S
import qualified GHCup.Prelude.File.Posix.Foreign as FD
import qualified Streamly.Internal.Data.Stream.StreamD.Type
                                               as D
import           Streamly.Internal.Data.Unfold.Type
import qualified Streamly.Internal.Data.Unfold as U
import           Streamly.Internal.Control.Concurrent ( withRunInIO )
import           Streamly.Internal.Data.IOFinalizer   ( newIOFinalizer, runIOFinalizer )
import GHC.IO.Exception (IOException(ioe_type), IOErrorType (..))


-- | On unix, we can use symlinks, so we just get the
-- symbolic link target.
--
-- On windows, we have to emulate symlinks via shims,
-- see 'createLink'.
getLinkTarget :: FilePath -> IO FilePath
getLinkTarget :: FilePath -> IO FilePath
getLinkTarget = FilePath -> IO FilePath
getSymbolicLinkTarget


-- | Checks whether the path is a link.
pathIsLink :: FilePath -> IO Bool
pathIsLink :: FilePath -> IO Bool
pathIsLink = FilePath -> IO Bool
pathIsSymbolicLink


chmod_755 :: MonadIO m => FilePath -> m ()
chmod_755 :: forall (m :: * -> *). MonadIO m => FilePath -> m ()
chmod_755 FilePath
fp = do
  let exe_mode :: FileMode
exe_mode =
          FileMode
nullFileMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
ownerExecuteMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
ownerReadMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
ownerWriteMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
groupExecuteMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
groupReadMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
otherExecuteMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
otherReadMode
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> FileMode -> IO ()
setFileMode FilePath
fp FileMode
exe_mode


-- |Default permissions for a new file.
newFilePerms :: FileMode
newFilePerms :: FileMode
newFilePerms =
  FileMode
ownerWriteMode
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
ownerReadMode
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
groupWriteMode
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
groupReadMode
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
otherWriteMode
    FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
otherReadMode


-- | Checks whether the binary is a broken link.
isBrokenSymlink :: FilePath -> IO Bool
isBrokenSymlink :: FilePath -> IO Bool
isBrokenSymlink FilePath
fp = do
  forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (FilePath -> IO Bool
pathIsSymbolicLink FilePath
fp) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right Bool
True -> do
      let symDir :: FilePath
symDir = FilePath -> FilePath
takeDirectory FilePath
fp
      FilePath
tfp <- FilePath -> IO FilePath
getSymbolicLinkTarget FilePath
fp
      Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesPathExist
        -- this drops 'symDir' if 'tfp' is absolute
        (FilePath
symDir FilePath -> FilePath -> FilePath
</> FilePath
tfp)
    Right Bool
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
    Left IOException
e | IOException -> Bool
isDoesNotExistError IOException
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
           | Bool
otherwise -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO IOException
e

copyFile :: FilePath   -- ^ source file
         -> FilePath   -- ^ destination file
         -> Bool       -- ^ fail if file exists
         -> IO ()
copyFile :: FilePath -> FilePath -> Bool -> IO ()
copyFile FilePath
from FilePath
to Bool
fail' = do
  forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    (FilePath
-> OpenMode -> [Flags] -> Maybe FileMode -> IO (Fd, Handle)
openFdHandle FilePath
from OpenMode
SPI.ReadOnly [Flags
FD.oNofollow] forall a. Maybe a
Nothing)
    (Handle -> IO ()
hClose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
    forall a b. (a -> b) -> a -> b
$ \(Fd
fromFd, Handle
fH) -> do
        FileMode
sourceFileMode <- FileStatus -> FileMode
fileMode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fd -> IO FileStatus
getFdStatus Fd
fromFd
        let dflags :: [Flags]
dflags = [ Flags
FD.oNofollow
                     , if Bool
fail' then Flags
FD.oExcl else Flags
FD.oTrunc
                     ]
        let openFdHandle' :: IO (Fd, Handle)
openFdHandle' = FilePath
-> OpenMode -> [Flags] -> Maybe FileMode -> IO (Fd, Handle)
openFdHandle FilePath
to OpenMode
SPI.WriteOnly [Flags]
dflags forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just FileMode
sourceFileMode
        forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
          (forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> if
                              -- if we copy from regular file to symlink, we need
                              -- to delete the symlink
                              | IOException -> IOErrorType
ioe_type IOException
e forall a. Eq a => a -> a -> Bool
== IOErrorType
InvalidArgument
                              , Bool -> Bool
not Bool
fail' -> do
                                 FilePath -> IO ()
removeLink FilePath
to
                                 IO (Fd, Handle)
openFdHandle'
                              | Bool
otherwise -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO IOException
e
                    )
            IO (Fd, Handle)
openFdHandle')
          (Handle -> IO ()
hClose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
          forall a b. (a -> b) -> a -> b
$ \(Fd
_, Handle
tH) -> do
              Handle -> Bool -> IO ()
hSetBinaryMode Handle
fH Bool
True
              Handle -> Bool -> IO ()
hSetBinaryMode Handle
tH Bool
True
              forall {m :: * -> *}. MonadIO m => (Handle, Handle) -> m ()
streamlyCopy (Handle
fH, Handle
tH)
 where
  openFdHandle :: FilePath
-> OpenMode -> [Flags] -> Maybe FileMode -> IO (Fd, Handle)
openFdHandle FilePath
fp OpenMode
omode [Flags]
flags Maybe FileMode
fM = do
    Fd
fd      <- FilePath -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd' FilePath
fp OpenMode
omode [Flags]
flags Maybe FileMode
fM
    Handle
handle' <- Fd -> IO Handle
SPI.fdToHandle Fd
fd
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fd
fd, Handle
handle')
  streamlyCopy :: (Handle, Handle) -> m ()
streamlyCopy (Handle
fH, Handle
tH) =
    forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> SerialT m a -> m b
S.fold (forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Handle -> Fold m (Array a) ()
FH.writeChunks Handle
tH) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadIO m) =>
Int -> Handle -> t m (Array Word8)
IFH.toChunksWithBufferOf (Int
256 forall a. Num a => a -> a -> a
* Int
1024) Handle
fH

foreign import capi unsafe "fcntl.h open"
   c_open :: CString -> CInt -> Posix.CMode -> IO CInt


open_  :: CString
       -> Posix.OpenMode
       -> [FD.Flags]
       -> Maybe Posix.FileMode
       -> IO Posix.Fd
open_ :: CString -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
open_ CString
str OpenMode
how [Flags]
optional_flags Maybe FileMode
maybe_mode = do
    CInt
fd <- CString -> CInt -> FileMode -> IO CInt
c_open CString
str CInt
all_flags FileMode
mode_w
    forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Fd
Posix.Fd CInt
fd)
  where
    all_flags :: CInt
all_flags  = [Flags] -> CInt
FD.unionFlags forall a b. (a -> b) -> a -> b
$ [Flags]
optional_flags forall a. [a] -> [a] -> [a]
++ [Flags
open_mode] forall a. [a] -> [a] -> [a]
++ [Flags]
creat


    ([Flags]
creat, FileMode
mode_w) = case Maybe FileMode
maybe_mode of
                        Maybe FileMode
Nothing -> ([],FileMode
0)
                        Just FileMode
x  -> ([Flags
FD.oCreat], FileMode
x)

    open_mode :: Flags
open_mode = case OpenMode
how of
                   OpenMode
Posix.ReadOnly  -> Flags
FD.oRdonly
                   OpenMode
Posix.WriteOnly -> Flags
FD.oWronly
                   OpenMode
Posix.ReadWrite -> Flags
FD.oRdwr


-- |Open and optionally create this file. See 'System.Posix.Files'
-- for information on how to use the 'FileMode' type.
--
-- Note that passing @Just x@ as the 4th argument triggers the
-- `oCreat` status flag, which must be set when you pass in `oExcl`
-- to the status flags. Also see the manpage for @open(2)@.
openFd' :: FilePath
        -> Posix.OpenMode
        -> [FD.Flags]               -- ^ status flags of @open(2)@
        -> Maybe Posix.FileMode  -- ^ @Just x@ => creates the file with the given modes, Nothing => the file must exist.
        -> IO Posix.Fd
openFd' :: FilePath -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd' FilePath
name OpenMode
how [Flags]
optional_flags Maybe FileMode
maybe_mode =
   forall a. FilePath -> (CString -> IO a) -> IO a
withFilePath FilePath
name forall a b. (a -> b) -> a -> b
$ \CString
str ->
     forall a. (Eq a, Num a) => FilePath -> FilePath -> IO a -> IO a
throwErrnoPathIfMinus1Retry FilePath
"openFd" FilePath
name forall a b. (a -> b) -> a -> b
$
       CString -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
open_ CString
str OpenMode
how [Flags]
optional_flags Maybe FileMode
maybe_mode


-- |Deletes the given file. Raises `eISDIR`
-- if run on a directory. Does not follow symbolic links.
--
-- Throws:
--
--    - `InappropriateType` for wrong file type (directory)
--    - `NoSuchThing` if the file does not exist
--    - `PermissionDenied` if the directory cannot be read
--
-- Notes: calls `unlink`
deleteFile :: FilePath -> IO ()
deleteFile :: FilePath -> IO ()
deleteFile = FilePath -> IO ()
removeLink


-- |Recreate a symlink.
--
-- In `Overwrite` copy mode only files and empty directories are deleted.
--
-- Safety/reliability concerns:
--
--    * `Overwrite` mode is inherently non-atomic
--
-- Throws:
--
--    - `InvalidArgument` if source file is wrong type (not a symlink)
--    - `PermissionDenied` if output directory cannot be written to
--    - `PermissionDenied` if source directory cannot be opened
--    - `SameFile` if source and destination are the same file
--      (`HPathIOException`)
--
--
-- Throws in `Strict` mode only:
--
--    - `AlreadyExists` if destination already exists
--
-- Throws in `Overwrite` mode only:
--
--    - `UnsatisfiedConstraints` if destination file is non-empty directory
--
-- Notes:
--
--    - calls `symlink`
recreateSymlink :: FilePath   -- ^ the old symlink file
                -> FilePath   -- ^ destination file
                -> Bool       -- ^ fail if destination file exists
                -> IO ()
recreateSymlink :: FilePath -> FilePath -> Bool -> IO ()
recreateSymlink FilePath
symsource FilePath
newsym Bool
fail' = do
  FilePath
sympoint <- FilePath -> IO FilePath
readSymbolicLink FilePath
symsource
  case Bool
fail' of
    Bool
True  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Bool
False ->
      forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> if IOErrorType
doesNotExistErrorType  forall a. Eq a => a -> a -> Bool
== IOException -> IOErrorType
ioeGetErrorType IOException
e then forall (f :: * -> *) a. Applicative f => a -> f a
pure () else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IOException -> IO a
ioError forall a b. (a -> b) -> a -> b
$ IOException
e) forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
deleteFile FilePath
newsym
  FilePath -> FilePath -> IO ()
createSymbolicLink FilePath
sympoint FilePath
newsym


-- copys files, recreates symlinks, fails on all other types
install :: FilePath -> FilePath -> Bool -> IO ()
install :: FilePath -> FilePath -> Bool -> IO ()
install FilePath
from FilePath
to Bool
fail' = do
  FileStatus
fs <- FilePath -> IO FileStatus
PF.getSymbolicLinkStatus FilePath
from
  FileStatus -> IO ()
decide FileStatus
fs
 where
  decide :: FileStatus -> IO ()
decide FileStatus
fs | FileStatus -> Bool
PF.isRegularFile FileStatus
fs     = FilePath -> FilePath -> Bool -> IO ()
copyFile FilePath
from FilePath
to Bool
fail'
            | FileStatus -> Bool
PF.isSymbolicLink FileStatus
fs    = FilePath -> FilePath -> Bool -> IO ()
recreateSymlink FilePath
from FilePath
to Bool
fail'
            | Bool
otherwise               = forall a. IOException -> IO a
ioError forall a b. (a -> b) -> a -> b
$ IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOException
mkIOError IOErrorType
illegalOperationErrorType FilePath
"install: not a regular file or symlink" forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just FilePath
from)

moveFile :: FilePath -> FilePath -> IO ()
moveFile :: FilePath -> FilePath -> IO ()
moveFile = FilePath -> FilePath -> IO ()
rename


moveFilePortable :: FilePath -> FilePath -> IO ()
moveFilePortable :: FilePath -> FilePath -> IO ()
moveFilePortable FilePath
from FilePath
to = do
  forall a. [Errno] -> IO a -> IO a -> IO a
catchErrno [Errno
eXDEV] (FilePath -> FilePath -> IO ()
moveFile FilePath
from FilePath
to) forall a b. (a -> b) -> a -> b
$ do
    FilePath -> FilePath -> Bool -> IO ()
copyFile FilePath
from FilePath
to Bool
True
    FilePath -> IO ()
removeFile FilePath
from


catchErrno :: [Errno] -- ^ errno to catch
           -> IO a    -- ^ action to try, which can raise an IOException
           -> IO a    -- ^ action to carry out in case of an IOException and
                      --   if errno matches
           -> IO a
catchErrno :: forall a. [Errno] -> IO a -> IO a -> IO a
catchErrno [Errno]
en IO a
a1 IO a
a2 =
  forall (m :: * -> *) a.
MonadCatch m =>
m a -> (IOException -> m a) -> m a
catchIOError IO a
a1 forall a b. (a -> b) -> a -> b
$ \IOException
e -> do
    Errno
errno <- IO Errno
getErrno
    if Errno
errno forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Errno]
en
      then IO a
a2
      else forall a. IOException -> IO a
ioError IOException
e

removeEmptyDirectory :: FilePath -> IO ()
removeEmptyDirectory :: FilePath -> IO ()
removeEmptyDirectory = FilePath -> IO ()
PD.removeDirectory


-- | Create an 'Unfold' of directory contents.
unfoldDirContents :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath (FD.DirType, FilePath)
unfoldDirContents :: forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadAsync m) =>
Unfold m FilePath (DirType, FilePath)
unfoldDirContents = forall (m :: * -> *) a c d b.
(MonadAsync m, MonadCatch m) =>
(a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
U.bracket (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO DirStreamPortable
openDirStreamPortable) (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirStreamPortable -> IO ()
closeDirStreamPortable) (forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold forall {m :: * -> *}.
MonadIO m =>
DirStreamPortable -> m (Step DirStreamPortable (DirType, FilePath))
step forall (m :: * -> *) a. Monad m => a -> m a
return)
 where
  {-# INLINE [0] step #-}
  step :: DirStreamPortable -> m (Step DirStreamPortable (DirType, FilePath))
step DirStreamPortable
dirstream = do
    (DirType
typ, FilePath
e) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DirStreamPortable -> IO (DirType, FilePath)
readDirEntPortable DirStreamPortable
dirstream
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
e    -> forall s a. Step s a
D.Stop
      | FilePath
"." forall a. Eq a => a -> a -> Bool
== FilePath
e  -> forall s a. s -> Step s a
D.Skip DirStreamPortable
dirstream
      | FilePath
".." forall a. Eq a => a -> a -> Bool
== FilePath
e -> forall s a. s -> Step s a
D.Skip DirStreamPortable
dirstream
      | Bool
otherwise -> forall s a. a -> s -> Step s a
D.Yield (DirType
typ, FilePath
e) DirStreamPortable
dirstream


getDirectoryContentsRecursiveDFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
                                       => FilePath
                                       -> S.SerialT m FilePath
getDirectoryContentsRecursiveDFSUnsafe :: forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadAsync m) =>
FilePath -> SerialT m FilePath
getDirectoryContentsRecursiveDFSUnsafe FilePath
fp = FilePath -> SerialT m FilePath
go FilePath
""
 where
  go :: FilePath -> SerialT m FilePath
go FilePath
cd = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
(a -> t m b) -> t m a -> t m b
S.concatMap (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
Unfold m a b -> a -> t m b
S.unfold forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadAsync m) =>
Unfold m FilePath (DirType, FilePath)
unfoldDirContents (FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
cd)) forall a b. (a -> b) -> a -> b
$ \(DirType
t, FilePath
f) ->
    if | DirType
t forall a. Eq a => a -> a -> Bool
== DirType
FD.dtDir -> FilePath -> SerialT m FilePath
go (FilePath
cd FilePath -> FilePath -> FilePath
</> FilePath
f)
       | Bool
otherwise     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
cd FilePath -> FilePath -> FilePath
</> FilePath
f)


getDirectoryContentsRecursiveUnfold :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath FilePath
getDirectoryContentsRecursiveUnfold :: forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadAsync m) =>
Unfold m FilePath FilePath
getDirectoryContentsRecursiveUnfold = forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold forall {m :: * -> *}.
(MonadMask m, MonadUnliftIO m) =>
(FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
 [FilePath])
-> m (Step
        (FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
         [FilePath])
        FilePath)
step (\FilePath
s -> forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
s, forall a. Maybe a
Nothing, [FilePath
""]))
 where
  {-# INLINE [0] step #-}
  step :: (FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
 [FilePath])
-> m (Step
        (FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
         [FilePath])
        FilePath)
step (FilePath
_, Maybe (FilePath, DirStreamPortable, IOFinalizer)
Nothing, []) = forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Step s a
D.Stop

  step (FilePath
topdir, Just (FilePath
cdir, DirStreamPortable
dirstream, IOFinalizer
finalizer), [FilePath]
dirs) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
onException (forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
finalizer) forall a b. (a -> b) -> a -> b
$ do
    (DirType
dt, FilePath
f) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DirStreamPortable -> IO (DirType, FilePath)
readDirEntPortable DirStreamPortable
dirstream
    if | FilePath
f forall a. Eq a => a -> a -> Bool
== FilePath
"" -> do
           forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
finalizer
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
D.Skip (FilePath
topdir, forall a. Maybe a
Nothing, [FilePath]
dirs)
       | FilePath
f forall a. Eq a => a -> a -> Bool
== FilePath
"." Bool -> Bool -> Bool
|| FilePath
f forall a. Eq a => a -> a -> Bool
== FilePath
".."
                        -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
D.Skip               (FilePath
topdir, forall a. a -> Maybe a
Just (FilePath
cdir, DirStreamPortable
dirstream, IOFinalizer
finalizer), [FilePath]
dirs)
       | DirType
FD.dtDir forall a. Eq a => a -> a -> Bool
== DirType
dt -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
D.Skip               (FilePath
topdir, forall a. a -> Maybe a
Just (FilePath
cdir, DirStreamPortable
dirstream, IOFinalizer
finalizer), (FilePath
cdir FilePath -> FilePath -> FilePath
</> FilePath
f)forall a. a -> [a] -> [a]
:[FilePath]
dirs)
       | Bool
otherwise      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. a -> s -> Step s a
D.Yield (FilePath
cdir FilePath -> FilePath -> FilePath
</> FilePath
f) (FilePath
topdir, forall a. a -> Maybe a
Just (FilePath
cdir, DirStreamPortable
dirstream, IOFinalizer
finalizer), [FilePath]
dirs)

  step (FilePath
topdir, Maybe (FilePath, DirStreamPortable, IOFinalizer)
Nothing, FilePath
dir:[FilePath]
dirs) = do
    (DirStreamPortable
s, IOFinalizer
f) <- forall {m :: * -> *}.
MonadUnliftIO m =>
FilePath -> m (DirStreamPortable, IOFinalizer)
acquire (FilePath
topdir FilePath -> FilePath -> FilePath
</> FilePath
dir)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
D.Skip (FilePath
topdir, forall a. a -> Maybe a
Just (FilePath
dir, DirStreamPortable
s, IOFinalizer
f), [FilePath]
dirs)

  acquire :: FilePath -> m (DirStreamPortable, IOFinalizer)
acquire FilePath
dir =
    forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ do
        DirStreamPortable
dirstream <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO DirStreamPortable
openDirStreamPortable FilePath
dir
        IOFinalizer
ref <- forall (m :: * -> *) a. MonadRunInIO m => m a -> m IOFinalizer
newIOFinalizer (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DirStreamPortable -> IO ()
closeDirStreamPortable DirStreamPortable
dirstream)
        forall (m :: * -> *) a. Monad m => a -> m a
return (DirStreamPortable
dirstream, IOFinalizer
ref)

getDirectoryContentsRecursiveBFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
                                       => FilePath
                                       -> S.SerialT m FilePath
getDirectoryContentsRecursiveBFSUnsafe :: forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadAsync m) =>
FilePath -> SerialT m FilePath
getDirectoryContentsRecursiveBFSUnsafe = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
Unfold m a b -> a -> t m b
S.unfold forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadAsync m) =>
Unfold m FilePath FilePath
getDirectoryContentsRecursiveUnfold