Walk directories in parallel (async)
authorDavid Cock <david.cock@inf.ethz.ch>
Wed, 19 Aug 2015 15:13:46 +0000 (17:13 +0200)
committerDavid Cock <david.cock@inf.ethz.ch>
Wed, 19 Aug 2015 15:13:46 +0000 (17:13 +0200)
Signed-off-by: David Cock <david.cock@inf.ethz.ch>

hake/Main.hs

index 45117a0..5fea171 100644 (file)
@@ -1,3 +1,5 @@
+import Control.Concurrent.Async
+
 import Control.Monad.Error
 
 import Data.Dynamic
@@ -117,11 +119,16 @@ listFiles root = do
         return ([], [])
     where
         walkchildren :: [FilePath] -> IO ([FilePath], [(FilePath, String)])
-        walkchildren [] = return ([], [])
-        walkchildren (child:siblings) = do
-            (allfiles, hakefiles) <- walkchild child
-            (allfilesS, hakefilesS) <- walkchildren siblings
-            return $ (allfiles ++ allfilesS, hakefiles ++ hakefilesS)
+        walkchildren children = do
+            children_async <- mapM (async.walkchild) children
+            results <- mapM wait children_async
+            return $ joinResults results
+            where
+                joinResults :: [([a],[b])] -> ([a],[b])
+                joinResults [] = ([],[])
+                joinResults ((as,bs):xs) =
+                    let (as',bs') = joinResults xs in
+                        (as ++ as', bs ++ bs')
 
         walkchild :: FilePath -> IO ([FilePath], [(FilePath, String)])
         walkchild child = do