diff --git a/app/Foliage/CmdBuild.hs b/app/Foliage/CmdBuild.hs index c44b4ad..51e4118 100644 --- a/app/Foliage/CmdBuild.hs +++ b/app/Foliage/CmdBuild.hs @@ -23,6 +23,7 @@ import Distribution.Package import Distribution.Pretty (prettyShow) import Distribution.Version import Foliage.FetchURL (addFetchURLRule) +import Foliage.GitClone (addGitCloneRule) import Foliage.HackageSecurity hiding (ToJSON, toJSON) import Foliage.Meta import Foliage.Meta.Aeson () @@ -42,6 +43,7 @@ cmdBuild buildOptions = do shake opts $ do addFetchURLRule cacheDir + addGitCloneRule cacheDir addPrepareSourceRule (buildOptsInputDir buildOptions) cacheDir addPrepareSdistRule outputDirRoot phony "buildAction" (buildAction buildOptions) diff --git a/app/Foliage/GitClone.hs b/app/Foliage/GitClone.hs new file mode 100644 index 0000000..78b5c17 --- /dev/null +++ b/app/Foliage/GitClone.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + +-- | Clone a github repository into a cache directory. +module Foliage.GitClone ( + gitClone, + addGitCloneRule, +) +where + +import Development.Shake hiding (doesDirectoryExist) +import Development.Shake.Classes +import Development.Shake.FilePath +import Development.Shake.Rule +import Foliage.Meta (GitHubRepo, gitHubRepoToString) +import GHC.Generics (Generic) +import System.Directory (doesDirectoryExist) + +newtype GitClone = GitClone {repo :: GitHubRepo} + deriving (Eq, Generic) + deriving newtype (NFData) + +instance Show GitClone where + show GitClone{repo} = "gitClone " <> gitHubRepoToString repo + +instance Hashable GitClone + +instance Binary GitClone + +type instance RuleResult GitClone = FilePath + +-- | Clone given repo at given revision into the cache directory and return the working copy path. +gitClone :: GitHubRepo -> Action FilePath +gitClone repo = apply1 GitClone{repo} + +-- | Set up the 'GitClone' rule with a cache directory. +addGitCloneRule + :: FilePath + -- ^ Cache directory + -> Rules () +addGitCloneRule cacheDir = addBuiltinRule noLint noIdentity run + where + run :: BuiltinRun GitClone FilePath + run GitClone{repo} _old _mode = do + let path = cacheDir "git" gitHubRepoToString repo + + alreadyCloned <- liftIO $ doesDirectoryExist path + if alreadyCloned + then command_ [Cwd path] "git" ["fetch"] + else do + let url = "https://github.com/" <> gitHubRepoToString repo <> ".git" + command_ [] "git" ["clone", "--recursive", url, path] + + return $ RunResult{runChanged = ChangedRecomputeDiff, runStore = "", runValue = path} diff --git a/app/Foliage/Meta.hs b/app/Foliage/Meta.hs index 71d7942..c83eabb 100644 --- a/app/Foliage/Meta.hs +++ b/app/Foliage/Meta.hs @@ -24,7 +24,9 @@ module Foliage.Meta ( pattern URISource, pattern GitHubSource, GitHubRepo (..), + gitHubRepoToString, GitHubRev (..), + gitHubRevToString, UTCTime, latestRevisionNumber, packageVersionSourceToUri, @@ -53,9 +55,17 @@ import Toml qualified newtype GitHubRepo = GitHubRepo {unGitHubRepo :: Text} deriving (Show, Eq, Binary, Hashable, NFData) via Text +gitHubRepoToString :: GitHubRepo -> String +gitHubRepoToString = + T.unpack . unGitHubRepo + newtype GitHubRev = GitHubRev {unGitHubRev :: Text} deriving (Show, Eq, Binary, Hashable, NFData) via Text +gitHubRevToString :: GitHubRev -> String +gitHubRevToString = + T.unpack . unGitHubRev + data PackageVersionSource = URISource { sourceURI :: URI diff --git a/app/Foliage/PrepareSource.hs b/app/Foliage/PrepareSource.hs index 2c6762e..ea6e707 100644 --- a/app/Foliage/PrepareSource.hs +++ b/app/Foliage/PrepareSource.hs @@ -15,9 +15,9 @@ import Distribution.Pretty (prettyShow) import Distribution.Types.PackageId import Distribution.Types.PackageName (unPackageName) import Foliage.FetchURL (fetchURL) +import Foliage.GitClone (gitClone) import Foliage.Meta import Foliage.UpdateCabalFile (rewritePackageVersion) -import Foliage.Utils.GitHub (githubRepoTarballUrl) import GHC.Generics import Network.URI (URI (..)) import System.Directory qualified as IO @@ -70,8 +70,8 @@ addPrepareSourceRule inputDir cacheDir = addBuiltinRule noLint noIdentity run tarballPath <- fetchURL uri extractFromTarball tarballPath mSubdir srcDir GitHubSource repo rev mSubdir -> do - tarballPath <- fetchURL (githubRepoTarballUrl repo rev) - extractFromTarball tarballPath mSubdir srcDir + repoDir <- gitClone repo + copyGitWorktree repoDir rev mSubdir srcDir let patchesDir = inputDir unPackageName pkgName prettyShow pkgVersion "patches" hasPatches <- doesDirectoryExist patchesDir @@ -117,16 +117,29 @@ addPrepareSourceRule inputDir cacheDir = addBuiltinRule noLint noIdentity run applyMSubdir = case mSubdir of Just s -> ( s); _ -> id srcDir = applyMSubdir $ byPassSingleTopLevelDir tmpDir - cmd_ - [ "cp" - , -- copy directories recursively - "--recursive" - , -- treat DEST as a normal file - "--no-target-directory" - , -- always follow symbolic links in SOURCE - "--dereference" - , -- SOURCE - srcDir - , -- DEST - outDir - ] + copyDirectoryContents srcDir outDir + +-- | Copy package source from a git repository using 'git worktree'. +copyGitWorktree :: FilePath -> GitHubRev -> Maybe FilePath -> FilePath -> Action () +copyGitWorktree repoDir rev mSubdir outDir = do + withTempDir $ \tmpDir -> do + command_ [Cwd repoDir] "git" ["worktree", "add", tmpDir, gitHubRevToString rev] + command_ [Cwd tmpDir] "git" ["submodule", "update", "--init"] + let packageDir = maybe tmpDir (tmpDir ) mSubdir + copyDirectoryContents packageDir outDir + command_ [Cwd repoDir] "git" ["worktree", "prune"] + +-- | Copy all contents from one directory to another. +copyDirectoryContents :: FilePath -> FilePath -> Action () +copyDirectoryContents source destination = + cmd_ + [ "cp" + , -- copy directories recursively + "--recursive" + , -- treat DEST as a normal file + "--no-target-directory" + , -- always follow symbolic links in SOURCE + "--dereference" + , source + , destination + ] diff --git a/app/Foliage/Utils/GitHub.hs b/app/Foliage/Utils/GitHub.hs deleted file mode 100644 index b3eb1e1..0000000 --- a/app/Foliage/Utils/GitHub.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Foliage.Utils.GitHub ( - githubRepoTarballUrl, -) -where - -import Data.Text qualified as T -import Foliage.Meta (GitHubRepo (unGitHubRepo), GitHubRev (unGitHubRev)) -import Network.URI (URI (..), URIAuth (..), nullURI, nullURIAuth) -import System.FilePath (()) - -githubRepoTarballUrl :: GitHubRepo -> GitHubRev -> URI -githubRepoTarballUrl repo rev = - nullURI - { uriScheme = "https:" - , uriAuthority = Just nullURIAuth{uriRegName = "github.com"} - , uriPath = "/" T.unpack (unGitHubRepo repo) "tarball" T.unpack (unGitHubRev rev) - } diff --git a/foliage.cabal b/foliage.cabal index d817eea..9d5d66a 100644 --- a/foliage.cabal +++ b/foliage.cabal @@ -27,6 +27,7 @@ executable foliage Foliage.CmdCreateKeys Foliage.CmdImportIndex Foliage.FetchURL + Foliage.GitClone Foliage.HackageSecurity Foliage.Meta Foliage.Meta.Aeson @@ -39,7 +40,6 @@ executable foliage Foliage.Time Foliage.UpdateCabalFile Foliage.Utils.Aeson - Foliage.Utils.GitHub Network.URI.Orphans build-depends: diff --git a/tests/Tests.hs b/tests/Tests.hs index 20119ea..5348018 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -35,6 +35,15 @@ main = do assertFailure "entry for pkg-a-2.3.4.5 is missing" Just entry -> do entryTime entry @?= 1648534790 + , --- + testCaseSteps "git submodules" $ \step -> + inTemporaryDirectoryWithFixture "tests/fixtures/git-submodule" $ do + step "Building repository" + callCommand "foliage build" + + doesFileExist "_cache/git/cardano-scaling/foliage-test-with-submodule/README.md" @? "Missing working copy" + doesFileExist "_cache/foliage-test-with-submodule/1.0.0/README.md" @? "Missing packaged version" + doesFileExist "_cache/foliage-test-with-submodule/1.1.0/README.md" @? "Missing packaged version" , --- testCaseSteps "accepts --no-signatures" $ \step -> inTemporaryDirectoryWithFixture "tests/fixtures/simple" $ do diff --git a/tests/fixtures/git-submodule/_sources/foliage-test-with-submodule/1.0.0/meta.toml b/tests/fixtures/git-submodule/_sources/foliage-test-with-submodule/1.0.0/meta.toml new file mode 100644 index 0000000..44a1b20 --- /dev/null +++ b/tests/fixtures/git-submodule/_sources/foliage-test-with-submodule/1.0.0/meta.toml @@ -0,0 +1,2 @@ +timestamp = 2023-11-03T17:35:22+00:00 +github = { repo = "cardano-scaling/foliage-test-with-submodule", rev = "db5874494ee5bac3fa8fee07d5806fcec27a2f4e" } diff --git a/tests/fixtures/git-submodule/_sources/foliage-test-with-submodule/1.1.0/meta.toml b/tests/fixtures/git-submodule/_sources/foliage-test-with-submodule/1.1.0/meta.toml new file mode 100644 index 0000000..f748b83 --- /dev/null +++ b/tests/fixtures/git-submodule/_sources/foliage-test-with-submodule/1.1.0/meta.toml @@ -0,0 +1,2 @@ +timestamp = 2023-11-03T15:53:59+00:00 +github = { repo = "cardano-scaling/foliage-test-with-submodule", rev = "1.1.0" }