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..0d57907 --- /dev/null +++ b/app/Foliage/GitClone.hs @@ -0,0 +1,55 @@ +{-# 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 +import Development.Shake.Classes +import Development.Shake.FilePath +import Development.Shake.Rule +import Foliage.Meta (GitHubRepo) +import GHC.Generics (Generic) + +newtype GitClone = GitClone {repo :: GitHubRepo} + deriving (Eq, Generic) + deriving newtype (NFData) + +instance Show GitClone where + show GitClone{repo} = "gitClone " <> show 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" show repo + + alreadyCloned <- doesDirectoryExist path + if alreadyCloned + then command_ [Cwd path] "git" ["fetch"] + else do + let url = "https://github.com/" <> show repo <> ".git" + command_ [] "git" ["clone", "--recursive", url, path] + + return $ RunResult{runChanged = ChangedRecomputeDiff, runStore = "", runValue = path} diff --git a/app/Foliage/PrepareSource.hs b/app/Foliage/PrepareSource.hs index 40123e0..d00bc46 100644 --- a/app/Foliage/PrepareSource.hs +++ b/app/Foliage/PrepareSource.hs @@ -15,6 +15,7 @@ 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 GHC.Generics @@ -69,9 +70,8 @@ addPrepareSourceRule inputDir cacheDir = addBuiltinRule noLint noIdentity run tarballPath <- fetchURL uri extractFromTarball tarballPath mSubdir srcDir GitHubSource repo rev mSubdir -> do - workingCopy <- gitCheckout cacheDir repo rev - let packageDir = maybe workingCopy (workingCopy ) mSubdir - copyDirectoryContents packageDir srcDir + repoDir <- gitClone repo + copyGitWorktree repoDir rev mSubdir srcDir let patchesDir = inputDir unPackageName pkgName prettyShow pkgVersion "patches" hasPatches <- doesDirectoryExist patchesDir @@ -119,20 +119,16 @@ addPrepareSourceRule inputDir cacheDir = addBuiltinRule noLint noIdentity run copyDirectoryContents srcDir outDir -gitCheckout :: FilePath -> GitHubRepo -> GitHubRev -> Action FilePath -gitCheckout cacheDir repo rev = do - alreadyCloned <- doesDirectoryExist path - if alreadyCloned - then command_ [Cwd path] "git" ["fetch"] - else command_ [] "git" ["clone", "--recursive", url, path] - command_ [Cwd path] "git" ["checkout", show rev] - command_ [Cwd path] "git" ["submodule", "update"] - pure path - where - path = cacheDir "git" show repo - - url = "https://github.com/" <> show repo <> ".git" +-- | 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, show rev] + command_ [Cwd tmpDir] "git" ["submodule", "update", "--init"] + let packageDir = maybe tmpDir (tmpDir ) mSubdir + copyDirectoryContents packageDir outDir +-- | Copy all contents from one directory to another. copyDirectoryContents :: FilePath -> FilePath -> Action () copyDirectoryContents source destination = cmd_ diff --git a/foliage.cabal b/foliage.cabal index 55d3e51..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