Skip to content

Commit

Permalink
VCS: Don't run submodule commands unless necessary
Browse files Browse the repository at this point in the history
Running `git submodule` commands is harmless but clutters up the logs,
making the tests difficult to debug when run in verbose-mode.

Doesn't seem to impact performance much. I measured a ~1.5% speedup with
this code, which is well within error margins.

See: https://github.com/haskell/cabal/pull/7625/files#r709617991
  • Loading branch information
9999years committed Dec 2, 2024
1 parent 1f52963 commit 04c09e8
Show file tree
Hide file tree
Showing 4 changed files with 62 additions and 25 deletions.
2 changes: 2 additions & 0 deletions Cabal/src/Distribution/Simple/Program/Run.hs
Original file line number Diff line number Diff line change
Expand Up @@ -61,6 +61,7 @@ data ProgramInvocation = ProgramInvocation
, progInvokeInputEncoding :: IOEncoding
-- ^ TODO: remove this, make user decide when constructing 'progInvokeInput'.
, progInvokeOutputEncoding :: IOEncoding
, progInvokeWhen :: IO Bool
}

data IOEncoding
Expand All @@ -82,6 +83,7 @@ emptyProgramInvocation =
, progInvokeInput = Nothing
, progInvokeInputEncoding = IOEncodingText
, progInvokeOutputEncoding = IOEncodingText
, progInvokeWhen = pure True
}

simpleProgramInvocation
Expand Down
43 changes: 30 additions & 13 deletions cabal-install/src/Distribution/Client/VCS.hs
Original file line number Diff line number Diff line change
Expand Up @@ -96,6 +96,7 @@ import qualified Data.List as List
import qualified Data.Map as Map
import System.Directory
( doesDirectoryExist
, doesFileExist
, removeDirectoryRecursive
, removePathForcibly
)
Expand Down Expand Up @@ -468,11 +469,18 @@ vcsGit =
[programInvocation prog cloneArgs]
-- And if there's a tag, we have to do that in a second step:
++ [git (resetArgs tag) | tag <- maybeToList (srpTag repo)]
++ [ git (["submodule", "sync", "--recursive"] ++ verboseArg)
, git (["submodule", "update", "--init", "--force", "--recursive"] ++ verboseArg)
++ [ whenGitModulesExists $ git $ ["submodule", "sync", "--recursive"] ++ verboseArg
, whenGitModulesExists $ git $ ["submodule", "update", "--init", "--force", "--recursive"] ++ verboseArg
]
where
git args = (programInvocation prog args){progInvokeCwd = Just destdir}

gitModulesPath = destdir </> ".gitmodules"
whenGitModulesExists invocation =
invocation
{ progInvokeWhen = doesFileExist gitModulesPath
}

cloneArgs =
["clone", srcuri, destdir]
++ branchArgs
Expand Down Expand Up @@ -516,29 +524,38 @@ vcsGit =
-- is needed because sometimes `git submodule sync` does not actually
-- update the submodule source URL. Detailed description here:
-- https://git.coop/-/snippets/85
git localDir $ ["submodule", "deinit", "--force", "--all"] ++ verboseArg
let gitModulesDir = localDir </> ".git" </> "modules"
gitModulesExists <- doesDirectoryExist gitModulesDir
when gitModulesExists $
let dotGitModulesPath = localDir </> ".git" </> "modules"
gitModulesPath = localDir </> ".gitmodules"

-- Remove any `.git/modules` if they exist.
dotGitModulesExists <- doesDirectoryExist dotGitModulesPath
when dotGitModulesExists $ do
git localDir $ ["submodule", "deinit", "--force", "--all"] ++ verboseArg
if buildOS == Windows
then do
-- Windows can't delete some git files #10182
void $
Process.createProcess_ "attrib" $
Process.shell $
"attrib -s -h -r " <> gitModulesDir <> "\\*.* /s /d"
"attrib -s -h -r " <> dotGitModulesPath <> "\\*.* /s /d"

catch
(removePathForcibly gitModulesDir)
(\e -> if isPermissionError e then removePathForcibly gitModulesDir else throw e)
else removeDirectoryRecursive gitModulesDir
(removePathForcibly dotGitModulesPath)
(\e -> if isPermissionError e then removePathForcibly dotGitModulesPath else throw e)
else removeDirectoryRecursive dotGitModulesPath

when (resetTarget /= "HEAD") $ do
git localDir fetchArgs -- first fetch the tag if needed
git localDir setTagArgs
git localDir resetArgs -- only then reset to the commit
git localDir $ ["submodule", "sync", "--recursive"] ++ verboseArg
git localDir $ ["submodule", "update", "--force", "--init", "--recursive"] ++ verboseArg
git localDir $ ["submodule", "foreach", "--recursive"] ++ verboseArg ++ ["git clean -ffxdq"]

-- We need to check if `.gitmodules` exists _after_ the `git reset` call.
gitModulesExists <- doesFileExist gitModulesPath
when gitModulesExists $ do
git localDir $ ["submodule", "sync", "--recursive"] ++ verboseArg
git localDir $ ["submodule", "update", "--force", "--init", "--recursive"] ++ verboseArg
git localDir $ ["submodule", "foreach", "--recursive"] ++ verboseArg ++ ["git clean -ffxdq"]

git localDir $ ["clean", "-ffxdq"]
where
git :: FilePath -> [String] -> IO ()
Expand Down
28 changes: 16 additions & 12 deletions cabal-install/tests/UnitTests/Distribution/Client/VCS.hs
Original file line number Diff line number Diff line change
Expand Up @@ -923,10 +923,7 @@ vcsTestDriverGit
, mkVcsTmpDir = tmpDir
}
, vcsAddSubmodule = \_ source dest -> do
destExists <-
(||)
<$> doesFileExist (repoRoot </> dest)
<*> doesDirectoryExist (repoRoot </> dest)
destExists <- doesPathExist $ repoRoot </> dest
when destExists $ gitQuiet ["rm", "--force", dest]
-- If there is an old submodule git dir with the same name, remove it.
-- It most likely has a different URL and `git submodule add` will fai.
Expand Down Expand Up @@ -995,16 +992,23 @@ vcsTestDriverGit
verboseArg = ["--quiet" | verbosity < Verbosity.normal]

submoduleGitDir path = repoRoot </> ".git" </> "modules" </> path

dotGitModulesPath = repoRoot </> ".git" </> "modules"
gitModulesPath = repoRoot </> ".gitmodules"

deinitAndRemoveCachedSubmodules = do
gitQuiet ["submodule", "deinit", "--force", "--all"]
let gitModulesDir = repoRoot </> ".git" </> "modules"
gitModulesExists <- doesDirectoryExist gitModulesDir
when gitModulesExists $ removeDirectoryRecursive gitModulesDir
dotGitModulesExists <- doesDirectoryExist dotGitModulesPath
when dotGitModulesExists $ do
git $ ["submodule", "deinit", "--force", "--all"] ++ verboseArg
removeDirectoryRecursive dotGitModulesPath

updateSubmodulesAndCleanup = do
gitQuiet ["submodule", "sync", "--recursive"]
gitQuiet ["submodule", "update", "--init", "--recursive", "--force"]
-- Note: We need to manually add `verboseArg` here so that the embedded `git clean` command includes it as well.
gitQuiet $ ["submodule", "foreach", "--recursive", "git clean -ffxdq"] ++ verboseArg
gitModulesExists <- doesFileExist gitModulesPath
when gitModulesExists $ do
gitQuiet ["submodule", "sync", "--recursive"]
gitQuiet ["submodule", "update", "--init", "--recursive", "--force"]
-- Note: We need to manually add `verboseArg` here so that the embedded `git clean` command includes it as well.
gitQuiet $ ["submodule", "foreach", "--recursive", "git clean -ffxdq"] ++ verboseArg
gitQuiet ["clean", "-ffxdq"]

type MTimeChange = Int
Expand Down
14 changes: 14 additions & 0 deletions changelog.d/pr-10590
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
---
synopsis: "Don't run submodule commands unless necessary"
packages: [cabal-install]
prs: 10590
---

When `cabal` clones a Git repo for a `source-repository-package` listed in a
`cabal.project`, it will run various commands to check out the correct
revision, initialize submodules if they're present, and so on.

Now, `cabal` will avoid running `git submodule` commands unless the cloned
repository contains a `.gitmodules` file. This will declutter `cabal`'s debug
output by running fewer commands.

0 comments on commit 04c09e8

Please sign in to comment.