Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Submodule support #89

Open
wants to merge 8 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions app/Foliage/CmdBuild.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()
Expand All @@ -42,6 +43,7 @@ cmdBuild buildOptions = do
shake opts $
do
addFetchURLRule cacheDir
addGitCloneRule cacheDir
addPrepareSourceRule (buildOptsInputDir buildOptions) cacheDir
addPrepareSdistRule outputDirRoot
phony "buildAction" (buildAction buildOptions)
Expand Down
56 changes: 56 additions & 0 deletions app/Foliage/GitClone.hs
Original file line number Diff line number Diff line change
@@ -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
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Here you should use that _old parameter to store (inside shake itself) information from the rule previous run. From the docs:

As an example, a typical BuiltinRun will look like:

run key oldStore mode = do
    ...
    pure $ RunResult change newStore newValue

Where you have:

  • key, how to identify individual artifacts, e.g. with file names.
  • oldStore, the value stored in the database previously, e.g. the file modification time.
  • mode, either RunDependenciesSame (none of your dependencies changed, you can probably not rebuild) or RunDependenciesChanged (your dependencies changed, probably rebuild).
  • change, usually one of either ChangedNothing (no work was required) or ChangedRecomputeDiff (I reran the rule and it should be considered different).
  • newStore, the new value to store in the database, which will be passed in next time as oldStore.
  • newValue, the result that apply will return when asked for the given key.

The argument oldStore is Maybe ByteString and newStore has to be ByteString, oldStore is Nothing if it is the first time the rule runs.

E.g. you could use that 1) to detect whether you checkout out the repo before 2) perhaps remember what commit you had checkedout (not sure if it's worth it but you can do that).

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yeah I thought about using the last fetched revision in the store. It felt like an optimization though and not sure if needed. You think we should do that?

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}
10 changes: 10 additions & 0 deletions app/Foliage/Meta.hs
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,9 @@ module Foliage.Meta (
pattern URISource,
pattern GitHubSource,
GitHubRepo (..),
gitHubRepoToString,
GitHubRev (..),
gitHubRevToString,
UTCTime,
latestRevisionNumber,
packageVersionSourceToUri,
Expand Down Expand Up @@ -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
Expand Down
45 changes: 29 additions & 16 deletions app/Foliage/PrepareSource.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
]
17 changes: 0 additions & 17 deletions app/Foliage/Utils/GitHub.hs

This file was deleted.

2 changes: 1 addition & 1 deletion foliage.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@ executable foliage
Foliage.CmdCreateKeys
Foliage.CmdImportIndex
Foliage.FetchURL
Foliage.GitClone
Foliage.HackageSecurity
Foliage.Meta
Foliage.Meta.Aeson
Expand All @@ -39,7 +40,6 @@ executable foliage
Foliage.Time
Foliage.UpdateCabalFile
Foliage.Utils.Aeson
Foliage.Utils.GitHub
Network.URI.Orphans

build-depends:
Expand Down
9 changes: 9 additions & 0 deletions tests/Tests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
timestamp = 2023-11-03T17:35:22+00:00
github = { repo = "cardano-scaling/foliage-test-with-submodule", rev = "db5874494ee5bac3fa8fee07d5806fcec27a2f4e" }
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
timestamp = 2023-11-03T15:53:59+00:00
github = { repo = "cardano-scaling/foliage-test-with-submodule", rev = "1.1.0" }
Loading