From cae3ce4ca05a6715d27219ebe59898a58c269221 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 6 Nov 2023 18:18:40 +0100 Subject: [PATCH] Make gitCheckout just an Action, no additional rule This avoids some boiler plate and works just the same. --- app/Foliage/CmdBuild.hs | 2 -- app/Foliage/GitClone.hs | 57 ------------------------------------ app/Foliage/PrepareSource.hs | 19 ++++++++++-- foliage.cabal | 1 - tests/Tests.hs | 4 +++ 5 files changed, 20 insertions(+), 63 deletions(-) delete mode 100644 app/Foliage/GitClone.hs diff --git a/app/Foliage/CmdBuild.hs b/app/Foliage/CmdBuild.hs index 51e4118..c44b4ad 100644 --- a/app/Foliage/CmdBuild.hs +++ b/app/Foliage/CmdBuild.hs @@ -23,7 +23,6 @@ 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 () @@ -43,7 +42,6 @@ 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 deleted file mode 100644 index c780cb9..0000000 --- a/app/Foliage/GitClone.hs +++ /dev/null @@ -1,57 +0,0 @@ -{-# 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, GitHubRev) -import GHC.Generics (Generic) - -data GitClone = GitClone {repo :: GitHubRepo, rev :: GitHubRev} - deriving (Eq, Generic, NFData) - -instance Show GitClone where - show GitClone{repo, rev} = "gitClone " <> show repo <> " " <> show rev - -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 -> GitHubRev -> Action FilePath -gitClone repo rev = apply1 GitClone{repo, rev} - --- | 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, rev} _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] - - command_ [Cwd path] "git" ["checkout", show rev] - command_ [Cwd path] "git" ["submodule", "update"] - - return $ RunResult{runChanged = ChangedRecomputeDiff, runStore = "", runValue = path} diff --git a/app/Foliage/PrepareSource.hs b/app/Foliage/PrepareSource.hs index 4d4ae02..40123e0 100644 --- a/app/Foliage/PrepareSource.hs +++ b/app/Foliage/PrepareSource.hs @@ -15,7 +15,6 @@ 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 @@ -70,8 +69,8 @@ addPrepareSourceRule inputDir cacheDir = addBuiltinRule noLint noIdentity run tarballPath <- fetchURL uri extractFromTarball tarballPath mSubdir srcDir GitHubSource repo rev mSubdir -> do - workDir <- gitClone repo rev - let packageDir = maybe workDir (workDir ) mSubdir + workingCopy <- gitCheckout cacheDir repo rev + let packageDir = maybe workingCopy (workingCopy ) mSubdir copyDirectoryContents packageDir srcDir let patchesDir = inputDir unPackageName pkgName prettyShow pkgVersion "patches" @@ -120,6 +119,20 @@ 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" + copyDirectoryContents :: FilePath -> FilePath -> Action () copyDirectoryContents source destination = cmd_ diff --git a/foliage.cabal b/foliage.cabal index 9d5d66a..55d3e51 100644 --- a/foliage.cabal +++ b/foliage.cabal @@ -27,7 +27,6 @@ executable foliage Foliage.CmdCreateKeys Foliage.CmdImportIndex Foliage.FetchURL - Foliage.GitClone Foliage.HackageSecurity Foliage.Meta Foliage.Meta.Aeson diff --git a/tests/Tests.hs b/tests/Tests.hs index d1639a3..5348018 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -40,6 +40,10 @@ main = do 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