Use sdist to find files to monitor, fixes #3019 for Simple Cabal files

cabal-install/Distribution/Client/Dependency/Modular/Linking.hs

@@ -32,7 +32,7 @@ import qualified Distribution.Client.Dependency.Modular.PSQ as P
 import qualified Distribution.Client.Dependency.Modular.ConflictSet as CS
 
 import Distribution.Client.Types (OptionalStanza(..))
-import Distribution.Client.ComponentDeps (Component)
+import Distribution.Client.ComponentDeps (Component(ComponentSetup))
 
 {-------------------------------------------------------------------------------
   Add linking
@@ -206,7 +206,7 @@ conflict = lift' . Left
 execUpdateState :: UpdateState () -> ValidateState -> Either Conflict ValidateState
 execUpdateState = execStateT . unUpdateState
 
-pickPOption :: QPN -> POption -> FlaggedDeps comp QPN -> UpdateState ()
+pickPOption :: QPN -> POption -> FlaggedDeps Component QPN -> UpdateState ()
 pickPOption qpn (POption i Nothing)    _deps = pickConcrete qpn i
 pickPOption qpn (POption i (Just pp'))  deps = pickLink     qpn i pp' deps
 
@@ -224,7 +224,7 @@ pickConcrete qpn@(Q pp _) i = do
       Just lg ->
         makeCanonical lg qpn i
 
-pickLink :: QPN -> I -> PP -> FlaggedDeps comp QPN -> UpdateState ()
+pickLink :: QPN -> I -> PP -> FlaggedDeps Component QPN -> UpdateState ()
 pickLink qpn@(Q _pp pn) i pp' deps = do
     vs <- get
 
@@ -279,10 +279,12 @@ makeCanonical lg qpn@(Q pp _) i =
 -- because having the direct dependencies in a link group means that we must
 -- have already made or will make sooner or later a link choice for one of these
 -- as well, and cover their dependencies at that point.
-linkDeps :: [Var QPN] -> PP -> FlaggedDeps comp QPN -> UpdateState ()
+linkDeps :: [Var QPN] -> PP -> FlaggedDeps Component QPN -> UpdateState ()
 linkDeps parents pp' = mapM_ go
   where
-    go :: FlaggedDep comp QPN -> UpdateState ()
+    go :: FlaggedDep Component QPN -> UpdateState ()
+    -- Skip setup dependencies.
+    go (Simple _ ComponentSetup) = return ()
     go (Simple (Dep qpn@(Q _ pn) _) _) = do
       vs <- get
       let qpn' = Q pp' pn

cabal-install/Distribution/Client/ProjectBuilding.hs

@@ -40,6 +40,7 @@ import           Distribution.Client.FetchUtils
 import           Distribution.Client.GlobalFlags (RepoContext)
 import qualified Distribution.Client.Tar as Tar
 import           Distribution.Client.Setup (filterConfigureFlags)
+import           Distribution.Client.SrcDist (allPackageSourceFiles)
 import           Distribution.Client.Utils (removeExistingFile)
 
 import           Distribution.Package hiding (InstalledPackageId, installedPackageId)
@@ -1138,10 +1139,10 @@ buildInplaceUnpackedPackage verbosity
           timestamp <- beginUpdateFileMonitor
           setup buildCommand buildFlags buildArgs
 
-          --TODO: [required eventually] temporary hack. We need to look at the package description
-          -- and work out the exact file monitors to use
-          allSrcFiles <- filter (not . ("dist-newstyle" `isPrefixOf`))
-                     <$> getDirectoryContentsRecursive srcdir
+          --TODO: [required eventually] this doesn't track file
+          --non-existence, so we could fail to rebuild if someone
+          --adds a new file which changes behavior.
+          allSrcFiles <- allPackageSourceFiles verbosity srcdir
 
           updatePackageBuildFileMonitor packageFileMonitor srcdir timestamp
                                         pkg buildStatus

cabal-install/Distribution/Client/Sandbox/Timestamp.hs

@@ -21,7 +21,6 @@ module Distribution.Client.Sandbox.Timestamp (
   writeTimestampFile
   ) where
 
-import Control.Exception                             (IOException)
 import Control.Monad                                 (filterM, forM, when)
 import Data.Char                                     (isSpace)
 import Data.List                                     (partition)
@@ -30,29 +29,15 @@ import System.FilePath                               ((<.>), (</>))
 import qualified Data.Map as M
 
 import Distribution.Compiler                         (CompilerId)
-import Distribution.Package                          (packageName)
-import Distribution.PackageDescription.Configuration (flattenPackageDescription)
-import Distribution.PackageDescription.Parse         (readPackageDescription)
-import Distribution.Simple.Setup                     (Flag (..),
-                                                      SDistFlags (..),
-                                                      defaultSDistFlags,
-                                                      sdistCommand)
 import Distribution.Simple.Utils                     (debug, die, warn)
 import Distribution.System                           (Platform)
 import Distribution.Text                             (display)
-import Distribution.Verbosity                        (Verbosity, lessVerbose,
-                                                      normal)
-import Distribution.Version                          (Version (..),
-                                                      orLaterVersion)
+import Distribution.Verbosity                        (Verbosity)
 
+import Distribution.Client.SrcDist (allPackageSourceFiles)
 import Distribution.Client.Sandbox.Index
   (ListIgnoredBuildTreeRefs (ListIgnored), RefTypesToList(OnlyLinks)
   ,listBuildTreeRefs)
-import Distribution.Client.SetupWrapper              (SetupScriptOptions (..),
-                                                      defaultSetupScriptOptions,
-                                                      setupWrapper)
-import Distribution.Client.Utils
-  (inDir, removeExistingFile, tryCanonicalizePath, tryFindAddSourcePackageDesc)
 
 import Distribution.Compat.Exception                 (catchIO)
 import Distribution.Client.Compat.Time               (ModTime, getCurTime,
@@ -238,45 +223,6 @@ withActionOnCompilerTimestamps f sandboxDir compId platform act = do
       else return r
     return timestampRecords'
 
--- | List all source files of a given add-source dependency. Exits with error if
--- something is wrong (e.g. there is no .cabal file in the given directory).
--- FIXME: This function is not thread-safe because of 'inDir'.
-allPackageSourceFiles :: Verbosity -> FilePath -> IO [FilePath]
-allPackageSourceFiles verbosity packageDir = inDir (Just packageDir) $ do
-  pkg <- do
-    let err = "Error reading source files of add-source dependency."
-    desc <- tryFindAddSourcePackageDesc packageDir err
-    flattenPackageDescription `fmap` readPackageDescription verbosity desc
-  let file      = "cabal-sdist-list-sources"
-      flags     = defaultSDistFlags {
-        sDistVerbosity   = Flag $ if verbosity == normal
-                                  then lessVerbose verbosity else verbosity,
-        sDistListSources = Flag file
-        }
-      setupOpts = defaultSetupScriptOptions {
-        -- 'sdist --list-sources' was introduced in Cabal 1.18.
-        useCabalVersion = orLaterVersion $ Version [1,18,0] []
-        }
-
-      doListSources :: IO [FilePath]
-      doListSources = do
-        setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags) []
-        srcs <- fmap lines . readFile $ file
-        mapM tryCanonicalizePath srcs
-
-      onFailedListSources :: IOException -> IO ()
-      onFailedListSources e = do
-        warn verbosity $
-          "Could not list sources of the add-source dependency '"
-          ++ display (packageName pkg) ++ "'. Skipping the timestamp check."
-        debug verbosity $
-          "Exception was: " ++ show e
-
-  -- Run setup sdist --list-sources=TMPFILE
-  ret <- doListSources `catchIO` (\e -> onFailedListSources e >> return [])
-  removeExistingFile file
-  return ret
-
 -- | Has this dependency been modified since we have last looked at it?
 isDepModified :: Verbosity -> ModTime -> AddSourceTimestamp -> IO Bool
 isDepModified verbosity now (packageDir, timestamp) = do
@@ -286,9 +232,10 @@ isDepModified verbosity now (packageDir, timestamp) = do
 
   where
     go []         = return False
-    go (dep:rest) = do
+    go (dep0:rest) = do
       -- FIXME: What if the clock jumps backwards at any point? For now we only
       -- print a warning.
+      let dep = packageDir </> dep0
       modTime <- getModTime dep
       when (modTime > now) $
         warn verbosity $ "File '" ++ dep

cabal-install/Distribution/Client/SrcDist.hs

@@ -2,7 +2,8 @@
 -- distribution for this package.  That is, packs up the source code
 -- into a tarball, making use of the corresponding Cabal module.
 module Distribution.Client.SrcDist (
-         sdist
+         sdist,
+         allPackageSourceFiles
   )  where
 
 
@@ -11,7 +12,7 @@ import Distribution.Client.SetupWrapper
 import Distribution.Client.Tar (createTarGzFile)
 
 import Distribution.Package
-         ( Package(..) )
+         ( Package(..), packageName )
 import Distribution.PackageDescription
          ( PackageDescription )
 import Distribution.PackageDescription.Configuration
@@ -20,23 +21,29 @@ import Distribution.PackageDescription.Parse
          ( readPackageDescription )
 import Distribution.Simple.Utils
          ( createDirectoryIfMissingVerbose, defaultPackageDesc
-         , die, notice, withTempDirectory )
+         , warn, die, notice, withTempDirectory )
 import Distribution.Client.Setup
          ( SDistFlags(..), SDistExFlags(..), ArchiveFormat(..) )
 import Distribution.Simple.Setup
-         ( Flag(..), sdistCommand, flagToList, fromFlag, fromFlagOrDefault )
+         ( Flag(..), sdistCommand, flagToList, fromFlag, fromFlagOrDefault
+         , defaultSDistFlags )
 import Distribution.Simple.BuildPaths ( srcPref)
 import Distribution.Simple.Program (requireProgram, simpleProgram, programPath)
 import Distribution.Simple.Program.Db (emptyProgramDb)
 import Distribution.Text ( display )
-import Distribution.Verbosity (Verbosity)
+import Distribution.Verbosity (Verbosity, normal, lessVerbose)
 import Distribution.Version   (Version(..), orLaterVersion)
 
+import Distribution.Client.Utils
+  (removeExistingFile, tryFindAddSourcePackageDesc)
+import Distribution.Compat.Exception                 (catchIO)
+
 import System.FilePath ((</>), (<.>))
 import Control.Monad (when, unless, liftM)
 import System.Directory (doesFileExist, removeFile, canonicalizePath)
 import System.Process (runProcess, waitForProcess)
 import System.Exit    (ExitCode(..))
+import Control.Exception                             (IOException)
 
 -- |Create a source distribution.
 sdist :: SDistFlags -> SDistExFlags -> IO ()
@@ -136,3 +143,42 @@ createZipArchive verbosity pkg tmpDir targetPref = do
     notice verbosity $ "Source zip archive created: " ++ zipfile
   where
     zipProgram = simpleProgram "zip"
+
+-- | List all source files of a given add-source dependency. Exits with error if
+-- something is wrong (e.g. there is no .cabal file in the given directory).
+allPackageSourceFiles :: Verbosity -> FilePath -> IO [FilePath]
+allPackageSourceFiles verbosity packageDir = do
+  pkg <- do
+    let err = "Error reading source files of package."
+    desc <- tryFindAddSourcePackageDesc packageDir err
+    flattenPackageDescription `fmap` readPackageDescription verbosity desc
+  let -- TODO: allocate a temporary directory for this, more thread safe.
+      file      = packageDir </> "cabal-sdist-list-sources"
+      flags     = defaultSDistFlags {
+        sDistVerbosity   = Flag $ if verbosity == normal
+                                  then lessVerbose verbosity else verbosity,
+        sDistListSources = Flag file
+        }
+      setupOpts = defaultSetupScriptOptions {
+        -- 'sdist --list-sources' was introduced in Cabal 1.18.
+        useCabalVersion = orLaterVersion $ Version [1,18,0] [],
+        useWorkingDir = Just packageDir
+        }
+
+      doListSources :: IO [FilePath]
+      doListSources = do
+        setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags) []
+        fmap lines . readFile $ file
+
+      onFailedListSources :: IOException -> IO ()
+      onFailedListSources e = do
+        warn verbosity $
+          "Could not list sources of the package '"
+          ++ display (packageName pkg) ++ "'."
+        warn verbosity $
+          "Exception was: " ++ show e
+
+  -- Run setup sdist --list-sources=TMPFILE
+  ret <- doListSources `catchIO` (\e -> onFailedListSources e >> return [])
+  removeExistingFile file
+  return ret

cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs

@@ -56,14 +56,15 @@ tests = [
         , runTest $ indep $ mkTest db6 "depsWithTests2" ["C", "D"] (Just [("A", 1), ("B", 1), ("C", 1), ("D", 1)])
         ]
     , testGroup "Setup dependencies" [
-          runTest $ mkTest db7  "setupDeps1" ["B"] (Just [("A", 2), ("B", 1)])
-        , runTest $ mkTest db7  "setupDeps2" ["C"] (Just [("A", 2), ("C", 1)])
-        , runTest $ mkTest db7  "setupDeps3" ["D"] (Just [("A", 1), ("D", 1)])
-        , runTest $ mkTest db7  "setupDeps4" ["E"] (Just [("A", 1), ("A", 2), ("E", 1)])
-        , runTest $ mkTest db7  "setupDeps5" ["F"] (Just [("A", 1), ("A", 2), ("F", 1)])
-        , runTest $ mkTest db8  "setupDeps6" ["C", "D"] (Just [("A", 1), ("B", 1), ("B", 2), ("C", 1), ("D", 1)])
-        , runTest $ mkTest db9  "setupDeps7" ["F", "G"] (Just [("A", 1), ("B", 1), ("B",2 ), ("C", 1), ("D", 1), ("E", 1), ("E", 2), ("F", 1), ("G", 1)])
-        , runTest $ mkTest db10 "setupDeps8" ["C"] (Just [("C", 1)])
+          runTest $         mkTest db7  "setupDeps1" ["B"] (Just [("A", 2), ("B", 1)])
+        , runTest $         mkTest db7  "setupDeps2" ["C"] (Just [("A", 2), ("C", 1)])
+        , runTest $         mkTest db7  "setupDeps3" ["D"] (Just [("A", 1), ("D", 1)])
+        , runTest $         mkTest db7  "setupDeps4" ["E"] (Just [("A", 1), ("A", 2), ("E", 1)])
+        , runTest $         mkTest db7  "setupDeps5" ["F"] (Just [("A", 1), ("A", 2), ("F", 1)])
+        , runTest $         mkTest db8  "setupDeps6" ["C", "D"] (Just [("A", 1), ("B", 1), ("B", 2), ("C", 1), ("D", 1)])
+        , runTest $         mkTest db9  "setupDeps7" ["F", "G"] (Just [("A", 1), ("B", 1), ("B",2 ), ("C", 1), ("D", 1), ("E", 1), ("E", 2), ("F", 1), ("G", 1)])
+        , runTest $         mkTest db10 "setupDeps8" ["C"] (Just [("C", 1)])
+        , runTest $ indep $ mkTest dbSetupDeps "setupDeps9" ["A", "B"] (Just [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2)])
         ]
     , testGroup "Base shim" [
           runTest $ mkTest db11 "baseShim1" ["A"] (Just [("A", 1)])
@@ -397,6 +398,23 @@ db10 =
     , Right $ exAv "C" 1 [ExFix "A" 2] `withSetupDeps` [ExFix "A" 1]
     ]
 
+-- | This database tests that linking a package does not also link the package's
+-- setup dependencies.
+--
+-- When A and B are installed as independent goals, their dependencies on C must
+-- be linked, due to the single instance restriction. Since C depends on D, 0.D
+-- and 1.D must also be linked. However, C's setup dependency on D should remain
+-- independent. The solver should be able to choose D-1 for C's library and D-2
+-- for C's setup script.
+dbSetupDeps :: ExampleDb
+dbSetupDeps = [
+    Right $ exAv "A" 1 [ExAny "C"]
+  , Right $ exAv "B" 1 [ExAny "C"]
+  , Right $ exAv "C" 1 [ExFix "D" 1] `withSetupDeps` [ExFix "D" 2]
+  , Right $ exAv "D" 1 []
+  , Right $ exAv "D" 2 []
+  ]
+
 -- | Tests for dealing with base shims
 db11 :: ExampleDb
 db11 =