Improve preprocessing speed by taking the common path first

haskell · Jan 30, 2025 · a4f8918 · a4f8918
1 parent e7bc62b
commit a4f8918
Showing 1 changed file with 59 additions and 56 deletions.
diff --git a/Cabal/src/Distribution/Simple/PreProcess.hs b/Cabal/src/Distribution/Simple/PreProcess.hs
@@ -292,63 +292,66 @@ preprocessFile
   -- ^ fail on missing file
   -> IO ()
 preprocessFile mbWorkDir searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes handlers failOnMissing = do
-  -- look for files in the various source dirs with this module name
-  -- and a file extension of a known preprocessor
-  psrcFiles <- findFileCwdWithExtension' mbWorkDir (map fst handlers) searchLoc baseFile
-  case psrcFiles of
-    -- no preprocessor file exists, look for an ordinary source file
-    -- just to make sure one actually exists at all for this module.
-
-    -- Note [Dodgy build dirs for preprocessors]
-    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-    -- By looking in the target/output build dir too, we allow
-    -- source files to appear magically in the target build dir without
-    -- any corresponding "real" source file. This lets custom Setup.hs
-    -- files generate source modules directly into the build dir without
-    -- the rest of the build system being aware of it (somewhat dodgy)
+  bsrcFiles <- findFileCwdWithExtension mbWorkDir builtinSuffixes (searchLoc ++ [buildAsSrcLoc]) baseFile
+  case bsrcFiles of
+    -- found a non-processable file in one of the source dirs
+    Just _ -> do
+      pure ()
     Nothing -> do
-      bsrcFiles <- findFileCwdWithExtension mbWorkDir builtinSuffixes (buildAsSrcLoc : searchLoc) baseFile
-      case (bsrcFiles, failOnMissing) of
-        (Nothing, True) ->
-          dieWithException verbosity $
-            CantFindSourceForPreProcessFile $
-              "can't find source for "
-                ++ getSymbolicPath baseFile
-                ++ " in "
-                ++ intercalate ", " (map getSymbolicPath searchLoc)
-        _ -> return ()
-    -- found a pre-processable file in one of the source dirs
-    Just (psrcLoc, psrcRelFile) -> do
-      let (srcStem, ext) = splitExtension $ getSymbolicPath psrcRelFile
-          psrcFile = psrcLoc </> psrcRelFile
-          pp =
-            fromMaybe
-              (error "Distribution.Simple.PreProcess: Just expected")
-              (lookup (Suffix $ safeTail ext) handlers)
-      -- Preprocessing files for 'sdist' is different from preprocessing
-      -- for 'build'.  When preprocessing for sdist we preprocess to
-      -- avoid that the user has to have the preprocessors available.
-      -- ATM, we don't have a way to specify which files are to be
-      -- preprocessed and which not, so for sdist we only process
-      -- platform independent files and put them into the 'buildLoc'
-      -- (which we assume is set to the temp. directory that will become
-      -- the tarball).
-      -- TODO: eliminate sdist variant, just supply different handlers
-      when (not forSDist || forSDist && platformIndependent pp) $ do
-        -- look for existing pre-processed source file in the dest dir to
-        -- see if we really have to re-run the preprocessor.
-        ppsrcFiles <- findFileCwdWithExtension mbWorkDir builtinSuffixes [buildAsSrcLoc] baseFile
-        recomp <- case ppsrcFiles of
-          Nothing -> return True
-          Just ppsrcFile ->
-            i psrcFile `moreRecentFile` i ppsrcFile
-        when recomp $ do
-          let destDir = i buildLoc </> takeDirectory srcStem
-          createDirectoryIfMissingVerbose verbosity True destDir
-          runPreProcessorWithHsBootHack
-            pp
-            (getSymbolicPath $ psrcLoc, getSymbolicPath $ psrcRelFile)
-            (getSymbolicPath $ buildLoc, srcStem <.> "hs")
+      -- look for files in the various source dirs with this module name
+      -- and a file extension of a known preprocessor
+      psrcFiles <- findFileCwdWithExtension' mbWorkDir (map fst handlers) searchLoc baseFile
+      case psrcFiles of
+        -- no preprocessor file exists, look for an ordinary source file
+        -- just to make sure one actually exists at all for this module.
+
+        -- Note [Dodgy build dirs for preprocessors]
+        -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        -- By looking in the target/output build dir too, we allow
+        -- source files to appear magically in the target build dir without
+        -- any corresponding "real" source file. This lets custom Setup.hs
+        -- files generate source modules directly into the build dir without
+        -- the rest of the build system being aware of it (somewhat dodgy)
+        Nothing ->
+          when failOnMissing $ do
+            dieWithException verbosity $
+              CantFindSourceForPreProcessFile $
+                "can't find source for "
+                  ++ getSymbolicPath baseFile
+                  ++ " in "
+                  ++ intercalate ", " (map getSymbolicPath searchLoc)
+        Just (psrcLoc, psrcRelFile) -> do
+          let (srcStem, ext) = splitExtension $ getSymbolicPath psrcRelFile
+              psrcFile = psrcLoc </> psrcRelFile
+              pp =
+                fromMaybe
+                  (error "Distribution.Simple.PreProcess: Just expected")
+                  (lookup (Suffix $ safeTail ext) handlers)
+          -- Preprocessing files for 'sdist' is different from preprocessing
+          -- for 'build'.  When preprocessing for sdist we preprocess to
+          -- avoid that the user has to have the preprocessors available.
+          -- ATM, we don't have a way to specify which files are to be
+          -- preprocessed and which not, so for sdist we only process
+          -- platform independent files and put them into the 'buildLoc'
+          -- (which we assume is set to the temp. directory that will become
+          -- the tarball).
+          -- TODO: eliminate sdist variant, just supply different handlers
+          when (not forSDist || forSDist && platformIndependent pp) $ do
+            -- look for existing pre-processed source file in the dest dir to
+            -- see if we really have to re-run the preprocessor.
+            ppsrcFiles <- findFileCwdWithExtension mbWorkDir builtinSuffixes [buildAsSrcLoc] baseFile
+            recomp <- case ppsrcFiles of
+              Nothing -> return True
+              Just ppsrcFile ->
+                i psrcFile `moreRecentFile` i ppsrcFile
+            when recomp $ do
+              let destDir = i buildLoc </> takeDirectory srcStem
+              createDirectoryIfMissingVerbose verbosity True destDir
+              runPreProcessorWithHsBootHack
+                pp
+                (getSymbolicPath $ psrcLoc, getSymbolicPath $ psrcRelFile)
+                (getSymbolicPath $ buildLoc, srcStem <.> "hs")
+
   where
     i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
     buildAsSrcLoc :: SymbolicPath Pkg (Dir Source)