Commit 1f663390 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

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: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 3a69f2ea
......@@ -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
......
......@@ -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
......
......@@ -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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment