{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CApiFFI #-}
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 (..))
getLinkTarget :: FilePath -> IO FilePath
getLinkTarget :: FilePath -> IO FilePath
getLinkTarget = FilePath -> IO FilePath
getSymbolicLinkTarget
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
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
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
(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
-> FilePath
-> Bool
-> 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
| 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
openFd' :: FilePath
-> Posix.OpenMode
-> [FD.Flags]
-> Maybe Posix.FileMode
-> 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
deleteFile :: FilePath -> IO ()
deleteFile :: FilePath -> IO ()
deleteFile = FilePath -> IO ()
removeLink
recreateSymlink :: FilePath
-> FilePath
-> Bool
-> 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
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]
-> IO a
-> IO a
-> 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
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