Fix issue with git clone: tags would get pulled twice due to the lock…

…file storing hashes (purescript#1186)

core/src/FS.js

@@ -6,6 +6,8 @@ export const moveSyncImpl = (source) => (destination) => () => moveSync(source,
 
 export const ensureFileSyncImpl = (file) => () => ensureFileSync(file);
 
+export const cpImpl = (source) => (dest) => () => fs.copySync(source, dest);
+
 // This takes a "basepath" and a "path", and returns the segments of difference between them.
 // So e.g. if basepath = "/a/b/c" and path = "/a/b/c/d/e", it will return ["d", "e"]
 function getPathDifference(basepath, pathToCompare) {

core/src/FS.purs

@@ -5,6 +5,7 @@ module Spago.FS
   , getInBetweenPaths
   , isLink
   , ls
+  , cp
   , mkdirp
   , moveSync
   , copyFileSync
@@ -50,6 +51,11 @@ copyFileSync { src, dst } = liftEffect $ FS.Sync.copyFile src dst
 copyFile :: forall m. MonadAff m => { src :: FilePath, dst :: FilePath } -> m Unit
 copyFile { src, dst } = liftAff $ FS.Aff.copyFile src dst
 
+foreign import cpImpl :: String -> String -> Effect Unit
+
+cp :: forall m. MonadEffect m => { src :: FilePath, dst :: FilePath } -> m Unit
+cp { src, dst } = liftEffect $ cpImpl src dst
+
 foreign import ensureFileSyncImpl :: String -> Effect Unit
 
 ensureFileSync :: forall m. MonadEffect m => FilePath -> m Unit

src/Spago/Command/Fetch.purs

@@ -181,10 +181,6 @@ run { packages: packagesRequestedToInstall, ensureRanges, isTest, isRepl } = do
         Nothing -> die "Impossible: package dependencies must be in dependencies map"
         Just deps -> pure $ Map.union deps if isRepl then supportPackage else Map.empty
 
-    case workspace.packageSet.lockfile of
-      Right _lockfile -> pure unit
-      Left reason -> writeNewLockfile reason allTransitiveDeps
-
     -- then for every package we have we try to download it, and copy it in the local cache
     logInfo "Downloading dependencies..."
 
@@ -264,14 +260,18 @@ run { packages: packagesRequestedToInstall, ensureRanges, isTest, isRepl } = do
         LocalPackage _ -> pure unit
         WorkspacePackage _ -> pure unit
 
-    pure dependencies
+    -- We return the dependencies, going through the lockfile write if we need to
+    -- (we return them from inside there because we need to update the commit hashes)
+    case workspace.packageSet.lockfile of
+      Right _lockfile -> pure dependencies
+      Left reason -> writeNewLockfile reason dependencies
 
 type LockfileBuilderResult =
   { workspacePackages :: Map PackageName Lock.WorkspaceLockPackage
   , packages :: Map PackageName Lock.LockEntry
   }
 
-writeNewLockfile :: forall a. String -> PackageTransitiveDeps -> Spago (FetchEnv a) Unit
+writeNewLockfile :: forall a. String -> PackageTransitiveDeps -> Spago (FetchEnv a) PackageTransitiveDeps
 writeNewLockfile reason allTransitiveDeps = do
   logInfo $ reason <> ", generating it..."
   { workspace } <- ask
@@ -332,6 +332,21 @@ writeNewLockfile reason allTransitiveDeps = do
   liftAff $ FS.writeYamlFile Lock.lockfileCodec "spago.lock" lockfile
   logInfo "Lockfile written to spago.lock. Please commit this file."
 
+  -- We update the dependencies here with the commit hashes that came from the getRef calls,
+  -- so that the build uses them instead of the tags
+  pure $ Map.mapMaybeWithKey
+    ( \_workspacePackage packageMap -> Just $ Map.mapMaybeWithKey
+        ( \name package -> Just case package of
+            GitPackage gitPackage -> case Map.lookup name packages of
+              Nothing -> package
+              Just (FromGit { rev }) -> GitPackage $ gitPackage { ref = rev }
+              Just _ -> package
+            _ -> package
+        )
+        packageMap
+    )
+    allTransitiveDeps
+
 toAllDependencies :: PackageTransitiveDeps -> PackageMap
 toAllDependencies = foldl (Map.unionWith (\l _ -> l)) Map.empty
 
@@ -347,6 +362,20 @@ getGitPackageInLocalCache name package = do
       FS.mkdirp $ Path.concat [ Paths.localCachePackagesPath, PackageName.print name ]
       FS.moveSync { src: tempDir, dst: localPackageLocation }
 
+      -- Note: the package might have been cloned with a tag, but we stick the commit hash in the lockfiles
+      -- so we need to make a copy to a location that has the commit hash too.
+      -- So we run getRef here and then do a copy if the ref is different than the original one
+      -- (since it might be a commit to start with)
+      logDebug $ "Checking if we need to copy the package to a commit hash location..."
+      Git.getRef (Just localPackageLocation) >>= case _ of
+        Left err -> die err
+        Right ref -> do
+          when (ref /= package.ref) do
+            let commitHashLocation = Config.getPackageLocation name (GitPackage $ package { ref = ref })
+            logDebug $ "Copying the repo also to " <> commitHashLocation
+            FS.mkdirp $ Path.concat [ Paths.localCachePackagesPath, PackageName.print name ]
+            FS.cp { src: localPackageLocation, dst: commitHashLocation }
+
 getPackageDependencies :: forall a. PackageName -> Package -> Spago (FetchEnv a) (Maybe (Map PackageName Range))
 getPackageDependencies packageName package = case package of
   RegistryVersion v -> do

src/Spago/Command/Uninstall.purs

@@ -56,7 +56,7 @@ run args = do
       -- We might be in a place where the config file is untouched, but we still need to update the lockfile
       case workspace.packageSet.lockfile of
         Right _ -> pure unit
-        Left reason -> writeNewLockfile reason
+        Left reason -> void $ writeNewLockfile reason
     Just removed' -> do
       modifyDoc removed'
 
@@ -78,7 +78,7 @@ run args = do
           }
 
       local (_ { workspace = newWorkspace }) do
-        writeNewLockfile "Lockfile is out of date (uninstalled packages)"
+        void $ writeNewLockfile "Lockfile is out of date (uninstalled packages)"
 
   where
   writeNewLockfile reason = do

src/Spago/Config.purs

@@ -167,7 +167,7 @@ readWorkspace { maybeSelectedPackage, pureBuild } = do
       ]
     Right { yaml: { workspace: Just workspace, package }, doc } -> pure { workspace, package, workspaceDoc: doc }
 
-  -- Then gather all the spago other configs in the tree.
+  logDebug "Gathering all the spago configs in the tree..."
   { succeeded: otherConfigPaths, failed, ignored } <- do
     result <- liftAff $ Glob.match' Paths.cwd [ "**/spago.yaml" ] { ignore: [ ".spago", "spago.yaml" ] }
     -- If a file is gitignored then we don't include it as a package
@@ -248,6 +248,7 @@ readWorkspace { maybeSelectedPackage, pureBuild } = do
           pkgs -> [ toDoc "Available packages:", indent (toDoc pkgs) ]
       Just p -> pure (Just p)
 
+  logDebug "Reading the lockfile..."
   maybeLockfileContents <- FS.exists "spago.lock" >>= case _ of
     false -> pure (Left "No lockfile found")
     true -> liftAff (FS.readYamlFile Lock.lockfileCodec "spago.lock") >>= case _ of

test-fixtures/list-packages-registry.txt

@@ -2,8 +2,8 @@ Reading Spago workspace configuration...
 
 ✅ Selecting package to build: aaa
 
+Downloading dependencies...
 No lockfile found, generating it...
 Lockfile written to spago.lock. Please commit this file.
-Downloading dependencies...
 
 ❌ Cannot list the packages in the package set, as none is configured for the project.

test-fixtures/pedantic/pedantic-instructions-installation-result.txt

@@ -3,9 +3,9 @@ Reading Spago workspace configuration...
 ✅ Selecting package to build: pedantic
 
 Adding 1 package to the config in spago.yaml
+Downloading dependencies...
 Lockfile is out of date (installing new packages), generating it...
 Lockfile written to spago.lock. Please commit this file.
-Downloading dependencies...
 Building...
            Src   Lib   All
 Warnings     0     0     0

test-fixtures/publish-no-config.txt

@@ -2,9 +2,9 @@ Reading Spago workspace configuration...
 
 ✅ Selecting package to build: aaaa
 
+Downloading dependencies...
 Lockfile is out of date, generating it...
 Lockfile written to spago.lock. Please commit this file.
-Downloading dependencies...
 Building...
            Src   Lib   All
 Warnings     0     0     0