From a047b773699016d556644b6fa99418db553c2258 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Tue, 8 Oct 2024 16:14:56 +0100 Subject: [PATCH 1/2] Avoid globbing the spago cache folder when building --- src/Spago/Command/Fetch.purs | 2 +- src/Spago/Command/Uninstall.purs | 4 +- src/Spago/Config.purs | 62 ++++++++++++++----- src/Spago/Glob.purs | 18 ++++-- src/Spago/Purs/Graph.purs | 2 +- ...antic-instructions-installation-result.txt | 2 +- test-fixtures/publish-no-config.txt | 2 +- test-fixtures/uninstall-remove-src-deps.txt | 2 +- test-fixtures/uninstall-remove-test-deps.txt | 2 +- test/Spago/Glob.purs | 21 ++++--- 10 files changed, 78 insertions(+), 39 deletions(-) diff --git a/src/Spago/Command/Fetch.purs b/src/Spago/Command/Fetch.purs index 704f41adf..7d246661b 100644 --- a/src/Spago/Command/Fetch.purs +++ b/src/Spago/Command/Fetch.purs @@ -139,7 +139,7 @@ run { packages: packagesRequestedToInstall, ensureRanges, isTest, isRepl } = do Nothing -> currentWorkspace Just { newWorkspacePackage } -> currentWorkspace { packageSet = currentWorkspace.packageSet - { lockfile = Left "Lockfile is out of date (installing new packages)" + { lockfile = Left "Lockfile is out of date (reason: installing new packages)" -- If we are installing packages, we need to add the new deps to the selected package , buildType = case currentWorkspace.packageSet.buildType of RegistrySolverBuild packageMap -> RegistrySolverBuild $ Map.insert newWorkspacePackage.package.name (WorkspacePackage newWorkspacePackage) packageMap diff --git a/src/Spago/Command/Uninstall.purs b/src/Spago/Command/Uninstall.purs index d07c4c1fd..b80ddc47b 100644 --- a/src/Spago/Command/Uninstall.purs +++ b/src/Spago/Command/Uninstall.purs @@ -68,7 +68,7 @@ run args = do newWorkspace = workspace { packageSet = workspace.packageSet - { lockfile = Left "Lockfile is out of date (installing new packages)" + { lockfile = Left "Lockfile is out of date (reason: installing new packages)" -- If we are installing packages, we need to add the new deps to the selected package , buildType = case workspace.packageSet.buildType of RegistrySolverBuild packageMap -> RegistrySolverBuild $ Map.insert newWorkspacePackage.package.name (WorkspacePackage newWorkspacePackage) packageMap @@ -78,7 +78,7 @@ run args = do } local (_ { workspace = newWorkspace }) do - void $ writeNewLockfile "Lockfile is out of date (uninstalled packages)" + void $ writeNewLockfile "Lockfile is out of date (reason: uninstalled packages)" where writeNewLockfile reason = do diff --git a/src/Spago/Config.purs b/src/Spago/Config.purs index 0f510f0fa..ca42a8a5c 100644 --- a/src/Spago/Config.purs +++ b/src/Spago/Config.purs @@ -196,11 +196,16 @@ readWorkspace { maybeSelectedPackage, pureBuild, migrateConfig } = do , "See the relevant documentation here: https://github.com/purescript/spago#the-workspace" ] Right config@{ yaml: { workspace: Just workspace, package }, doc } -> do + logDebug "Read the root config" doMigrateConfig "spago.yaml" config pure { workspace, package, workspaceDoc: doc } logDebug "Gathering all the spago configs in the tree..." - otherConfigPaths <- liftAff $ Glob.gitignoringGlob Paths.cwd [ "**/spago.yaml" ] + otherConfigPaths <- liftAff $ Glob.gitignoringGlob + { cwd: Paths.cwd + , includePatterns: [ "**/spago.yaml" ] + , ignorePatterns: [ "**/node_modules/**", "**/.spago/**" ] + } unless (Array.null otherConfigPaths) do logDebug $ [ toDoc "Found packages at these paths:", Log.indent $ Log.lines (map toDoc otherConfigPaths) ] @@ -300,8 +305,10 @@ readWorkspace { maybeSelectedPackage, pureBuild, migrateConfig } = do true, _ -> do logDebug "Using lockfile because of --pure flag" pure (Right contents) - false, true -> pure (Left "Lockfile is out of date") - false, false -> do + false, lockfileIsOutOfDate@{ result: true } -> do + logDebug $ "Reason for recomputing the lockfile: " <> show lockfileIsOutOfDate + pure $ Left $ "Lockfile is out of date (reason: " <> lockfileIsOutOfDate.reasons <> ")" + false, { result: false } -> do logDebug "Lockfile is up to date, using it" pure (Right contents) @@ -455,22 +462,45 @@ workspacePackageToLockfilePackage { path, package } = Tuple package.name , test: { dependencies: foldMap _.dependencies package.test, build_plan: mempty } } -shouldComputeNewLockfile :: { workspace :: Core.WorkspaceConfig, workspacePackages :: Map PackageName WorkspacePackage } -> Lock.WorkspaceLock -> Boolean +type LockfileRecomputeResult = + { workspacesDontMatch :: Boolean + , extraPackagesDontMatch :: Boolean + , packageSetAddressIsDifferent :: Boolean + , packageSetIsLocal :: Boolean + , result :: Boolean + , reasons :: String + } + +shouldComputeNewLockfile :: { workspace :: Core.WorkspaceConfig, workspacePackages :: Map PackageName WorkspacePackage } -> Lock.WorkspaceLock -> LockfileRecomputeResult shouldComputeNewLockfile { workspace, workspacePackages } workspaceLock = - -- the workspace packages should exactly match, except for the needed_by field, which is filled in during build plan construction - ((workspacePackageToLockfilePackage >>> snd <$> workspacePackages) /= (eraseBuildPlan <$> workspaceLock.packages)) - -- and the extra packages should exactly match - || (fromMaybe Map.empty workspace.extraPackages /= workspaceLock.extra_packages) - -- and the package set address needs to match - we have no way to match the package set contents at this point, so we let it be - || (workspace.packageSet /= map _.address workspaceLock.package_set) - -- and the package set is not a local file - if it is then we always recompute the lockfile because we have no way to check if it's changed - || - ( case workspace.packageSet of - Just (Core.SetFromPath _) -> true - _ -> false - ) + { workspacesDontMatch + , extraPackagesDontMatch + , packageSetAddressIsDifferent + , packageSetIsLocal + , result: workspacesDontMatch || extraPackagesDontMatch || packageSetAddressIsDifferent || packageSetIsLocal + , reasons: String.joinWith ", " $ Array.mapMaybe identity + [ explainReason workspacesDontMatch "workspace packages changed" + , explainReason extraPackagesDontMatch "extraPackages changed" + , explainReason packageSetAddressIsDifferent "package set address changed" + , explainReason packageSetIsLocal "package set is local" + ] + } where eraseBuildPlan = _ { core { build_plan = mempty }, test { build_plan = mempty } } + -- surely this already exists + explainReason flag reason = if flag then Just reason else Nothing + + -- Conditions for recomputing the lockfile: + -- 1. the workspace packages should exactly match, except for the needed_by field, which is filled in during build plan construction + workspacesDontMatch = (workspacePackageToLockfilePackage >>> snd <$> workspacePackages) /= (eraseBuildPlan <$> workspaceLock.packages) + -- 2. the extra packages should exactly match + extraPackagesDontMatch = fromMaybe Map.empty workspace.extraPackages /= workspaceLock.extra_packages + -- 3. the package set address needs to match - we have no way to match the package set contents at this point, so we let it be + packageSetAddressIsDifferent = workspace.packageSet /= map _.address workspaceLock.package_set + -- 4. the package set is not a local file - if it is then we always recompute the lockfile because we have no way to check if it's changed + packageSetIsLocal = case workspace.packageSet of + Just (Core.SetFromPath _) -> true + _ -> false getPackageLocation :: PackageName -> Package -> FilePath getPackageLocation name = Paths.mkRelative <<< case _ of diff --git a/src/Spago/Glob.purs b/src/Spago/Glob.purs index 29838fcea..4b53ee67b 100644 --- a/src/Spago/Glob.purs +++ b/src/Spago/Glob.purs @@ -89,8 +89,8 @@ gitignoreFileToGlob base = | leadingSlash pattern = dropPrefixSlash pattern <> "/**" | otherwise = "**/" <> pattern <> "/**" -fsWalk :: String -> Array String -> Array String -> Aff (Array Entry) -fsWalk cwd ignorePatterns includePatterns = Aff.makeAff \cb -> do +fsWalk :: GlobParams -> Aff (Array Entry) +fsWalk { cwd, ignorePatterns, includePatterns } = Aff.makeAff \cb -> do let includeMatcher = testGlob { ignore: [], include: includePatterns } -- Pattern for directories which can be outright ignored. @@ -204,6 +204,14 @@ fsWalk cwd ignorePatterns includePatterns = Aff.makeAff \cb -> do pure $ Aff.Canceler \_ -> void $ liftEffect $ Ref.write true canceled -gitignoringGlob :: String -> Array String -> Aff (Array String) -gitignoringGlob dir patterns = map (withForwardSlashes <<< Path.relative dir <<< _.path) - <$> fsWalk dir [ ".git" ] patterns +type GlobParams = { ignorePatterns :: Array String, includePatterns :: Array String, cwd :: FilePath } + +gitignoringGlob :: GlobParams -> Aff (Array String) +gitignoringGlob { cwd, ignorePatterns, includePatterns } = map (withForwardSlashes <<< Path.relative cwd <<< _.path) + <$> fsWalk + { cwd + , ignorePatterns: ignorePatterns + -- The ones in the base directory are always ignored + <> [ ".git", "spago.yaml" ] + , includePatterns + } diff --git a/src/Spago/Purs/Graph.purs b/src/Spago/Purs/Graph.purs index b881d8369..03f99b2dd 100644 --- a/src/Spago/Purs/Graph.purs +++ b/src/Spago/Purs/Graph.purs @@ -127,7 +127,7 @@ getModuleGraphWithPackage (ModuleGraph graph) = do pure packageGraph compileGlob :: forall a. FilePath -> Spago a (Array FilePath) -compileGlob sourcePath = liftAff $ Glob.gitignoringGlob Paths.cwd [ withForwardSlashes sourcePath ] +compileGlob sourcePath = liftAff $ Glob.gitignoringGlob { cwd: Paths.cwd, includePatterns: [ withForwardSlashes sourcePath ], ignorePatterns: [] } -------------------------------------------------------------------------------- -- Package graph diff --git a/test-fixtures/pedantic/pedantic-instructions-installation-result.txt b/test-fixtures/pedantic/pedantic-instructions-installation-result.txt index 5c545401a..346c35305 100644 --- a/test-fixtures/pedantic/pedantic-instructions-installation-result.txt +++ b/test-fixtures/pedantic/pedantic-instructions-installation-result.txt @@ -4,7 +4,7 @@ Reading Spago workspace configuration... Adding 1 package to the config in spago.yaml Downloading dependencies... -Lockfile is out of date (installing new packages), generating it... +Lockfile is out of date (reason: installing new packages), generating it... Lockfile written to spago.lock. Please commit this file. Building... Src Lib All diff --git a/test-fixtures/publish-no-config.txt b/test-fixtures/publish-no-config.txt index e74d35b26..14486843c 100644 --- a/test-fixtures/publish-no-config.txt +++ b/test-fixtures/publish-no-config.txt @@ -3,7 +3,7 @@ Reading Spago workspace configuration... ✓ Selecting package to build: aaaa Downloading dependencies... -Lockfile is out of date, generating it... +Lockfile is out of date (reason: workspace packages changed), generating it... Lockfile written to spago.lock. Please commit this file. Building... Src Lib All diff --git a/test-fixtures/uninstall-remove-src-deps.txt b/test-fixtures/uninstall-remove-src-deps.txt index d7df7b775..06cf8c24b 100644 --- a/test-fixtures/uninstall-remove-src-deps.txt +++ b/test-fixtures/uninstall-remove-src-deps.txt @@ -3,5 +3,5 @@ Reading Spago workspace configuration... ✓ Selecting package to build: uninstall-tests Removing the following source dependencies: either -Lockfile is out of date (uninstalled packages), generating it... +Lockfile is out of date (reason: uninstalled packages), generating it... Lockfile written to spago.lock. Please commit this file. diff --git a/test-fixtures/uninstall-remove-test-deps.txt b/test-fixtures/uninstall-remove-test-deps.txt index 6158bc175..ad3f434a8 100644 --- a/test-fixtures/uninstall-remove-test-deps.txt +++ b/test-fixtures/uninstall-remove-test-deps.txt @@ -3,5 +3,5 @@ Reading Spago workspace configuration... ✓ Selecting package to build: uninstall-tests Removing the following test dependencies: either -Lockfile is out of date (uninstalled packages), generating it... +Lockfile is out of date (reason: uninstalled packages), generating it... Lockfile written to spago.lock. Please commit this file. diff --git a/test/Spago/Glob.purs b/test/Spago/Glob.purs index 45129b970..9356b4e91 100644 --- a/test/Spago/Glob.purs +++ b/test/Spago/Glob.purs @@ -46,40 +46,41 @@ globTmpDir m = Aff.bracket make cleanup m spec :: Spec Unit spec = Spec.around globTmpDir do + let glob cwd includePatterns = Glob.gitignoringGlob { cwd, includePatterns, ignorePatterns: [] } Spec.describe "glob" do Spec.describe "glob behavior" do Spec.it "'**/..' matches 0 or more directories" \p -> do - a <- Glob.gitignoringGlob (Path.concat [ p, "fruits/left" ]) [ "**/apple" ] - b <- Glob.gitignoringGlob (Path.concat [ p, "fruits" ]) [ "**/apple" ] + a <- glob (Path.concat [ p, "fruits/left" ]) [ "**/apple" ] + b <- glob (Path.concat [ p, "fruits" ]) [ "**/apple" ] Array.sort a `Assert.shouldEqual` [ "apple" ] Array.sort b `Assert.shouldEqual` [ "left/apple", "right/apple" ] Spec.it "'../**/..' matches 0 or more directories" \p -> do - a <- Glob.gitignoringGlob p [ "fruits/**/apple" ] + a <- glob p [ "fruits/**/apple" ] Array.sort a `Assert.shouldEqual` [ "fruits/left/apple", "fruits/right/apple" ] Spec.it "'../**' matches 0 or more directories" \p -> do - a <- Glob.gitignoringGlob p [ "fruits/left/**" ] + a <- glob p [ "fruits/left/**" ] Array.sort a `Assert.shouldEqual` [ "fruits/left", "fruits/left/apple" ] Spec.describe "gitignoringGlob" do Spec.it "when no .gitignore, yields all matches" \p -> do - a <- Glob.gitignoringGlob p [ "**/apple" ] + a <- glob p [ "**/apple" ] Array.sort a `Assert.shouldEqual` [ "fruits/left/apple", "fruits/right/apple", "src/fruits/apple" ] Spec.it "respects a .gitignore pattern that doesn't conflict with search" \p -> do FS.writeTextFile (Path.concat [ p, ".gitignore" ]) "fruits/right" - a <- Glob.gitignoringGlob p [ "fruits/**/apple" ] + a <- glob p [ "fruits/**/apple" ] Array.sort a `Assert.shouldEqual` [ "fruits/left/apple" ] Spec.it "respects some .gitignore patterns" \p -> do FS.writeTextFile (Path.concat [ p, ".gitignore" ]) "fruits\nfruits/right" - a <- Glob.gitignoringGlob p [ "fruits/**/apple" ] + a <- glob p [ "fruits/**/apple" ] Array.sort a `Assert.shouldEqual` [ "fruits/left/apple" ] Spec.it "respects a negated .gitignore pattern" \p -> do FS.writeTextFile (Path.concat [ p, ".gitignore" ]) "!/fruits/left/apple\n/fruits/**/apple" - a <- Glob.gitignoringGlob p [ "**/apple" ] + a <- glob p [ "**/apple" ] Array.sort a `Assert.shouldEqual` [ "fruits/left/apple", "src/fruits/apple" ] for_ [ "/fruits", "fruits", "fruits/", "**/fruits", "fruits/**", "**/fruits/**" ] \gitignore -> do @@ -87,7 +88,7 @@ spec = Spec.around globTmpDir do ("does not respect a .gitignore pattern that conflicts with search: " <> gitignore) \p -> do FS.writeTextFile (Path.concat [ p, ".gitignore" ]) gitignore - a <- Glob.gitignoringGlob p [ "fruits/**/apple" ] + a <- glob p [ "fruits/**/apple" ] Array.sort a `Assert.shouldEqual` [ "fruits/left/apple", "fruits/right/apple" ] Spec.it "is stacksafe" \p -> do @@ -101,5 +102,5 @@ spec = Spec.around globTmpDir do FS.writeTextFile (Path.concat [ p, "fruits", ".gitignore" ]) hugeGitignore FS.writeTextFile (Path.concat [ p, "fruits", "left", ".gitignore" ]) hugeGitignore FS.writeTextFile (Path.concat [ p, "fruits", "right", ".gitignore" ]) hugeGitignore - a <- Glob.gitignoringGlob p [ "fruits/**/apple" ] + a <- glob p [ "fruits/**/apple" ] Array.sort a `Assert.shouldEqual` [ "fruits/left/apple", "fruits/right/apple" ] From 9bef4e701c70bd5d946daa46caa029d50c560afe Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Thu, 31 Oct 2024 15:07:03 +0200 Subject: [PATCH 2/2] Fix test --- test/Spago/Glob.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Spago/Glob.purs b/test/Spago/Glob.purs index 4d2b7e96b..c5c86a86a 100644 --- a/test/Spago/Glob.purs +++ b/test/Spago/Glob.purs @@ -107,5 +107,5 @@ spec = Spec.around globTmpDir do Spec.it "does respect .gitignore even though it might conflict with a search path without base" $ \p -> do FS.writeTextFile (Path.concat [ p, ".gitignore" ]) "fruits" - a <- Glob.gitignoringGlob p [ "**/apple" ] + a <- glob p [ "**/apple" ] Array.sort a `Assert.shouldEqual` []