From b24fa3272461e962497a4772eb1346c46911b861 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Tue, 5 Feb 2019 23:35:39 +0100 Subject: [PATCH] Add support for repositories with submodules `git archive` doesn't include files from git submodules in the generated archive. This patch uses `git submodule foreach` to explicitly generate an archive for each submodule and to append it to the main one with `tar` command. We also export `withRepo` which can be useful independently of repo archive creation. --- ChangeLog.md | 1 + subs/pantry/src/Pantry/Repo.hs | 86 ++++++++++++++----- test/integration/tests/git-submodules/Main.hs | 47 ++++++++++ 3 files changed, 114 insertions(+), 20 deletions(-) create mode 100644 test/integration/tests/git-submodules/Main.hs diff --git a/ChangeLog.md b/ChangeLog.md index 7033542d89..573fbdd720 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -16,6 +16,7 @@ Major changes: * Support for archives and repos in the `packages` section has been removed. Instead, you must use `extra-deps` for such dependencies. `packages` now only supports local filepaths. + * Add support for Git repositories containing (recursive) submodules. * Addition of new configuration options for specifying a "pantry tree" key, which provides more reproducibility around builds, and (in the future) will be used for more efficient package diff --git a/subs/pantry/src/Pantry/Repo.hs b/subs/pantry/src/Pantry/Repo.hs index 7f104d55c0..6db5927c95 100644 --- a/subs/pantry/src/Pantry/Repo.hs +++ b/subs/pantry/src/Pantry/Repo.hs @@ -6,6 +6,9 @@ module Pantry.Repo , fetchRepos , getRepo , getRepoKey + , createRepoArchive + , withRepoArchive + , withRepo ) where import Pantry.Types @@ -71,26 +74,82 @@ getRepo' => Repo -> RawPackageMetadata -> RIO env Package -getRepo' repo@(Repo url commit repoType' subdir) rpm = - withSystemTempDirectory "get-repo" $ +getRepo' repo rpm = do + withRepoArchive repo $ \tarball -> do + abs' <- resolveFile' tarball + getArchivePackage + (RPLIRepo repo rpm) + RawArchive + { raLocation = ALFilePath $ ResolvedPath + { resolvedRelative = RelFilePath $ T.pack tarball + , resolvedAbsolute = abs' + } + , raHash = Nothing + , raSize = Nothing + , raSubdir = repoSubdir repo + } + rpm + +-- | Fetch a repository and create a (temporary) tar archive from it. Pass the +-- path of the generated tarball to the given action. +withRepoArchive + :: forall env a. (HasLogFunc env, HasProcessContext env) + => Repo + -> (FilePath -> RIO env a) + -> RIO env a +withRepoArchive repo action = + withSystemTempDirectory "with-repo-archive" $ \tmpdir -> do + let tarball = tmpdir "foo.tar" + createRepoArchive repo tarball + action tarball + +-- | Create a tarball containing files from a repository +createRepoArchive + :: forall env. (HasLogFunc env, HasProcessContext env) + => Repo + -> FilePath -- ^ Output tar archive filename + -> RIO env () +createRepoArchive repo tarball = do + let runCommand cmd args = void $ proc cmd args readProcess_ + + withRepo repo $ case repoType repo of + RepoGit -> do + runCommand "git" ["-c", "core.autocrlf=false", "archive", "-o", tarball, "HEAD"] + -- also include submodules files: use `git submodule foreach` to + -- execute `git archive` in each submodule and to append the + -- generated archive to the main one with `tar -A` + runCommand "git" + [ "submodule", "foreach", "--recursive" + , "git -c core.autocrlf=false archive --prefix=$displaypath/ -o bar.tar HEAD" + <> " && if [ -f bar.tar ]; then tar -Af " <> tarball <> " bar.tar ; fi" + ] + RepoHg -> runCommand "hg" ["archive", tarball, "-X", ".hg_archival.txt"] + + +-- | Clone the repository and execute the action with the working +-- directory set to the repository root. +withRepo + :: forall env a. (HasLogFunc env, HasProcessContext env) + => Repo + -> RIO env a + -> RIO env a +withRepo repo@(Repo url commit repoType' _subdir) action = + withSystemTempDirectory "with-repo" $ \tmpdir -> withWorkingDir tmpdir $ do let suffix = "cloned" dir = tmpdir suffix - tarball = tmpdir "foo.tar" - let (commandName, resetArgs, submoduleArgs, archiveArgs) = + let (commandName, resetArgs, submoduleArgs) = case repoType' of RepoGit -> ( "git" , ["reset", "--hard", T.unpack commit] , Just ["submodule", "update", "--init", "--recursive"] - , ["-c", "core.autocrlf=false", "archive", "-o", tarball, "HEAD"] ) RepoHg -> ( "hg" , ["update", "-C", T.unpack commit] , Nothing - , ["archive", tarball, "-X", ".hg_archival.txt"] ) let runCommand args = void $ proc commandName args readProcess_ @@ -113,17 +172,4 @@ getRepo' repo@(Repo url commit repoType' subdir) rpm = -- ENABLE_VIRTUAL_TERMINAL_PROCESSING flag for native terminals. The -- folowing hack re-enables the lost ANSI-capability. when osIsWindows $ void $ liftIO $ hSupportsANSIWithoutEmulation stdout - runCommand archiveArgs - abs' <- resolveFile' tarball - getArchivePackage - (RPLIRepo repo rpm) - RawArchive - { raLocation = ALFilePath $ ResolvedPath - { resolvedRelative = RelFilePath $ T.pack tarball - , resolvedAbsolute = abs' - } - , raHash = Nothing - , raSize = Nothing - , raSubdir = subdir - } - rpm + action diff --git a/test/integration/tests/git-submodules/Main.hs b/test/integration/tests/git-submodules/Main.hs new file mode 100644 index 0000000000..219ec1d5ab --- /dev/null +++ b/test/integration/tests/git-submodules/Main.hs @@ -0,0 +1,47 @@ +import StackTest +import System.Directory (createDirectoryIfMissing,withCurrentDirectory) + +main :: IO () +main = do + let + gitInit = do + runShell "git init ." + runShell "git config user.name Test" + runShell "git config user.email test@test.com" + + createDirectoryIfMissing True "tmpSubSubRepo" + withCurrentDirectory "tmpSubSubRepo" $ do + gitInit + stack ["new", "pkg ", defaultResolverArg] + runShell "git add pkg" + runShell "git commit -m SubSubCommit" + + createDirectoryIfMissing True "tmpSubRepo" + withCurrentDirectory "tmpSubRepo" $ do + gitInit + runShell "git submodule add ../tmpSubSubRepo sub" + runShell "git commit -a -m SubCommit" + + createDirectoryIfMissing True "tmpRepo" + withCurrentDirectory "tmpRepo" $ do + gitInit + runShell "git submodule add ../tmpSubRepo sub" + runShell "git commit -a -m Commit" + + stack ["new", defaultResolverArg, "tmpPackage"] + + withCurrentDirectory "tmpPackage" $ do + -- add git dependency on repo with recursive submodules + runShell "echo 'extra-deps:' >> stack.yaml" + runShell "echo \"- git: $(cd ../tmpRepo && pwd)\" >> stack.yaml" + runShell "echo \" commit: $(cd ../tmpRepo && git rev-parse HEAD)\" >> stack.yaml" + runShell "echo ' subdir: sub/sub/pkg' >> stack.yaml" + + -- Setup the package + stack ["setup"] + + -- cleanup + removeDirIgnore "tmpRepo" + removeDirIgnore "tmpSubRepo" + removeDirIgnore "tmpSubSubRepo" + removeDirIgnore "tmpPackage"