{-# 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
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
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
  IO Bool -> IO (Either IOException Bool)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (FilePath -> IO Bool
pathIsSymbolicLink FilePath
fp) IO (Either IOException Bool)
-> (Either IOException Bool -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
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 (Bool -> Bool) -> IO Bool -> IO Bool
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 -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
    Left IOException
e | IOException -> Bool
isDoesNotExistError IOException
e -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
           | Bool
otherwise -> IOException -> IO Bool
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
  IO (Fd, Handle)
-> ((Fd, Handle) -> IO ()) -> ((Fd, Handle) -> IO ()) -> IO ()
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] Maybe FileMode
forall a. Maybe a
Nothing)
    (Handle -> IO ()
hClose (Handle -> IO ())
-> ((Fd, Handle) -> Handle) -> (Fd, Handle) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fd, Handle) -> Handle
forall a b. (a, b) -> b
snd)
    (((Fd, Handle) -> IO ()) -> IO ())
-> ((Fd, Handle) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Fd
fromFd, Handle
fH) -> do
        FileMode
sourceFileMode <- FileStatus -> FileMode
fileMode (FileStatus -> FileMode) -> IO FileStatus -> IO 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 (Maybe FileMode -> IO (Fd, Handle))
-> Maybe FileMode -> IO (Fd, Handle)
forall a b. (a -> b) -> a -> b
$ FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
sourceFileMode
        IO (Fd, Handle)
-> ((Fd, Handle) -> IO ()) -> ((Fd, Handle) -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
          ((IOException -> IO (Fd, Handle))
-> IO (Fd, Handle) -> IO (Fd, Handle)
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 IOErrorType -> IOErrorType -> Bool
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 -> IOException -> IO (Fd, Handle)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO IOException
e
                    )
            IO (Fd, Handle)
openFdHandle')
          (Handle -> IO ()
hClose (Handle -> IO ())
-> ((Fd, Handle) -> Handle) -> (Fd, Handle) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fd, Handle) -> Handle
forall a b. (a, b) -> b
snd)
          (((Fd, Handle) -> IO ()) -> IO ())
-> ((Fd, Handle) -> IO ()) -> IO ()
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
              (Handle, Handle) -> IO ()
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
    (Fd, Handle) -> IO (Fd, Handle)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fd
fd, Handle
handle')
  streamlyCopy :: (Handle, Handle) -> m ()
streamlyCopy (Handle
fH, Handle
tH) =
    Fold m (Array Word8) () -> SerialT m (Array Word8) -> m ()
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> SerialT m a -> m b
S.fold (Handle -> Fold m (Array Word8) ()
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Handle -> Fold m (Array a) ()
FH.writeChunks Handle
tH) (SerialT m (Array Word8) -> m ())
-> SerialT m (Array Word8) -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Handle -> SerialT m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadIO m) =>
Int -> Handle -> t m (Array Word8)
IFH.toChunksWithBufferOf (Int
256 Int -> Int -> Int
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
    Fd -> IO Fd
forall a. a -> IO a
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 ([Flags] -> CInt) -> [Flags] -> CInt
forall a b. (a -> b) -> a -> b
$ [Flags]
optional_flags [Flags] -> [Flags] -> [Flags]
forall a. [a] -> [a] -> [a]
++ [Flags
open_mode] [Flags] -> [Flags] -> [Flags]
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 =
   FilePath -> (CString -> IO Fd) -> IO Fd
forall a. FilePath -> (CString -> IO a) -> IO a
withFilePath FilePath
name ((CString -> IO Fd) -> IO Fd) -> (CString -> IO Fd) -> IO Fd
forall a b. (a -> b) -> a -> b
$ \CString
str ->
     FilePath -> FilePath -> IO Fd -> IO Fd
forall a. (Eq a, Num a) => FilePath -> FilePath -> IO a -> IO a
throwErrnoPathIfMinus1Retry FilePath
"openFd" FilePath
name (IO Fd -> IO Fd) -> IO Fd -> IO Fd
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  -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Bool
False ->
      (IOException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> if IOErrorType
doesNotExistErrorType  IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOException -> IOErrorType
ioeGetErrorType IOException
e then () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> (IOException -> IO ()) -> IOException -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> IO ()
forall a. IOException -> IO a
ioError (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ IOException
e) (IO () -> IO ()) -> IO () -> IO ()
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               = IOException -> IO ()
forall a. IOException -> IO a
ioError (IOException -> IO ()) -> IOException -> IO ()
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" Maybe Handle
forall a. Maybe a
Nothing (FilePath -> Maybe FilePath
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
  [Errno] -> IO () -> IO () -> IO ()
forall a. [Errno] -> IO a -> IO a -> IO a
catchErrno [Errno
eXDEV] (FilePath -> FilePath -> IO ()
moveFile FilePath
from FilePath
to) (IO () -> IO ()) -> IO () -> IO ()
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 =
  IO a -> (IOException -> IO a) -> IO a
forall (m :: * -> *) a.
MonadCatch m =>
m a -> (IOException -> m a) -> m a
catchIOError IO a
a1 ((IOException -> IO a) -> IO a) -> (IOException -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \IOException
e -> do
    Errno
errno <- IO Errno
getErrno
    if Errno
errno Errno -> [Errno] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Errno]
en
      then IO a
a2
      else IOException -> IO a
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 = (FilePath -> m DirStreamPortable)
-> (DirStreamPortable -> m ())
-> Unfold m DirStreamPortable (DirType, FilePath)
-> Unfold m FilePath (DirType, FilePath)
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 (IO DirStreamPortable -> m DirStreamPortable
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DirStreamPortable -> m DirStreamPortable)
-> (FilePath -> IO DirStreamPortable)
-> FilePath
-> m DirStreamPortable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO DirStreamPortable
openDirStreamPortable) (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (DirStreamPortable -> IO ()) -> DirStreamPortable -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirStreamPortable -> IO ()
closeDirStreamPortable) ((DirStreamPortable
 -> m (Step DirStreamPortable (DirType, FilePath)))
-> (DirStreamPortable -> m DirStreamPortable)
-> Unfold m DirStreamPortable (DirType, FilePath)
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold DirStreamPortable -> m (Step DirStreamPortable (DirType, FilePath))
forall {m :: * -> *}.
MonadIO m =>
DirStreamPortable -> m (Step DirStreamPortable (DirType, FilePath))
step DirStreamPortable -> m DirStreamPortable
forall a. a -> m a
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) <- IO (DirType, FilePath) -> m (DirType, FilePath)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DirType, FilePath) -> m (DirType, FilePath))
-> IO (DirType, FilePath) -> m (DirType, FilePath)
forall a b. (a -> b) -> a -> b
$ DirStreamPortable -> IO (DirType, FilePath)
readDirEntPortable DirStreamPortable
dirstream
    Step DirStreamPortable (DirType, FilePath)
-> m (Step DirStreamPortable (DirType, FilePath))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step DirStreamPortable (DirType, FilePath)
 -> m (Step DirStreamPortable (DirType, FilePath)))
-> Step DirStreamPortable (DirType, FilePath)
-> m (Step DirStreamPortable (DirType, FilePath))
forall a b. (a -> b) -> a -> b
$ if
      | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
e    -> Step DirStreamPortable (DirType, FilePath)
forall s a. Step s a
D.Stop
      | FilePath
"." FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
e  -> DirStreamPortable -> Step DirStreamPortable (DirType, FilePath)
forall s a. s -> Step s a
D.Skip DirStreamPortable
dirstream
      | FilePath
".." FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
e -> DirStreamPortable -> Step DirStreamPortable (DirType, FilePath)
forall s a. s -> Step s a
D.Skip DirStreamPortable
dirstream
      | Bool
otherwise -> (DirType, FilePath)
-> DirStreamPortable -> Step DirStreamPortable (DirType, FilePath)
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 = (((DirType, FilePath) -> SerialT m FilePath)
 -> SerialT m (DirType, FilePath) -> SerialT m FilePath)
-> SerialT m (DirType, FilePath)
-> ((DirType, FilePath) -> SerialT m FilePath)
-> SerialT m FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((DirType, FilePath) -> SerialT m FilePath)
-> SerialT m (DirType, FilePath) -> SerialT m FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
(a -> t m b) -> t m a -> t m b
S.concatMap (Unfold m FilePath (DirType, FilePath)
-> FilePath -> SerialT m (DirType, FilePath)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
Unfold m a b -> a -> t m b
S.unfold Unfold m FilePath (DirType, FilePath)
forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadAsync m) =>
Unfold m FilePath (DirType, FilePath)
unfoldDirContents (FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
cd)) (((DirType, FilePath) -> SerialT m FilePath) -> SerialT m FilePath)
-> ((DirType, FilePath) -> SerialT m FilePath)
-> SerialT m FilePath
forall a b. (a -> b) -> a -> b
$ \(DirType
t, FilePath
f) ->
    if | DirType
t DirType -> DirType -> Bool
forall a. Eq a => a -> a -> Bool
== DirType
FD.dtDir -> FilePath -> SerialT m FilePath
go (FilePath
cd FilePath -> FilePath -> FilePath
</> FilePath
f)
       | Bool
otherwise     -> FilePath -> SerialT m FilePath
forall a. a -> SerialT m a
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 = ((FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
  [FilePath])
 -> m (Step
         (FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
          [FilePath])
         FilePath))
-> (FilePath
    -> m (FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
          [FilePath]))
-> Unfold m FilePath FilePath
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
 [FilePath])
-> m (Step
        (FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
         [FilePath])
        FilePath)
forall {m :: * -> *}.
(MonadMask m, MonadUnliftIO m) =>
(FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
 [FilePath])
-> m (Step
        (FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
         [FilePath])
        FilePath)
step (\FilePath
s -> (FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
 [FilePath])
-> m (FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
      [FilePath])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
s, Maybe (FilePath, DirStreamPortable, IOFinalizer)
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, []) = Step
  (FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
   [FilePath])
  FilePath
-> m (Step
        (FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
         [FilePath])
        FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (FilePath, Maybe (FilePath, DirStreamPortable, IOFinalizer),
   [FilePath])
  FilePath
forall s a. Step s a
D.Stop

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

  acquire :: FilePath -> m (DirStreamPortable, IOFinalizer)
acquire FilePath
dir =
    ((forall a. m a -> IO a) -> IO (DirStreamPortable, IOFinalizer))
-> m (DirStreamPortable, IOFinalizer)
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (DirStreamPortable, IOFinalizer))
 -> m (DirStreamPortable, IOFinalizer))
-> ((forall a. m a -> IO a) -> IO (DirStreamPortable, IOFinalizer))
-> m (DirStreamPortable, IOFinalizer)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> IO (DirStreamPortable, IOFinalizer)
-> IO (DirStreamPortable, IOFinalizer)
forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (IO (DirStreamPortable, IOFinalizer)
 -> IO (DirStreamPortable, IOFinalizer))
-> IO (DirStreamPortable, IOFinalizer)
-> IO (DirStreamPortable, IOFinalizer)
forall a b. (a -> b) -> a -> b
$ m (DirStreamPortable, IOFinalizer)
-> IO (DirStreamPortable, IOFinalizer)
forall a. m a -> IO a
run (m (DirStreamPortable, IOFinalizer)
 -> IO (DirStreamPortable, IOFinalizer))
-> m (DirStreamPortable, IOFinalizer)
-> IO (DirStreamPortable, IOFinalizer)
forall a b. (a -> b) -> a -> b
$ do
        DirStreamPortable
dirstream <- IO DirStreamPortable -> m DirStreamPortable
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DirStreamPortable -> m DirStreamPortable)
-> IO DirStreamPortable -> m DirStreamPortable
forall a b. (a -> b) -> a -> b
$ FilePath -> IO DirStreamPortable
openDirStreamPortable FilePath
dir
        IOFinalizer
ref <- m () -> m IOFinalizer
forall (m :: * -> *) a. MonadRunInIO m => m a -> m IOFinalizer
newIOFinalizer (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DirStreamPortable -> IO ()
closeDirStreamPortable DirStreamPortable
dirstream)
        (DirStreamPortable, IOFinalizer)
-> m (DirStreamPortable, IOFinalizer)
forall a. a -> m a
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 = Unfold m FilePath FilePath -> FilePath -> SerialT m FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
Unfold m a b -> a -> t m b
S.unfold Unfold m FilePath FilePath
forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadAsync m) =>
Unfold m FilePath FilePath
getDirectoryContentsRecursiveUnfold