Skip to content

Commit dec2282

Browse files
ezyangezyang
committed
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: Edward Z. Yang <[email protected]>
1 parent 40892a0 commit dec2282

File tree

4 files changed

+260
-26
lines changed

4 files changed

+260
-26
lines changed

‎cabal-install/Distribution/Client/ProjectBuilding.hs‎

Lines changed: 32 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -56,12 +56,15 @@ import Distribution.Client.FetchUtils
5656
import Distribution.Client.GlobalFlags (RepoContext)
5757
import qualified Distribution.Client.Tar as Tar
5858
import Distribution.Client.Setup (filterConfigureFlags)
59+
import Distribution.Client.SourceFiles
5960
import Distribution.Client.SrcDist (allPackageSourceFiles)
6061
import Distribution.Client.Utils (removeExistingFile)
6162

6263
import Distribution.Package hiding (InstalledPackageId, installedPackageId)
64+
import qualified Distribution.PackageDescription as PD
6365
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
6466
import qualified Distribution.InstalledPackageInfo as Installed
67+
import Distribution.Types.BuildType
6568
import Distribution.Simple.Program
6669
import qualified Distribution.Simple.Setup as Cabal
6770
import Distribution.Simple.Command (CommandUI)
@@ -85,7 +88,6 @@ import qualified Data.ByteString.Lazy as LBS
8588

8689
import Control.Monad
8790
import Control.Exception
88-
import Data.List
8991
import Data.Maybe
9092

9193
import System.FilePath
@@ -452,15 +454,14 @@ updatePackageBuildFileMonitor :: PackageFileMonitor
452454
-> MonitorTimestamp
453455
-> ElaboratedConfiguredPackage
454456
-> BuildStatusRebuild
455-
-> [FilePath]
457+
-> [MonitorFilePath]
456458
-> BuildResultMisc
457459
-> IO ()
458460
updatePackageBuildFileMonitor PackageFileMonitor{pkgFileMonitorBuild}
459461
srcdir timestamp pkg pkgBuildStatus
460-
allSrcFiles buildResult =
462+
monitors buildResult =
461463
updateFileMonitor pkgFileMonitorBuild srcdir (Just timestamp)
462-
(map monitorFileHashed allSrcFiles)
463-
buildComponents' buildResult
464+
monitors buildComponents' buildResult
464465
where
465466
(_pkgconfig, buildComponents) = packageFileMonitorKeyValues pkg
466467

@@ -1041,29 +1042,35 @@ buildInplaceUnpackedPackage verbosity
10411042
annotateFailureNoLog BuildFailed $
10421043
setup buildCommand buildFlags buildArgs
10431044

1044-
--TODO: [required eventually] this doesn't track file
1045-
--non-existence, so we could fail to rebuild if someone
1046-
--adds a new file which changes behavior.
1047-
allSrcFiles <-
1048-
let trySdist = allPackageSourceFiles verbosity scriptOptions srcdir
1049-
-- This is just a hack, to get semi-reasonable file
1050-
-- listings for the monitor
1051-
tryFallback = do
1052-
warn verbosity $
1053-
"Couldn't use sdist to compute source files; falling " ++
1054-
"back on recursive file scan."
1055-
filter (not . ("dist" `isPrefixOf`))
1056-
`fmap` getDirectoryContentsRecursive srcdir
1057-
in if elabSetupScriptCliVersion pkg >= mkVersion [1,17]
1058-
then do r <- trySdist
1059-
if null r
1060-
then tryFallback
1061-
else return r
1062-
else tryFallback
1045+
let listSimple =
1046+
execRebuild srcdir (needElaboratedConfiguredPackage pkg)
1047+
listSdist =
1048+
fmap (map monitorFileHashed) $
1049+
allPackageSourceFiles verbosity scriptOptions srcdir
1050+
ifNullThen m m' = do xs <- m
1051+
if null xs then m' else return xs
1052+
monitors <- case PD.buildType (elabPkgDescription pkg) of
1053+
Just Simple -> listSimple
1054+
-- If a Custom setup was used, AND the Cabal is recent
1055+
-- enough to have sdist --list-sources, use that to
1056+
-- determine the files that we need to track. This can
1057+
-- cause unnecessary rebuilding (for example, if README
1058+
-- is edited, we will try to rebuild) but there isn't
1059+
-- a more accurate Custom interface we can use to get
1060+
-- this info. We prefer not to use listSimple here
1061+
-- as it can miss extra source files that are considered
1062+
-- by the Custom setup.
1063+
_ | elabSetupScriptCliVersion pkg >= mkVersion [1,17]
1064+
-- However, sometimes sdist --list-sources will fail
1065+
-- and return an empty list. In that case, fall
1066+
-- back on the (inaccurate) simple tracking.
1067+
-> listSdist `ifNullThen` listSimple
1068+
| otherwise
1069+
-> listSimple
10631070

10641071
updatePackageBuildFileMonitor packageFileMonitor srcdir timestamp
10651072
pkg buildStatus
1066-
allSrcFiles buildResult
1073+
monitors buildResult
10671074

10681075
-- PURPOSELY omitted: no copy!
10691076

‎cabal-install/Distribution/Client/RebuildMonad.hs‎

Lines changed: 67 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ module Distribution.Client.RebuildMonad (
1212
-- * Rebuild monad
1313
Rebuild,
1414
runRebuild,
15+
execRebuild,
1516
askRoot,
1617

1718
-- * Setting up file monitoring
@@ -44,6 +45,12 @@ module Distribution.Client.RebuildMonad (
4445
getDirectoryContentsMonitored,
4546
createDirectoryMonitored,
4647
monitorDirectoryStatus,
48+
doesFileExistMonitored,
49+
need,
50+
needIfExists,
51+
findFileWithExtensionMonitored,
52+
findFirstFileMonitored,
53+
findFileMonitored,
4754
) where
4855

4956
import Prelude ()
@@ -58,7 +65,7 @@ import Distribution.Verbosity (Verbosity)
5865

5966
import Control.Monad.State as State
6067
import Control.Monad.Reader as Reader
61-
import System.FilePath (takeFileName)
68+
import System.FilePath
6269
import System.Directory
6370

6471

@@ -88,6 +95,10 @@ unRebuild rootDir (Rebuild action) = runStateT (runReaderT action rootDir) []
8895
runRebuild :: FilePath -> Rebuild a -> IO a
8996
runRebuild rootDir (Rebuild action) = evalStateT (runReaderT action rootDir) []
9097

98+
-- | Run a 'Rebuild' IO action.
99+
execRebuild :: FilePath -> Rebuild a -> IO [MonitorFilePath]
100+
execRebuild rootDir (Rebuild action) = execStateT (runReaderT action rootDir) []
101+
91102
-- | The root that relative paths are interpreted as being relative to.
92103
askRoot :: Rebuild FilePath
93104
askRoot = Rebuild Reader.ask
@@ -166,3 +177,58 @@ monitorDirectoryStatus dir = do
166177
then monitorDirectory dir
167178
else monitorNonExistentDirectory dir]
168179

180+
doesFileExistMonitored :: FilePath -> Rebuild Bool
181+
doesFileExistMonitored f = do
182+
root <- askRoot
183+
exists <- liftIO $ doesFileExist (root </> f)
184+
-- TODO: If the file exists, should we really monitor the entire
185+
-- file?!
186+
monitorFiles [if exists
187+
then monitorFileHashed f
188+
else monitorNonExistentFile f]
189+
return exists
190+
191+
-- | Monitor a single file
192+
need :: FilePath -> Rebuild ()
193+
need f = monitorFiles [monitorFileHashed f]
194+
195+
-- | Monitor a file if it exists; otherwise check for when it
196+
-- gets created. This is a bit better for recompilation avoidance
197+
-- because sometimes users give bad package metadata, and we don't
198+
-- want to repeatedly rebuild in this case (which we would if we
199+
-- need'ed a non-existent file).
200+
needIfExists :: FilePath -> Rebuild ()
201+
needIfExists f = do
202+
root <- askRoot
203+
exists <- liftIO $ doesFileExist (root </> f)
204+
monitorFiles [if exists
205+
then monitorFileHashed f
206+
else monitorNonExistentFile f]
207+
208+
-- | Like 'findFileWithExtension', but in the 'Rebuild' monad.
209+
findFileWithExtensionMonitored
210+
:: [String]
211+
-> [FilePath]
212+
-> FilePath
213+
-> Rebuild (Maybe FilePath)
214+
findFileWithExtensionMonitored extensions searchPath baseName =
215+
findFirstFileMonitored id
216+
[ path </> baseName <.> ext
217+
| path <- nub searchPath
218+
, ext <- nub extensions ]
219+
220+
-- | Like 'findFirstFile', but in the 'Rebuild' monad.
221+
findFirstFileMonitored :: (a -> FilePath) -> [a] -> Rebuild (Maybe a)
222+
findFirstFileMonitored file = findFirst
223+
where findFirst [] = return Nothing
224+
findFirst (x:xs) = do exists <- doesFileExistMonitored (file x)
225+
if exists
226+
then return (Just x)
227+
else findFirst xs
228+
229+
-- | Like 'findFile', but in the 'Rebuild' monad.
230+
findFileMonitored :: [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
231+
findFileMonitored searchPath fileName =
232+
findFirstFileMonitored id
233+
[ path </> fileName
234+
| path <- nub searchPath]

‎cabal-install/Distribution/Client/SourceFiles.hs‎

Lines changed: 160 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,160 @@
1+
-- | Contains an @sdist@ like function which computes the source files
2+
-- that we should track to determine if a rebuild is necessary.
3+
-- Unlike @sdist@, we can operate directly on the true
4+
-- 'PackageDescription' (not flattened).
5+
--
6+
-- The naming convention, roughly, is that to declare we need the
7+
-- source for some type T, you use the function needT; some functions
8+
-- need auxiliary information.
9+
--
10+
-- We can only use this code for non-Custom scripts; Custom scripts
11+
-- may have arbitrary extra dependencies (esp. new preprocessors) which
12+
-- we cannot "see" easily.
13+
module Distribution.Client.SourceFiles (needElaboratedConfiguredPackage) where
14+
15+
import Distribution.Client.ProjectPlanning.Types
16+
import Distribution.Client.RebuildMonad
17+
18+
import Distribution.Solver.Types.OptionalStanza
19+
20+
import Distribution.Simple.PreProcess
21+
22+
import Distribution.Types.PackageDescription
23+
import Distribution.Types.Component
24+
import Distribution.Types.ComponentRequestedSpec
25+
import Distribution.Types.Library
26+
import Distribution.Types.Executable
27+
import Distribution.Types.Benchmark
28+
import Distribution.Types.BenchmarkInterface
29+
import Distribution.Types.TestSuite
30+
import Distribution.Types.TestSuiteInterface
31+
import Distribution.Types.BuildInfo
32+
33+
import Distribution.ModuleName
34+
35+
import Prelude ()
36+
import Distribution.Client.Compat.Prelude
37+
38+
import System.FilePath
39+
import Control.Monad
40+
import qualified Data.Set as Set
41+
42+
needElaboratedConfiguredPackage :: ElaboratedConfiguredPackage -> Rebuild ()
43+
needElaboratedConfiguredPackage elab =
44+
case elabPkgOrComp elab of
45+
ElabComponent ecomp -> needElaboratedComponent elab ecomp
46+
ElabPackage epkg -> needElaboratedPackage elab epkg
47+
48+
needElaboratedPackage :: ElaboratedConfiguredPackage -> ElaboratedPackage -> Rebuild ()
49+
needElaboratedPackage elab epkg =
50+
mapM_ (needComponent pkg_descr) (enabledComponents pkg_descr enabled)
51+
where
52+
pkg_descr = elabPkgDescription elab
53+
enabled_stanzas = pkgStanzasEnabled epkg
54+
-- TODO: turn this into a helper function somewhere
55+
enabled =
56+
ComponentRequestedSpec {
57+
testsRequested = TestStanzas `Set.member` enabled_stanzas,
58+
benchmarksRequested = BenchStanzas `Set.member` enabled_stanzas
59+
}
60+
61+
needElaboratedComponent :: ElaboratedConfiguredPackage -> ElaboratedComponent -> Rebuild ()
62+
needElaboratedComponent elab ecomp =
63+
case mb_comp of
64+
Nothing -> needSetup
65+
Just comp -> needComponent pkg_descr comp
66+
where
67+
pkg_descr = elabPkgDescription elab
68+
mb_comp = fmap (getComponent pkg_descr) (compComponentName ecomp)
69+
70+
needComponent :: PackageDescription -> Component -> Rebuild ()
71+
needComponent pkg_descr comp =
72+
case comp of
73+
CLib lib -> needLibrary pkg_descr lib
74+
CExe exe -> needExecutable pkg_descr exe
75+
CTest test -> needTestSuite pkg_descr test
76+
CBench bench -> needBenchmark pkg_descr bench
77+
78+
needSetup :: Rebuild ()
79+
needSetup = findFirstFileMonitored id ["Setup.hs", "Setup.lhs"] >> return ()
80+
81+
needLibrary :: PackageDescription -> Library -> Rebuild ()
82+
needLibrary pkg_descr (Library { exposedModules = modules
83+
, signatures = sigs
84+
, libBuildInfo = bi })
85+
= needBuildInfo pkg_descr bi (modules ++ sigs)
86+
87+
needExecutable :: PackageDescription -> Executable -> Rebuild ()
88+
needExecutable pkg_descr (Executable { modulePath = mainPath
89+
, buildInfo = bi })
90+
= do needBuildInfo pkg_descr bi []
91+
needMainFile bi mainPath
92+
93+
needTestSuite :: PackageDescription -> TestSuite -> Rebuild ()
94+
needTestSuite pkg_descr t
95+
= case testInterface t of
96+
TestSuiteExeV10 _ mainPath -> do
97+
needBuildInfo pkg_descr bi []
98+
needMainFile bi mainPath
99+
TestSuiteLibV09 _ m ->
100+
needBuildInfo pkg_descr bi [m]
101+
TestSuiteUnsupported _ -> return () -- soft fail
102+
where
103+
bi = testBuildInfo t
104+
105+
needMainFile :: BuildInfo -> FilePath -> Rebuild ()
106+
needMainFile bi mainPath = do
107+
-- The matter here is subtle. It might *seem* that we
108+
-- should just search for mainPath, but as per
109+
-- b61cb051f63ed5869b8f4a6af996ff7e833e4b39 'main-is'
110+
-- will actually be the source file AFTER preprocessing,
111+
-- whereas we need to get the file *prior* to preprocessing.
112+
ppFile <- findFileWithExtensionMonitored
113+
(ppSuffixes knownSuffixHandlers)
114+
(hsSourceDirs bi)
115+
(dropExtension mainPath)
116+
case ppFile of
117+
-- But check the original path in the end, because
118+
-- maybe it's a non-preprocessed file with a non-traditional
119+
-- extension.
120+
Nothing -> findFileMonitored (hsSourceDirs bi) mainPath
121+
>>= maybe (return ()) need
122+
Just pp -> need pp
123+
124+
needBenchmark :: PackageDescription -> Benchmark -> Rebuild ()
125+
needBenchmark pkg_descr bm
126+
= case benchmarkInterface bm of
127+
BenchmarkExeV10 _ mainPath -> do
128+
needBuildInfo pkg_descr bi []
129+
needMainFile bi mainPath
130+
BenchmarkUnsupported _ -> return () -- soft fail
131+
where
132+
bi = benchmarkBuildInfo bm
133+
134+
needBuildInfo :: PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
135+
needBuildInfo pkg_descr bi modules = do
136+
-- NB: These are separate because there may be both A.hs and
137+
-- A.hs-boot; need to track both.
138+
findNeededModules ["hs", "lhs", "hsig", "lhsig"]
139+
findNeededModules ["hs-boot", "lhs-boot"]
140+
mapM_ needIfExists (cSources bi ++ jsSources bi)
141+
-- A MASSIVE HACK to (1) make sure we rebuild when header
142+
-- files change, but (2) not have to rebuild when anything
143+
-- in extra-src-files changes (most of these won't affect
144+
-- compilation). It would be even better if we knew on a
145+
-- per-component basis which headers would be used but that
146+
-- seems to be too difficult.
147+
mapM_ needIfExists (filter ((==".h").takeExtension) (extraSrcFiles pkg_descr))
148+
forM_ (installIncludes bi) $ \f ->
149+
findFileMonitored ("." : includeDirs bi) f
150+
>>= maybe (return ()) need
151+
where
152+
findNeededModules exts =
153+
mapM_ (findNeededModule exts)
154+
(modules ++ otherModules bi)
155+
findNeededModule exts m =
156+
findFileWithExtensionMonitored
157+
(ppSuffixes knownSuffixHandlers ++ exts)
158+
(hsSourceDirs bi)
159+
(toFilePath m)
160+
>>= maybe (return ()) need

‎cabal-install/cabal-install.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -324,6 +324,7 @@ executable cabal
324324
Distribution.Client.SrcDist
325325
Distribution.Client.SolverInstallPlan
326326
Distribution.Client.SolverPlanIndex
327+
Distribution.Client.SourceFiles
327328
Distribution.Client.Tar
328329
Distribution.Client.Targets
329330
Distribution.Client.Types

0 commit comments

Comments
 (0)