#include "inline.hs"
module Streamly.Internal.FileSystem.Dir
(
read
, readFiles
, readDirs
, readEither
, readEitherPaths
, reader
, fileReader
, dirReader
, eitherReader
, eitherReaderPaths
, toStream
, toEither
, toFiles
, toDirs
)
where
import Control.Monad.Catch (MonadCatch)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Bifunctor (bimap)
import Data.Either (isRight, isLeft, fromLeft, fromRight)
import Data.Function ((&))
import Streamly.Data.Stream (Stream)
import Streamly.Internal.Data.Unfold (Step(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import System.FilePath ((</>))
#if (defined linux_HOST_OS) || (defined darwin_HOST_OS)
import System.Posix (DirStream, openDirStream, readDirStream, closeDirStream)
#elif defined(mingw32_HOST_OS)
import qualified System.Win32 as Win32
#else
#error "Unsupported architecture"
#endif
import qualified Streamly.Data.Unfold as UF
import qualified Streamly.Internal.Data.Unfold as UF (mapM2, bracketIO)
import qualified Streamly.Data.Stream as S
import qualified System.Directory as Dir
import Prelude hiding (read)
#if (defined linux_HOST_OS) || (defined darwin_HOST_OS)
{-# INLINE streamReader #-}
streamReader :: MonadIO m => Unfold m DirStream FilePath
streamReader :: forall (m :: * -> *). MonadIO m => Unfold m DirStream FilePath
streamReader = (DirStream -> m (Step DirStream FilePath))
-> (DirStream -> m DirStream) -> Unfold m DirStream FilePath
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold DirStream -> m (Step DirStream FilePath)
forall {m :: * -> *}.
MonadIO m =>
DirStream -> m (Step DirStream FilePath)
step DirStream -> m DirStream
forall (m :: * -> *) a. Monad m => a -> m a
return
where
step :: DirStream -> m (Step DirStream FilePath)
step DirStream
strm = do
FilePath
file <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ DirStream -> IO FilePath
readDirStream DirStream
strm
case FilePath
file of
[] -> Step DirStream FilePath -> m (Step DirStream FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Step DirStream FilePath
forall s a. Step s a
Stop
FilePath
_ -> Step DirStream FilePath -> m (Step DirStream FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step DirStream FilePath -> m (Step DirStream FilePath))
-> Step DirStream FilePath -> m (Step DirStream FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> DirStream -> Step DirStream FilePath
forall s a. a -> s -> Step s a
Yield FilePath
file DirStream
strm
#elif defined(mingw32_HOST_OS)
openDirStream :: String -> IO (Win32.HANDLE, Win32.FindData)
openDirStream = Win32.findFirstFile
closeDirStream :: (Win32.HANDLE, Win32.FindData) -> IO ()
closeDirStream (h, _) = Win32.findClose h
{-# INLINE streamReader #-}
streamReader :: MonadIO m => Unfold m (Win32.HANDLE, Win32.FindData) FilePath
streamReader = Unfold step return
where
step (h, fdat) = do
more <- liftIO $ Win32.findNextFile h fdat
if more
then do
file <- liftIO $ Win32.getFindDataFileName fdat
return $ Yield file (h, fdat)
else return Stop
#endif
{-# INLINE reader #-}
reader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath
reader :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m FilePath FilePath
reader =
(FilePath -> IO DirStream)
-> (DirStream -> IO ())
-> Unfold m DirStream FilePath
-> Unfold m FilePath FilePath
forall (m :: * -> *) a c d b.
(MonadIO m, MonadCatch m) =>
(a -> IO c) -> (c -> IO d) -> Unfold m c b -> Unfold m a b
UF.bracketIO FilePath -> IO DirStream
openDirStream DirStream -> IO ()
closeDirStream Unfold m DirStream FilePath
forall (m :: * -> *). MonadIO m => Unfold m DirStream FilePath
streamReader
Unfold m FilePath FilePath
-> (Unfold m FilePath FilePath -> Unfold m FilePath FilePath)
-> Unfold m FilePath FilePath
forall a b. a -> (a -> b) -> b
& (FilePath -> Bool)
-> Unfold m FilePath FilePath -> Unfold m FilePath FilePath
forall (m :: * -> *) b a.
Monad m =>
(b -> Bool) -> Unfold m a b -> Unfold m a b
UF.filter (\FilePath
x -> FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"." Bool -> Bool -> Bool
&& FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"..")
{-# INLINE eitherReader #-}
eitherReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)
eitherReader :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m FilePath (Either FilePath FilePath)
eitherReader = (FilePath -> FilePath -> m (Either FilePath FilePath))
-> Unfold m FilePath FilePath
-> Unfold m FilePath (Either FilePath FilePath)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Unfold m a b -> Unfold m a c
UF.mapM2 FilePath -> FilePath -> m (Either FilePath FilePath)
forall {m :: * -> *}.
MonadIO m =>
FilePath -> FilePath -> m (Either FilePath FilePath)
classify Unfold m FilePath FilePath
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m FilePath FilePath
reader
where
classify :: FilePath -> FilePath -> m (Either FilePath FilePath)
classify FilePath
dir FilePath
x = do
Bool
r <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
Dir.doesDirectoryExist (FilePath
dir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x)
Either FilePath FilePath -> m (Either FilePath FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath FilePath -> m (Either FilePath FilePath))
-> Either FilePath FilePath -> m (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ if Bool
r then FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left FilePath
x else FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right FilePath
x
{-# INLINE eitherReaderPaths #-}
eitherReaderPaths ::(MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)
eitherReaderPaths :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m FilePath (Either FilePath FilePath)
eitherReaderPaths =
(FilePath
-> Either FilePath FilePath -> m (Either FilePath FilePath))
-> Unfold m FilePath (Either FilePath FilePath)
-> Unfold m FilePath (Either FilePath FilePath)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Unfold m a b -> Unfold m a c
UF.mapM2 (\FilePath
dir -> Either FilePath FilePath -> m (Either FilePath FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath FilePath -> m (Either FilePath FilePath))
-> (Either FilePath FilePath -> Either FilePath FilePath)
-> Either FilePath FilePath
-> m (Either FilePath FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath)
-> (FilePath -> FilePath)
-> Either FilePath FilePath
-> Either FilePath FilePath
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (FilePath
dir FilePath -> FilePath -> FilePath
</>) (FilePath
dir FilePath -> FilePath -> FilePath
</>)) Unfold m FilePath (Either FilePath FilePath)
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m FilePath (Either FilePath FilePath)
eitherReader
{-# INLINE fileReader #-}
fileReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath
fileReader :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m FilePath FilePath
fileReader = (Either FilePath FilePath -> FilePath)
-> Unfold m FilePath (Either FilePath FilePath)
-> Unfold m FilePath FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Either FilePath FilePath -> FilePath
forall b a. b -> Either a b -> b
fromRight FilePath
forall a. HasCallStack => a
undefined) (Unfold m FilePath (Either FilePath FilePath)
-> Unfold m FilePath FilePath)
-> Unfold m FilePath (Either FilePath FilePath)
-> Unfold m FilePath FilePath
forall a b. (a -> b) -> a -> b
$ (Either FilePath FilePath -> Bool)
-> Unfold m FilePath (Either FilePath FilePath)
-> Unfold m FilePath (Either FilePath FilePath)
forall (m :: * -> *) b a.
Monad m =>
(b -> Bool) -> Unfold m a b -> Unfold m a b
UF.filter Either FilePath FilePath -> Bool
forall a b. Either a b -> Bool
isRight Unfold m FilePath (Either FilePath FilePath)
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m FilePath (Either FilePath FilePath)
eitherReader
{-# INLINE dirReader #-}
dirReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath
dirReader :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m FilePath FilePath
dirReader = (Either FilePath FilePath -> FilePath)
-> Unfold m FilePath (Either FilePath FilePath)
-> Unfold m FilePath FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Either FilePath FilePath -> FilePath
forall a b. a -> Either a b -> a
fromLeft FilePath
forall a. HasCallStack => a
undefined) (Unfold m FilePath (Either FilePath FilePath)
-> Unfold m FilePath FilePath)
-> Unfold m FilePath (Either FilePath FilePath)
-> Unfold m FilePath FilePath
forall a b. (a -> b) -> a -> b
$ (Either FilePath FilePath -> Bool)
-> Unfold m FilePath (Either FilePath FilePath)
-> Unfold m FilePath (Either FilePath FilePath)
forall (m :: * -> *) b a.
Monad m =>
(b -> Bool) -> Unfold m a b -> Unfold m a b
UF.filter Either FilePath FilePath -> Bool
forall a b. Either a b -> Bool
isLeft Unfold m FilePath (Either FilePath FilePath)
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m FilePath (Either FilePath FilePath)
eitherReader
{-# INLINE read #-}
read :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath
read :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m FilePath
read = Unfold m FilePath FilePath -> FilePath -> Stream m FilePath
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
S.unfold Unfold m FilePath FilePath
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m FilePath FilePath
reader
{-# DEPRECATED toStream "Please use 'read' instead" #-}
{-# INLINE toStream #-}
toStream :: (MonadIO m, MonadCatch m) => String -> Stream m String
toStream :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m FilePath
toStream = FilePath -> Stream m FilePath
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m FilePath
read
{-# INLINE readEither #-}
readEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)
readEither :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m (Either FilePath FilePath)
readEither = Unfold m FilePath (Either FilePath FilePath)
-> FilePath -> Stream m (Either FilePath FilePath)
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
S.unfold Unfold m FilePath (Either FilePath FilePath)
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m FilePath (Either FilePath FilePath)
eitherReader
{-# INLINE readEitherPaths #-}
readEitherPaths :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)
readEitherPaths :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m (Either FilePath FilePath)
readEitherPaths FilePath
dir = (Either FilePath FilePath -> Either FilePath FilePath)
-> Stream m (Either FilePath FilePath)
-> Stream m (Either FilePath FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> FilePath)
-> (FilePath -> FilePath)
-> Either FilePath FilePath
-> Either FilePath FilePath
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (FilePath
dir FilePath -> FilePath -> FilePath
</>) (FilePath
dir FilePath -> FilePath -> FilePath
</>)) (Stream m (Either FilePath FilePath)
-> Stream m (Either FilePath FilePath))
-> Stream m (Either FilePath FilePath)
-> Stream m (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Stream m (Either FilePath FilePath)
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m (Either FilePath FilePath)
readEither FilePath
dir
{-# DEPRECATED toEither "Please use 'readEither' instead" #-}
{-# INLINE toEither #-}
toEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)
toEither :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m (Either FilePath FilePath)
toEither = FilePath -> Stream m (Either FilePath FilePath)
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m (Either FilePath FilePath)
readEither
{-# INLINE readFiles #-}
readFiles :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath
readFiles :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m FilePath
readFiles = Unfold m FilePath FilePath -> FilePath -> Stream m FilePath
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
S.unfold Unfold m FilePath FilePath
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m FilePath FilePath
fileReader
{-# DEPRECATED toFiles "Please use 'readFiles' instead" #-}
{-# INLINE toFiles #-}
toFiles :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath
toFiles :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m FilePath
toFiles = FilePath -> Stream m FilePath
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m FilePath
readFiles
{-# INLINE readDirs #-}
readDirs :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath
readDirs :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m FilePath
readDirs = Unfold m FilePath FilePath -> FilePath -> Stream m FilePath
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
S.unfold Unfold m FilePath FilePath
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m FilePath FilePath
dirReader
{-# DEPRECATED toDirs "Please use 'readDirs' instead" #-}
{-# INLINE toDirs #-}
toDirs :: (MonadIO m, MonadCatch m) => String -> Stream m String
toDirs :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m FilePath
toDirs = FilePath -> Stream m FilePath
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Stream m FilePath
readDirs