Fix #3019, use sdist to find files to monitor.

As a refactoring, this moves allPackageSourceFiles from
Distribution.Client.Sandbox.Timestamp to
Distribution.Client.SrcDist, makes it thread safe, and has
it return files relative to the source directory.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

cabal-install/Distribution/Client/ProjectBuilding.hs

@@ -36,6 +36,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)
@@ -1135,10 +1136,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.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