Avoid globbing the spago cache folder when building

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

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

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

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
+    }

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

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

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

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.

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.

test/Spago/Glob.purs

@@ -46,48 +46,49 @@ 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
         Spec.it
           ("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" ]