par-traverse 0.2.0.0 → 0.2.1.0

raw patch · 4 files changed

+64/−35 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• LICENSE +1/−1
• par-traverse.cabal +23/−21
• src/System/Directory/Parallel.hs +36/−13

@@ -1,5 +1,9 @@ # par-traverse +## 0.2.1.0++  * Add `parTraverseAll`+ ## 0.2.0.0    * Add filter for descending into directories

@@ -1,4 +1,4 @@-Copyright Vanessa McHale (c) 2019+Copyright Vanessa McHale (c) 2019-2020  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 

@@ -1,30 +1,31 @@-cabal-version: 1.18-name: par-traverse-version: 0.2.0.0-license: BSD3-license-file: LICENSE-copyright: Copyright: (c) 2019 Vanessa McHale-maintainer: vamchale@gmail.com-author: Vanessa McHale-synopsis: Traverse a directory in parallel+cabal-version:   1.18+name:            par-traverse+version:         0.2.1.0+license:         BSD3+license-file:    LICENSE+copyright:       Copyright: (c) 2019-2020 Vanessa McHale+maintainer:      vamchale@gmail.com+author:          Vanessa McHale+synopsis:        Traverse a directory in parallel description:     Concurrent directory traversals in Haskell using [parallel-io](http://hackage.haskell.org/package/parallel-io)-category: System, Directory, Parallel, Concurrent-build-type: Simple-extra-doc-files: README.md-                 CHANGELOG.md +category:        System, Directory, Parallel, Concurrent+build-type:      Simple+extra-doc-files:+    README.md+    CHANGELOG.md+ source-repository head-    type: git+    type:     git     location: https://github.com/vmchale/phash-    subdir: par-traverse+    subdir:   par-traverse  library-    exposed-modules:-        System.Directory.Parallel-    hs-source-dirs: src+    exposed-modules:  System.Directory.Parallel+    hs-source-dirs:   src     default-language: Haskell2010-    ghc-options: -Wall+    ghc-options:      -Wall     build-depends:         base >=4.8 && <5,         parallel-io -any,@@ -32,8 +33,9 @@         filepath -any      if impl(ghc >=8.0)-        ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates-                     -Wredundant-constraints -Widentities+        ghc-options:+            -Wincomplete-uni-patterns -Wincomplete-record-updates+            -Wredundant-constraints -Widentities      if impl(ghc >=8.4)         ghc-options: -Wmissing-export-lists

@@ -1,12 +1,15 @@-module System.Directory.Parallel ( parTraverse ) where+module System.Directory.Parallel ( parTraverse+                                 , parTraverseAll+                                 ) where  import           Control.Concurrent                  (getNumCapabilities) import           Control.Concurrent.ParallelIO.Local (Pool, parallel_, withPool) import           Control.Monad                       (filterM)-import           System.Directory                    (doesDirectoryExist,-                                                      listDirectory)+import           System.Directory                    (doesDirectoryExist, listDirectory) import           System.FilePath                     ((</>)) +-- TODO: mapConcurrently?+ partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a]) partitionM _ [] = pure ([], []) partitionM f (x:xs) = do@@ -16,20 +19,40 @@         then pure (x:as, bs)         else pure (as, x:bs) -parTraverse :: (FilePath -> IO ()) -- ^ Action to execute on files-            -> (FilePath -> IO Bool) -- ^ Filter on files-            -> (FilePath -> IO Bool) -- ^ Filter on directories-            -> [FilePath] -- ^ Starting directories-            -> IO ()-parTraverse act fileP dirP dirs = do+-- | @since 0.2.1.0+parTraverseAll :: (FilePath -> IO ()) -- ^ Action to execute on files+               -> (FilePath -> IO Bool) -- ^ Filter on files+               -> (FilePath -> IO Bool) -- ^ Filter on directories+               -> [FilePath] -- ^ Starting files/directories+               -> IO ()+parTraverseAll act fileP dirP fps = do+    (dirs, files) <- partitionM doesDirectoryExist fps+    parTraverseFiles act fileP dirP dirs files+++parTraverseFiles :: (FilePath -> IO ()) -- ^ Action to execute on files+                 -> (FilePath -> IO Bool) -- ^ Filter on files+                 -> (FilePath -> IO Bool) -- ^ Filter on directories+                 -> [FilePath] -- ^ Starting directories+                 -> [FilePath] -- ^ Starting files (won't be filtered)+                 -> IO ()+parTraverseFiles act fileP dirP dirs files = do     ncpu <- getNumCapabilities     withPool ncpu $ \pool ->-        parallel_ pool $ fmap (loopPool pool) dirs+        parallel_ pool $ fmap act files ++ fmap (loopPool pool) dirs      where loopPool :: Pool -> FilePath -> IO ()           loopPool pool fp = do                 all' <- fmap (fp </>) <$> listDirectory fp-                (dirs', files) <- partitionM doesDirectoryExist all'+                -- unsafeInterleaveIO? lol+                (dirs', files') <- partitionM doesDirectoryExist all'                 dirs'' <- filterM dirP dirs'-                files' <- filterM fileP files-                parallel_ pool (fmap act files' ++ fmap (loopPool pool) dirs'')+                files'' <- filterM fileP files'+                parallel_ pool (fmap act files'' ++ fmap (loopPool pool) dirs'')++parTraverse :: (FilePath -> IO ()) -- ^ Action to execute on files+            -> (FilePath -> IO Bool) -- ^ Filter on files+            -> (FilePath -> IO Bool) -- ^ Filter on directories+            -> [FilePath] -- ^ Starting directories+            -> IO ()+parTraverse act fileP dirP dirs = parTraverseFiles act fileP dirP dirs []