diff --git a/Data/Conduit/Combinators.hs b/Data/Conduit/Combinators.hs --- a/Data/Conduit/Combinators.hs +++ b/Data/Conduit/Combinators.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE GADTs #-} @@ -45,6 +46,10 @@ , sourceRandomGen , sourceRandomNGen + -- ** Filesystem + , sourceDirectory + , sourceDirectoryDeep + -- * Consumers -- ** Pure , drop @@ -180,11 +185,12 @@ import qualified Data.Vector.Generic as V import qualified Data.Vector.Generic.Mutable as VM import qualified Filesystem as F -import Filesystem.Path (FilePath) +import Filesystem.Path (FilePath, ()) +import Filesystem.Path.CurrentOS (encodeString, decodeString) import Prelude (Bool (..), Eq (..), Int, Maybe (..), Monad (..), Num (..), Ord (..), fromIntegral, maybe, - ($), Functor (..), Enum, seq, Show, Char) + ($), Functor (..), Enum, seq, Show, Char, (||)) import Data.Word (Word8) import qualified Prelude import System.IO (Handle) @@ -195,6 +201,8 @@ import Data.Text (Text) import qualified System.Random.MWC as MWC import Data.Conduit.Combinators.Internal +import qualified System.PosixCompat.Files as PosixC +import qualified System.Posix.Directory as Dir -- END IMPORTS @@ -388,6 +396,66 @@ -> Producer m a sourceRandomNGen gen = initReplicate (return gen) (liftBase . MWC.uniform) {-# INLINE sourceRandomNGen #-} + +-- | Stream the contents of the given directory, without traversing deeply. +-- +-- This function will return /all/ of the contents of the directory, whether +-- they be files, directories, etc. +-- +-- Note that the generated filepaths will be the complete path, not just the +-- filename. In other words, if you have a directory @foo@ containing files +-- @bar@ and @baz@, and you use @sourceDirectory@ on @foo@, the results will be +-- @foo/bar@ and @foo/baz@. +-- +-- Since 1.0.0 +sourceDirectory :: MonadResource m => FilePath -> Producer m FilePath +#ifdef WINDOWS +sourceDirectory = (liftIO . F.listDirectory) >=> yieldMany +#else +sourceDirectory dir = + bracketP (Dir.openDirStream $ encodeString dir) Dir.closeDirStream loop + where + loop ds = do + fp <- liftIO $ Dir.readDirStream ds + unless (Prelude.null fp) $ do + unless (fp == "." || fp == "..") + $ yield $ dir decodeString fp + loop ds +#endif + +-- | Deeply stream the contents of the given directory. +-- +-- This works the same as @sourceDirectory@, but will not return directories at +-- all. This function also takes an extra parameter to indicate whether +-- symlinks will be followed. +-- +-- Since 1.0.0 +sourceDirectoryDeep :: MonadResource m + => Bool -- ^ Follow directory symlinks + -> FilePath -- ^ Root directory + -> Producer m FilePath +sourceDirectoryDeep followSymlinks = + start + where + start :: MonadResource m => FilePath -> Producer m FilePath + start dir = sourceDirectory dir =$= awaitForever go + + go :: MonadResource m => FilePath -> Producer m FilePath + go fp = do + isFile' <- liftIO $ F.isFile fp + if isFile' + then yield fp + else do + follow' <- liftIO $ follow fp + when follow' (start fp) + + follow :: FilePath -> Prelude.IO Bool + follow p = do + let path = encodeString p + stat <- if followSymlinks + then PosixC.getFileStatus path + else PosixC.getSymbolicLinkStatus path + return (PosixC.isDirectory stat) -- | Ignore a certain number of values in the stream. -- diff --git a/Data/Conduit/Combinators/Unqualified.hs b/Data/Conduit/Combinators/Unqualified.hs --- a/Data/Conduit/Combinators/Unqualified.hs +++ b/Data/Conduit/Combinators/Unqualified.hs @@ -1,5 +1,6 @@ -- WARNING: This module is autogenerated {-# OPTIONS_HADDOCK not-home #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE GADTs #-} @@ -34,6 +35,10 @@ , sourceRandomGen , sourceRandomNGen + -- *** Filesystem + , sourceDirectory + , sourceDirectoryDeep + -- ** Consumers -- *** Pure , dropC @@ -173,6 +178,7 @@ import qualified Data.Vector.Generic.Mutable as VM import qualified Filesystem as F import Filesystem.Path (FilePath) +import Filesystem.Path.CurrentOS (encodeString) import Prelude (Bool (..), Eq (..), Int, Maybe (..), Monad (..), Num (..), Ord (..), fromIntegral, maybe, @@ -187,6 +193,7 @@ import Data.Text (Text) import qualified System.Random.MWC as MWC import Data.Conduit.Combinators.Internal +import qualified System.PosixCompat.Files as Posix -- END IMPORTS @@ -362,6 +369,35 @@ -> Producer m a sourceRandomNGen = CC.sourceRandomNGen {-# INLINE sourceRandomNGen #-} + +-- | Stream the contents of the given directory, without traversing deeply. +-- +-- This function will return /all/ of the contents of the directory, whether +-- they be files, directories, etc. +-- +-- Note that the generated filepaths will be the complete path, not just the +-- filename. In other words, if you have a directory @foo@ containing files +-- @bar@ and @baz@, and you use @sourceDirectory@ on @foo@, the results will be +-- @foo/bar@ and @foo/baz@. +-- +-- Since 1.0.0 +sourceDirectory :: MonadResource m => FilePath -> Producer m FilePath +sourceDirectory = CC.sourceDirectory +{-# INLINE sourceDirectory #-} + +-- | Deeply stream the contents of the given directory. +-- +-- This works the same as @sourceDirectory@, but will not return directories at +-- all. This function also takes an extra parameter to indicate whether +-- symlinks will be followed. +-- +-- Since 1.0.0 +sourceDirectoryDeep :: MonadResource m + => Bool -- ^ Follow directory symlinks + -> FilePath -- ^ Root directory + -> Producer m FilePath +sourceDirectoryDeep = CC.sourceDirectoryDeep +{-# INLINE sourceDirectoryDeep #-} -- | Ignore a certain number of values in the stream. -- diff --git a/conduit-combinators.cabal b/conduit-combinators.cabal --- a/conduit-combinators.cabal +++ b/conduit-combinators.cabal @@ -1,5 +1,5 @@ name: conduit-combinators -version: 0.2.1 +version: 0.2.2 synopsis: Commonly used conduit functions, for both chunked and unchunked data description: Provides a replacement for Data.Conduit.List, as well as a convenient Conduit module. homepage: https://github.com/fpco/conduit-combinators @@ -10,6 +10,7 @@ category: Data, Conduit build-type: Simple cabal-version: >=1.8 +extra-source-files: test/subdir/dummyfile.txt library exposed-modules: Conduit @@ -30,6 +31,11 @@ , bytestring , void , mwc-random + , unix-compat + if os(windows) + cpp-options: -DWINDOWS + else + build-depends: unix test-suite test hs-source-dirs: test diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -123,6 +123,17 @@ gen <- createSystemRandom x <- sourceRandomNGen gen 100 $$ sumC :: IO Double x `shouldSatisfy` (\y -> y > 10 && y < 90) + it "sourceDirectory" $ do + res <- runResourceT + $ sourceDirectory "test" $$ filterC (not . flip hasExtension "swp") =$ sinkList + sort res `shouldBe` ["test/Spec.hs", "test/subdir"] + it "sourceDirectoryDeep" $ do + res1 <- runResourceT + $ sourceDirectoryDeep False "test" $$ filterC (not . flip hasExtension "swp") =$ sinkList + res2 <- runResourceT + $ sourceDirectoryDeep True "test" $$ filterC (not . flip hasExtension "swp") =$ sinkList + sort res1 `shouldBe` ["test/Spec.hs", "test/subdir/dummyfile.txt"] + sort res1 `shouldBe` sort res2 prop "drop" $ \(T.pack -> input) count -> runIdentity (yieldMany input $$ (dropC count >>= \() -> sinkList)) `shouldBe` T.unpack (T.drop count input) diff --git a/test/subdir/dummyfile.txt b/test/subdir/dummyfile.txt new file mode 100644 --- /dev/null +++ b/test/subdir/dummyfile.txt