Refactor lookupMany function

Development/Shake/Core.hs

@@ -466,9 +466,9 @@ need'' e init_fps = do
             -- NB: if this Need is for a generated file we have to build it again if any of the things *it* needs have changed,
             -- so we recursively invoke need in order to check if we have any changes
             nested_new_times <- need'' (e { ae_would_block_handles = would_block_handles ++ ae_would_block_handles e }) nested_fps
-            let ([], relevant_nested_new_times) = lookupMany (\nested_fp -> internalError $ "The file " ++ show nested_fp ++ " that we needed did not have a modification time in the output") nested_fps nested_new_times
-            return $ firstJust $ (\f -> zipWith f relevant_nested_new_times nested_old_times) $
-                \(fp, old_time) new_time -> guard (old_time /= new_time) >> return ("modification time of " ++ show fp ++ " has changed from " ++ show old_time ++ " to " ++ show new_time)
+            let ([], relevant_nested_new_times) = lookupRemoveMany (\nested_fp -> internalError $ "The file " ++ show nested_fp ++ " that we needed did not have a modification time in the output") nested_fps nested_new_times
+            return $ firstJust $ (\f -> zipWith3 f nested_fps relevant_nested_new_times nested_old_times) $
+                \fp old_time new_time -> guard (old_time /= new_time) >> return ("modification time of " ++ show fp ++ " has changed from " ++ show old_time ++ " to " ++ show new_time)
 
         find_all_rules :: [(n, Either (Entry n) (BuildingWaitHandle n))] -> [([n], [n], IO [(n, Entry n)])]
                        -> [n] -> [BuildingWaitHandle n] -> PureDatabase n
@@ -579,7 +579,7 @@ need'' e init_fps = do
         mtimes <- rule
         -- We restrict the list of modification times returned to just those files that were actually needed by the user:
         -- we don't want to add a a dependency on those files that were incidentally created by the rule
-        return $ snd $ lookupMany no_mtime_error unclean_fps mtimes
+        return $ unclean_fps `zip` lookupMany no_mtime_error unclean_fps mtimes
 
     -- NB: we communicate the ModTimes of files that we were waiting on the completion of via the BuildingWaitHandle
     clean_times <- forM cleans $ \(clean_fp, ei_mtime_wait_handle) -> fmap ((,) clean_fp) $ case ei_mtime_wait_handle of
@@ -749,9 +749,9 @@ concurrencyChartURL (width, height) xys
 
 markCleans :: Namespace n => Database n -> History n -> [n] -> [(n, Entry n)] -> IO ()
 markCleans db_mvar nested_hist fps nested_times = modifyMVar_ db_mvar (return . go)
-  where ([], relevant_nested_times) = lookupMany (\fp -> internalError $ "Rule did not return modification time for the file " ++ show fp ++ " that it claimed to create") fps nested_times
+  where ([], relevant_nested_times) = lookupRemoveMany (\fp -> internalError $ "Rule did not return modification time for the file " ++ show fp ++ " that it claimed to create") fps nested_times
 
-        go init_db = foldr (\(fp, nested_time) db -> M.insert fp (Clean nested_hist nested_time) db) init_db relevant_nested_times
+        go init_db = foldr (\(fp, nested_time) db -> M.insert fp (Clean nested_hist nested_time) db) init_db (fps `zip` relevant_nested_times)
 
 
 appendHistory :: QA n -> Act n o ()

Development/Shake/Core/Utilities.hs

@@ -46,12 +46,17 @@ lookupRemove _      []           = Nothing
 lookupRemove want_k ((k, v):kvs) | want_k == k = Just (v, kvs)
                                  | otherwise   = fmap (second ((k, v) :)) $ lookupRemove want_k kvs
 
+lookupRemoveMany :: Eq k
+                 => (forall r. k -> r)
+                 -> [k] -> [(k, v)] -> ([(k, v)], [v])
+lookupRemoveMany missing_error ks init_kvs
+  = mapAccumL (\kvs k -> case lookupRemove k kvs of Nothing -> missing_error k
+                                                    Just (v, kvs') -> (kvs', v)) init_kvs ks
+
 lookupMany :: Eq k
            => (forall r. k -> r)
-           -> [k] -> [(k, v)] -> ([(k, v)], [(k, v)])
-lookupMany missing_error ks init_kvs
-  = mapAccumL (\kvs k -> case lookupRemove k kvs of Nothing -> missing_error k
-                                                    Just (v, kvs') -> (kvs', (k, v))) init_kvs ks
+           -> [k] -> [(k, v)] -> [v]
+lookupMany missing_error ks = snd . lookupRemoveMany missing_error ks
 
 fixEq :: Eq a => (a -> a) -> a -> a
 fixEq f x | x == x'   = x