Resolve #5586. Treat all packages as remote except LocalUnpackedPackage

Also calculate hashes for all locally available tarballs.

Author: phadej

cabal-install/Distribution/Client/FetchUtils.hs

@@ -99,8 +99,8 @@ checkFetched loc = case loc of
       return (Just $ RemoteTarballPackage uri file)
     RepoTarballPackage repo pkgid (Just file) ->
       return (Just $ RepoTarballPackage repo pkgid file)
-    RemoteSourceRepoPackage repo (Just dir) ->
-      return (Just $ RemoteSourceRepoPackage repo dir)
+    RemoteSourceRepoPackage repo (Just file) ->
+      return (Just $ RemoteSourceRepoPackage repo file)
 
     RemoteTarballPackage     _uri Nothing -> return Nothing
     RemoteSourceRepoPackage _repo Nothing -> return Nothing

cabal-install/Distribution/Client/ProjectBuilding.hs

@@ -200,13 +200,8 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} shared =
           -- artifacts under the shared dist directory.
           dryRunLocalPkg pkg depsBuildStatus srcdir
 
-        Just (RemoteSourceRepoPackage _repo srcdir) ->
-          -- At this point, source repos are essentially the same as local
-          -- dirs, since we've already download them.
-          dryRunLocalPkg pkg depsBuildStatus srcdir
-
-        -- The three tarball cases are handled the same as each other,
-        -- though depending on the build style.
+        -- The rest cases are all tarball cases are,
+        -- and handled the same as each other though depending on the build style.
         Just (LocalTarballPackage    tarball) ->
           dryRunTarballPkg pkg depsBuildStatus tarball
 
@@ -216,6 +211,10 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} shared =
         Just (RepoTarballPackage _ _ tarball) ->
           dryRunTarballPkg pkg depsBuildStatus tarball
 
+        Just (RemoteSourceRepoPackage _repo tarball) ->
+          dryRunTarballPkg pkg depsBuildStatus tarball
+
+
     dryRunTarballPkg :: ElaboratedConfiguredPackage
                      -> [BuildStatus]
                      -> FilePath

cabal-install/Distribution/Client/ProjectConfig.hs

@@ -127,6 +127,8 @@ import Distribution.Version
          ( Version )
 import qualified Distribution.Deprecated.ParseUtils as OldParser
          ( ParseResult(..), locatedErrorMsg, showPWarning )
+import Distribution.Client.SrcDist
+         ( packageDirToSdist )
 
 import qualified Codec.Archive.Tar       as Tar
 import qualified Codec.Archive.Tar.Entry as Tar
@@ -1170,6 +1172,7 @@ syncAndReadSourcePackagesRemoteRepos verbosity
         syncSourceRepos verbosity vcs
           [ (repo, repoPath)
           | (repo, _, repoPath) <- repoGroupWithPaths ]
+        -- TODO phadej 2020-06-18 add post-sync script
 
         -- But for reading we go through each 'SourceRepo' including its subdir
         -- value and have to know which path each one ended up in.
@@ -1199,24 +1202,30 @@ syncAndReadSourcePackagesRemoteRepos verbosity
                   : [ pathStem ++ "-" ++ show (i :: Int) | i <- [2..] ]
 
     readPackageFromSourceRepo
-        :: SourceRepositoryPackage Maybe -> FilePath
+        :: SourceRepositoryPackage Maybe
+        -> FilePath
         -> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
     readPackageFromSourceRepo repo repoPath = do
-        let packageDir = maybe repoPath (repoPath </>) (srpSubdir repo)
+        let packageDir :: FilePath
+            packageDir = maybe repoPath (repoPath </>) (srpSubdir repo)
+
         entries <- liftIO $ getDirectoryContents packageDir
-        --TODO: wrap exceptions
+        --TODO: dcoutts 2018-06-23: wrap exceptions
         case filter (\e -> takeExtension e == ".cabal") entries of
           []       -> liftIO $ throwIO $ NoCabalFileFound packageDir
           (_:_:_)  -> liftIO $ throwIO $ MultipleCabalFilesFound packageDir
           [cabalFileName] -> do
+            let cabalFilePath = packageDir </> cabalFileName
             monitorFiles [monitorFileHashed cabalFilePath]
-            liftIO $ fmap (mkSpecificSourcePackage location)
-                   . readSourcePackageCabalFile verbosity cabalFilePath
-                 =<< BS.readFile cabalFilePath
-            where
-              cabalFilePath = packageDir </> cabalFileName
-              location      = RemoteSourceRepoPackage repo packageDir
+            gpd <- liftIO $ readSourcePackageCabalFile verbosity cabalFilePath =<< BS.readFile cabalFilePath
+
+            -- write sdist tarball, to repoPath-pgkid
+            tarball <- liftIO $ packageDirToSdist verbosity gpd packageDir
+            let tarballPath = repoPath ++ "-" ++ prettyShow (packageId gpd) ++ ".tar.gz"
+            liftIO $ LBS.writeFile tarballPath tarball
 
+            let location = RemoteSourceRepoPackage repo tarballPath
+            return $ mkSpecificSourcePackage location gpd
 
     reportSourceRepoProblems :: [(SourceRepoList, SourceRepoProblem)] -> Rebuild a
     reportSourceRepoProblems = liftIO . die' verbosity . renderSourceRepoProblems
@@ -1231,13 +1240,11 @@ syncAndReadSourcePackagesRemoteRepos verbosity
 --
 mkSpecificSourcePackage :: PackageLocation FilePath
                         -> GenericPackageDescription
-                        -> PackageSpecifier
-                             (SourcePackage (PackageLocation (Maybe FilePath)))
+                        -> PackageSpecifier (SourcePackage UnresolvedPkgLoc)
 mkSpecificSourcePackage location pkg =
     SpecificSourcePackage SourcePackage
       { srcpkgPackageId     = packageId pkg
       , srcpkgDescription   = pkg
-        --TODO: it is silly that we still have to use a Maybe FilePath here
       , srcpkgSource        = fmap Just location
       , srcpkgDescrOverride = Nothing
       }

cabal-install/Distribution/Client/ProjectPlanning.hs

@@ -593,19 +593,25 @@ rebuildInstallPlan verbosity
           Map.fromList
             [ (pkgname, stanzas)
             | pkg <- localPackages
+              -- TODO: misnormer: we should separate
+              -- builtin/global/inplace/local packages
+              -- and packages explicitly mentioned in the project
+              --
             , let pkgname            = pkgSpecifierTarget pkg
                   testsEnabled       = lookupLocalPackageConfig
                                          packageConfigTests
                                          projectConfig pkgname
                   benchmarksEnabled  = lookupLocalPackageConfig
                                          packageConfigBenchmarks
                                          projectConfig pkgname
-                  stanzas =
-                    Map.fromList $
+                  isLocal = isJust (shouldBeLocal pkg)
+                  stanzas
+                    | isLocal = Map.fromList $
                       [ (TestStanzas, enabled)
-                      | enabled <- flagToList testsEnabled ]
-                   ++ [ (BenchStanzas , enabled)
+                      | enabled <- flagToList testsEnabled ] ++
+                      [ (BenchStanzas , enabled)
                       | enabled <- flagToList benchmarksEnabled ]
+                    | otherwise = Map.fromList [(TestStanzas, False), (BenchStanzas, False) ]
             ]
 
     -- Elaborate the solver's install plan to get a fully detailed plan. This
@@ -823,10 +829,14 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do
 
         -- Tarballs from remote URLs. We must have downloaded these already
         -- (since we extracted the .cabal file earlier)
-        --TODO: [required eventually] finish remote tarball functionality
---        allRemoteTarballPkgs =
---          [ (pkgid, )
---          | (pkgid, RemoteTarballPackage ) <- allPkgLocations ]
+        remoteTarballPkgs =
+          [ (pkgid, tarball)
+          | (pkgid, RemoteTarballPackage _ (Just tarball)) <- allPkgLocations ]
+
+        -- tarballs from source-repository-package stanzas
+        sourceRepoTarballPkgs =
+          [ (pkgid, tarball)
+          | (pkgid, RemoteSourceRepoPackage _ (Just tarball)) <- allPkgLocations ]
 
         -- Tarballs from repositories, either where the repository provides
         -- hashes as part of the repo metadata, or where we will have to
@@ -906,6 +916,8 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do
     --
     let allTarballFilePkgs :: [(PackageId, FilePath)]
         allTarballFilePkgs = localTarballPkgs
+                          ++ remoteTarballPkgs
+                          ++ sourceRepoTarballPkgs
                           ++ repoTarballPkgsDownloaded
                           ++ repoTarballPkgsNewlyDownloaded
     hashesFromTarballFiles <- liftIO $
@@ -1925,16 +1937,6 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
         Set.fromList (catMaybes (map shouldBeLocal localPackages))
         --TODO: localPackages is a misnomer, it's all project packages
         -- here is where we decide which ones will be local!
-      where
-        shouldBeLocal :: PackageSpecifier (SourcePackage (PackageLocation loc)) -> Maybe PackageId
-        shouldBeLocal NamedPackage{}              = Nothing
-        shouldBeLocal (SpecificSourcePackage pkg)
-          | LocalTarballPackage _ <- srcpkgSource pkg = Nothing
-          | otherwise = Just (packageId pkg)
-        -- TODO: Is it only LocalTarballPackages we can know about without
-        -- them being "local" in the sense meant here?
-        --
-        -- Also, review use of SourcePackage's loc vs ProjectPackageLocation
 
     pkgsUseSharedLibrary :: Set PackageId
     pkgsUseSharedLibrary =
@@ -1995,6 +1997,12 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
 
 -- TODO: Drop matchPlanPkg/matchElabPkg in favor of mkCCMapping
 
+shouldBeLocal :: PackageSpecifier (SourcePackage (PackageLocation loc)) -> Maybe PackageId
+shouldBeLocal NamedPackage{}              = Nothing
+shouldBeLocal (SpecificSourcePackage pkg) = case srcpkgSource pkg of
+    LocalUnpackedPackage _ -> Just (packageId pkg)
+    _                      -> Nothing
+
 -- | Given a 'ElaboratedPlanPackage', report if it matches a 'ComponentName'.
 matchPlanPkg :: (ComponentName -> Bool) -> ElaboratedPlanPackage -> Bool
 matchPlanPkg p = InstallPlan.foldPlanPackage (p . ipiComponentName) (matchElabPkg p)