Commit 19b8c681 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

For non-Custom packages, replace sdist with hand-rolled rebuild checking.



New module Distribution.Client.SourceFiles implements
'needElaboratedConfiguredPackage', which if run in the 'Rebuild'
monad is sufficient to ensure all source files that participate
in a build are monitored.

Fixes #3401.  It also fixes the "we didn't detect a new file
appearing" problem.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 39435c03
......@@ -15,6 +15,7 @@ module Distribution.Client.FileMonitor (
monitorFile,
monitorFileHashed,
monitorNonExistentFile,
monitorFileExistence,
monitorDirectory,
monitorNonExistentDirectory,
monitorDirectoryExistence,
......@@ -123,6 +124,12 @@ monitorFileHashed = MonitorFile FileHashed DirNotExists
monitorNonExistentFile :: FilePath -> MonitorFilePath
monitorNonExistentFile = MonitorFile FileNotExists DirNotExists
-- | Monitor a single file for existence only. The monitored file is
-- considered to have changed if it no longer exists.
--
monitorFileExistence :: FilePath -> MonitorFilePath
monitorFileExistence = MonitorFile FileExists DirNotExists
-- | Monitor a single directory for changes, based on its modification
-- time. The monitored directory is considered to have changed if it no
-- longer exists or if its modification time has changed.
......
......@@ -56,12 +56,15 @@ import Distribution.Client.FetchUtils
import Distribution.Client.GlobalFlags (RepoContext)
import qualified Distribution.Client.Tar as Tar
import Distribution.Client.Setup (filterConfigureFlags)
import Distribution.Client.SourceFiles
import Distribution.Client.SrcDist (allPackageSourceFiles)
import Distribution.Client.Utils (removeExistingFile)
import Distribution.Package hiding (InstalledPackageId, installedPackageId)
import qualified Distribution.PackageDescription as PD
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.Types.BuildType
import Distribution.Simple.Program
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Command (CommandUI)
......@@ -85,7 +88,6 @@ import qualified Data.ByteString.Lazy as LBS
import Control.Monad
import Control.Exception
import Data.List
import Data.Maybe
import System.FilePath
......@@ -452,15 +454,14 @@ updatePackageBuildFileMonitor :: PackageFileMonitor
-> MonitorTimestamp
-> ElaboratedConfiguredPackage
-> BuildStatusRebuild
-> [FilePath]
-> [MonitorFilePath]
-> BuildResultMisc
-> IO ()
updatePackageBuildFileMonitor PackageFileMonitor{pkgFileMonitorBuild}
srcdir timestamp pkg pkgBuildStatus
allSrcFiles buildResult =
monitors buildResult =
updateFileMonitor pkgFileMonitorBuild srcdir (Just timestamp)
(map monitorFileHashed allSrcFiles)
buildComponents' buildResult
monitors buildComponents' buildResult
where
(_pkgconfig, buildComponents) = packageFileMonitorKeyValues pkg
......@@ -1041,29 +1042,35 @@ buildInplaceUnpackedPackage verbosity
annotateFailureNoLog BuildFailed $
setup buildCommand buildFlags buildArgs
--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 <-
let trySdist = allPackageSourceFiles verbosity scriptOptions srcdir
-- This is just a hack, to get semi-reasonable file
-- listings for the monitor
tryFallback = do
warn verbosity $
"Couldn't use sdist to compute source files; falling " ++
"back on recursive file scan."
filter (not . ("dist" `isPrefixOf`))
`fmap` getDirectoryContentsRecursive srcdir
in if elabSetupScriptCliVersion pkg >= mkVersion [1,17]
then do r <- trySdist
if null r
then tryFallback
else return r
else tryFallback
let listSimple =
execRebuild srcdir (needElaboratedConfiguredPackage pkg)
listSdist =
fmap (map monitorFileHashed) $
allPackageSourceFiles verbosity scriptOptions srcdir
ifNullThen m m' = do xs <- m
if null xs then m' else return xs
monitors <- case PD.buildType (elabPkgDescription pkg) of
Just Simple -> listSimple
-- If a Custom setup was used, AND the Cabal is recent
-- enough to have sdist --list-sources, use that to
-- determine the files that we need to track. This can
-- cause unnecessary rebuilding (for example, if README
-- is edited, we will try to rebuild) but there isn't
-- a more accurate Custom interface we can use to get
-- this info. We prefer not to use listSimple here
-- as it can miss extra source files that are considered
-- by the Custom setup.
_ | elabSetupScriptCliVersion pkg >= mkVersion [1,17]
-- However, sometimes sdist --list-sources will fail
-- and return an empty list. In that case, fall
-- back on the (inaccurate) simple tracking.
-> listSdist `ifNullThen` listSimple
| otherwise
-> listSimple
updatePackageBuildFileMonitor packageFileMonitor srcdir timestamp
pkg buildStatus
allSrcFiles buildResult
monitors buildResult
-- PURPOSELY omitted: no copy!
......
......@@ -12,6 +12,7 @@ module Distribution.Client.RebuildMonad (
-- * Rebuild monad
Rebuild,
runRebuild,
execRebuild,
askRoot,
-- * Setting up file monitoring
......@@ -44,6 +45,12 @@ module Distribution.Client.RebuildMonad (
getDirectoryContentsMonitored,
createDirectoryMonitored,
monitorDirectoryStatus,
doesFileExistMonitored,
need,
needIfExists,
findFileWithExtensionMonitored,
findFirstFileMonitored,
findFileMonitored,
) where
import Prelude ()
......@@ -58,7 +65,7 @@ import Distribution.Verbosity (Verbosity)
import Control.Monad.State as State
import Control.Monad.Reader as Reader
import System.FilePath (takeFileName)
import System.FilePath
import System.Directory
......@@ -88,6 +95,10 @@ unRebuild rootDir (Rebuild action) = runStateT (runReaderT action rootDir) []
runRebuild :: FilePath -> Rebuild a -> IO a
runRebuild rootDir (Rebuild action) = evalStateT (runReaderT action rootDir) []
-- | Run a 'Rebuild' IO action.
execRebuild :: FilePath -> Rebuild a -> IO [MonitorFilePath]
execRebuild rootDir (Rebuild action) = execStateT (runReaderT action rootDir) []
-- | The root that relative paths are interpreted as being relative to.
askRoot :: Rebuild FilePath
askRoot = Rebuild Reader.ask
......@@ -166,3 +177,58 @@ monitorDirectoryStatus dir = do
then monitorDirectory dir
else monitorNonExistentDirectory dir]
-- | Like 'doesFileExist', but in the 'Rebuild' monad. This does
-- NOT track the contents of 'FilePath'; use 'need' in that case.
doesFileExistMonitored :: FilePath -> Rebuild Bool
doesFileExistMonitored f = do
root <- askRoot
exists <- liftIO $ doesFileExist (root </> f)
monitorFiles [if exists
then monitorFileExistence f
else monitorNonExistentFile f]
return exists
-- | Monitor a single file
need :: FilePath -> Rebuild ()
need f = monitorFiles [monitorFileHashed f]
-- | Monitor a file if it exists; otherwise check for when it
-- gets created. This is a bit better for recompilation avoidance
-- because sometimes users give bad package metadata, and we don't
-- want to repeatedly rebuild in this case (which we would if we
-- need'ed a non-existent file).
needIfExists :: FilePath -> Rebuild ()
needIfExists f = do
root <- askRoot
exists <- liftIO $ doesFileExist (root </> f)
monitorFiles [if exists
then monitorFileHashed f
else monitorNonExistentFile f]
-- | Like 'findFileWithExtension', but in the 'Rebuild' monad.
findFileWithExtensionMonitored
:: [String]
-> [FilePath]
-> FilePath
-> Rebuild (Maybe FilePath)
findFileWithExtensionMonitored extensions searchPath baseName =
findFirstFileMonitored id
[ path </> baseName <.> ext
| path <- nub searchPath
, ext <- nub extensions ]
-- | Like 'findFirstFile', but in the 'Rebuild' monad.
findFirstFileMonitored :: (a -> FilePath) -> [a] -> Rebuild (Maybe a)
findFirstFileMonitored file = findFirst
where findFirst [] = return Nothing
findFirst (x:xs) = do exists <- doesFileExistMonitored (file x)
if exists
then return (Just x)
else findFirst xs
-- | Like 'findFile', but in the 'Rebuild' monad.
findFileMonitored :: [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
findFileMonitored searchPath fileName =
findFirstFileMonitored id
[ path </> fileName
| path <- nub searchPath]
-- | Contains an @sdist@ like function which computes the source files
-- that we should track to determine if a rebuild is necessary.
-- Unlike @sdist@, we can operate directly on the true
-- 'PackageDescription' (not flattened).
--
-- The naming convention, roughly, is that to declare we need the
-- source for some type T, you use the function needT; some functions
-- need auxiliary information.
--
-- We can only use this code for non-Custom scripts; Custom scripts
-- may have arbitrary extra dependencies (esp. new preprocessors) which
-- we cannot "see" easily.
module Distribution.Client.SourceFiles (needElaboratedConfiguredPackage) where
import Distribution.Client.ProjectPlanning.Types
import Distribution.Client.RebuildMonad
import Distribution.Solver.Types.OptionalStanza
import Distribution.Simple.PreProcess
import Distribution.Types.PackageDescription
import Distribution.Types.Component
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.Library
import Distribution.Types.Executable
import Distribution.Types.Benchmark
import Distribution.Types.BenchmarkInterface
import Distribution.Types.TestSuite
import Distribution.Types.TestSuiteInterface
import Distribution.Types.BuildInfo
import Distribution.ModuleName
import Prelude ()
import Distribution.Client.Compat.Prelude
import System.FilePath
import Control.Monad
import qualified Data.Set as Set
needElaboratedConfiguredPackage :: ElaboratedConfiguredPackage -> Rebuild ()
needElaboratedConfiguredPackage elab =
case elabPkgOrComp elab of
ElabComponent ecomp -> needElaboratedComponent elab ecomp
ElabPackage epkg -> needElaboratedPackage elab epkg
needElaboratedPackage :: ElaboratedConfiguredPackage -> ElaboratedPackage -> Rebuild ()
needElaboratedPackage elab epkg =
mapM_ (needComponent pkg_descr) (enabledComponents pkg_descr enabled)
where
pkg_descr = elabPkgDescription elab
enabled_stanzas = pkgStanzasEnabled epkg
-- TODO: turn this into a helper function somewhere
enabled =
ComponentRequestedSpec {
testsRequested = TestStanzas `Set.member` enabled_stanzas,
benchmarksRequested = BenchStanzas `Set.member` enabled_stanzas
}
needElaboratedComponent :: ElaboratedConfiguredPackage -> ElaboratedComponent -> Rebuild ()
needElaboratedComponent elab ecomp =
case mb_comp of
Nothing -> needSetup
Just comp -> needComponent pkg_descr comp
where
pkg_descr = elabPkgDescription elab
mb_comp = fmap (getComponent pkg_descr) (compComponentName ecomp)
needComponent :: PackageDescription -> Component -> Rebuild ()
needComponent pkg_descr comp =
case comp of
CLib lib -> needLibrary pkg_descr lib
CExe exe -> needExecutable pkg_descr exe
CTest test -> needTestSuite pkg_descr test
CBench bench -> needBenchmark pkg_descr bench
needSetup :: Rebuild ()
needSetup = findFirstFileMonitored id ["Setup.hs", "Setup.lhs"] >> return ()
needLibrary :: PackageDescription -> Library -> Rebuild ()
needLibrary pkg_descr (Library { exposedModules = modules
, signatures = sigs
, libBuildInfo = bi })
= needBuildInfo pkg_descr bi (modules ++ sigs)
needExecutable :: PackageDescription -> Executable -> Rebuild ()
needExecutable pkg_descr (Executable { modulePath = mainPath
, buildInfo = bi })
= do needBuildInfo pkg_descr bi []
needMainFile bi mainPath
needTestSuite :: PackageDescription -> TestSuite -> Rebuild ()
needTestSuite pkg_descr t
= case testInterface t of
TestSuiteExeV10 _ mainPath -> do
needBuildInfo pkg_descr bi []
needMainFile bi mainPath
TestSuiteLibV09 _ m ->
needBuildInfo pkg_descr bi [m]
TestSuiteUnsupported _ -> return () -- soft fail
where
bi = testBuildInfo t
needMainFile :: BuildInfo -> FilePath -> Rebuild ()
needMainFile bi mainPath = do
-- The matter here is subtle. It might *seem* that we
-- should just search for mainPath, but as per
-- b61cb051f63ed5869b8f4a6af996ff7e833e4b39 'main-is'
-- will actually be the source file AFTER preprocessing,
-- whereas we need to get the file *prior* to preprocessing.
ppFile <- findFileWithExtensionMonitored
(ppSuffixes knownSuffixHandlers)
(hsSourceDirs bi)
(dropExtension mainPath)
case ppFile of
-- But check the original path in the end, because
-- maybe it's a non-preprocessed file with a non-traditional
-- extension.
Nothing -> findFileMonitored (hsSourceDirs bi) mainPath
>>= maybe (return ()) need
Just pp -> need pp
needBenchmark :: PackageDescription -> Benchmark -> Rebuild ()
needBenchmark pkg_descr bm
= case benchmarkInterface bm of
BenchmarkExeV10 _ mainPath -> do
needBuildInfo pkg_descr bi []
needMainFile bi mainPath
BenchmarkUnsupported _ -> return () -- soft fail
where
bi = benchmarkBuildInfo bm
needBuildInfo :: PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
needBuildInfo pkg_descr bi modules = do
-- NB: These are separate because there may be both A.hs and
-- A.hs-boot; need to track both.
findNeededModules ["hs", "lhs", "hsig", "lhsig"]
findNeededModules ["hs-boot", "lhs-boot"]
mapM_ needIfExists (cSources bi ++ jsSources bi)
-- A MASSIVE HACK to (1) make sure we rebuild when header
-- files change, but (2) not have to rebuild when anything
-- in extra-src-files changes (most of these won't affect
-- compilation). It would be even better if we knew on a
-- per-component basis which headers would be used but that
-- seems to be too difficult.
mapM_ needIfExists (filter ((==".h").takeExtension) (extraSrcFiles pkg_descr))
forM_ (installIncludes bi) $ \f ->
findFileMonitored ("." : includeDirs bi) f
>>= maybe (return ()) need
where
findNeededModules exts =
mapM_ (findNeededModule exts)
(modules ++ otherModules bi)
findNeededModule exts m =
findFileWithExtensionMonitored
(ppSuffixes knownSuffixHandlers ++ exts)
(hsSourceDirs bi)
(toFilePath m)
>>= maybe (return ()) need
......@@ -324,6 +324,7 @@ executable cabal
Distribution.Client.SrcDist
Distribution.Client.SolverInstallPlan
Distribution.Client.SolverPlanIndex
Distribution.Client.SourceFiles
Distribution.Client.Tar
Distribution.Client.Targets
Distribution.Client.Types
......
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