Skip to content

Commit 0068715

Browse files
ezyangezyang
committed
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 <[email protected]>
1 parent e8cd369 commit 0068715

File tree

3 files changed

+60
-66
lines changed

3 files changed

+60
-66
lines changed

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

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ import Distribution.Client.FetchUtils
3636
import Distribution.Client.GlobalFlags (RepoContext)
3737
import qualified Distribution.Client.Tar as Tar
3838
import Distribution.Client.Setup (filterConfigureFlags)
39+
import Distribution.Client.SrcDist (allPackageSourceFiles)
3940
import Distribution.Client.Utils (removeExistingFile)
4041

4142
import Distribution.Package hiding (InstalledPackageId, installedPackageId)
@@ -1134,10 +1135,10 @@ buildInplaceUnpackedPackage verbosity
11341135
timestamp <- beginUpdateFileMonitor
11351136
setup buildCommand buildFlags buildArgs
11361137

1137-
--TODO: [required eventually] temporary hack. We need to look at the package description
1138-
-- and work out the exact file monitors to use
1139-
allSrcFiles <- filter (not . ("dist-newstyle" `isPrefixOf`))
1140-
<$> getDirectoryContentsRecursive srcdir
1138+
--TODO: [required eventually] this doesn't track file
1139+
--non-existence, so we could fail to rebuild if someone
1140+
--adds a new file which changes behavior.
1141+
allSrcFiles <- allPackageSourceFiles verbosity srcdir
11411142

11421143
updatePackageBuildFileMonitor packageFileMonitor srcdir timestamp
11431144
pkg buildStatus

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

Lines changed: 4 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,6 @@ module Distribution.Client.Sandbox.Timestamp (
2121
writeTimestampFile
2222
) where
2323

24-
import Control.Exception (IOException)
2524
import Control.Monad (filterM, forM, when)
2625
import Data.Char (isSpace)
2726
import Data.List (partition)
@@ -30,29 +29,15 @@ import System.FilePath ((<.>), (</>))
3029
import qualified Data.Map as M
3130

3231
import Distribution.Compiler (CompilerId)
33-
import Distribution.Package (packageName)
34-
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
35-
import Distribution.PackageDescription.Parse (readPackageDescription)
36-
import Distribution.Simple.Setup (Flag (..),
37-
SDistFlags (..),
38-
defaultSDistFlags,
39-
sdistCommand)
4032
import Distribution.Simple.Utils (debug, die, warn)
4133
import Distribution.System (Platform)
4234
import Distribution.Text (display)
43-
import Distribution.Verbosity (Verbosity, lessVerbose,
44-
normal)
45-
import Distribution.Version (Version (..),
46-
orLaterVersion)
35+
import Distribution.Verbosity (Verbosity)
4736

37+
import Distribution.Client.SrcDist (allPackageSourceFiles)
4838
import Distribution.Client.Sandbox.Index
4939
(ListIgnoredBuildTreeRefs (ListIgnored), RefTypesToList(OnlyLinks)
5040
,listBuildTreeRefs)
51-
import Distribution.Client.SetupWrapper (SetupScriptOptions (..),
52-
defaultSetupScriptOptions,
53-
setupWrapper)
54-
import Distribution.Client.Utils
55-
(inDir, removeExistingFile, tryCanonicalizePath, tryFindAddSourcePackageDesc)
5641

5742
import Distribution.Compat.Exception (catchIO)
5843
import Distribution.Client.Compat.Time (ModTime, getCurTime,
@@ -238,45 +223,6 @@ withActionOnCompilerTimestamps f sandboxDir compId platform act = do
238223
else return r
239224
return timestampRecords'
240225

241-
-- | List all source files of a given add-source dependency. Exits with error if
242-
-- something is wrong (e.g. there is no .cabal file in the given directory).
243-
-- FIXME: This function is not thread-safe because of 'inDir'.
244-
allPackageSourceFiles :: Verbosity -> FilePath -> IO [FilePath]
245-
allPackageSourceFiles verbosity packageDir = inDir (Just packageDir) $ do
246-
pkg <- do
247-
let err = "Error reading source files of add-source dependency."
248-
desc <- tryFindAddSourcePackageDesc packageDir err
249-
flattenPackageDescription `fmap` readPackageDescription verbosity desc
250-
let file = "cabal-sdist-list-sources"
251-
flags = defaultSDistFlags {
252-
sDistVerbosity = Flag $ if verbosity == normal
253-
then lessVerbose verbosity else verbosity,
254-
sDistListSources = Flag file
255-
}
256-
setupOpts = defaultSetupScriptOptions {
257-
-- 'sdist --list-sources' was introduced in Cabal 1.18.
258-
useCabalVersion = orLaterVersion $ Version [1,18,0] []
259-
}
260-
261-
doListSources :: IO [FilePath]
262-
doListSources = do
263-
setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags) []
264-
srcs <- fmap lines . readFile $ file
265-
mapM tryCanonicalizePath srcs
266-
267-
onFailedListSources :: IOException -> IO ()
268-
onFailedListSources e = do
269-
warn verbosity $
270-
"Could not list sources of the add-source dependency '"
271-
++ display (packageName pkg) ++ "'. Skipping the timestamp check."
272-
debug verbosity $
273-
"Exception was: " ++ show e
274-
275-
-- Run setup sdist --list-sources=TMPFILE
276-
ret <- doListSources `catchIO` (\e -> onFailedListSources e >> return [])
277-
removeExistingFile file
278-
return ret
279-
280226
-- | Has this dependency been modified since we have last looked at it?
281227
isDepModified :: Verbosity -> ModTime -> AddSourceTimestamp -> IO Bool
282228
isDepModified verbosity now (packageDir, timestamp) = do
@@ -286,9 +232,10 @@ isDepModified verbosity now (packageDir, timestamp) = do
286232

287233
where
288234
go [] = return False
289-
go (dep:rest) = do
235+
go (dep0:rest) = do
290236
-- FIXME: What if the clock jumps backwards at any point? For now we only
291237
-- print a warning.
238+
let dep = packageDir </> dep0
292239
modTime <- getModTime dep
293240
when (modTime > now) $
294241
warn verbosity $ "File '" ++ dep

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

Lines changed: 51 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,8 @@
22
-- distribution for this package. That is, packs up the source code
33
-- into a tarball, making use of the corresponding Cabal module.
44
module Distribution.Client.SrcDist (
5-
sdist
5+
sdist,
6+
allPackageSourceFiles
67
) where
78

89

@@ -11,7 +12,7 @@ import Distribution.Client.SetupWrapper
1112
import Distribution.Client.Tar (createTarGzFile)
1213

1314
import Distribution.Package
14-
( Package(..) )
15+
( Package(..), packageName )
1516
import Distribution.PackageDescription
1617
( PackageDescription )
1718
import Distribution.PackageDescription.Configuration
@@ -20,23 +21,29 @@ import Distribution.PackageDescription.Parse
2021
( readPackageDescription )
2122
import Distribution.Simple.Utils
2223
( createDirectoryIfMissingVerbose, defaultPackageDesc
23-
, die, notice, withTempDirectory )
24+
, warn, die, notice, withTempDirectory )
2425
import Distribution.Client.Setup
2526
( SDistFlags(..), SDistExFlags(..), ArchiveFormat(..) )
2627
import Distribution.Simple.Setup
27-
( Flag(..), sdistCommand, flagToList, fromFlag, fromFlagOrDefault )
28+
( Flag(..), sdistCommand, flagToList, fromFlag, fromFlagOrDefault
29+
, defaultSDistFlags )
2830
import Distribution.Simple.BuildPaths ( srcPref)
2931
import Distribution.Simple.Program (requireProgram, simpleProgram, programPath)
3032
import Distribution.Simple.Program.Db (emptyProgramDb)
3133
import Distribution.Text ( display )
32-
import Distribution.Verbosity (Verbosity)
34+
import Distribution.Verbosity (Verbosity, normal, lessVerbose)
3335
import Distribution.Version (Version(..), orLaterVersion)
3436

37+
import Distribution.Client.Utils
38+
(removeExistingFile, tryFindAddSourcePackageDesc)
39+
import Distribution.Compat.Exception (catchIO)
40+
3541
import System.FilePath ((</>), (<.>))
3642
import Control.Monad (when, unless, liftM)
3743
import System.Directory (doesFileExist, removeFile, canonicalizePath)
3844
import System.Process (runProcess, waitForProcess)
3945
import System.Exit (ExitCode(..))
46+
import Control.Exception (IOException)
4047

4148
-- |Create a source distribution.
4249
sdist :: SDistFlags -> SDistExFlags -> IO ()
@@ -136,3 +143,42 @@ createZipArchive verbosity pkg tmpDir targetPref = do
136143
notice verbosity $ "Source zip archive created: " ++ zipfile
137144
where
138145
zipProgram = simpleProgram "zip"
146+
147+
-- | List all source files of a given add-source dependency. Exits with error if
148+
-- something is wrong (e.g. there is no .cabal file in the given directory).
149+
allPackageSourceFiles :: Verbosity -> FilePath -> IO [FilePath]
150+
allPackageSourceFiles verbosity packageDir = do
151+
pkg <- do
152+
let err = "Error reading source files of package."
153+
desc <- tryFindAddSourcePackageDesc packageDir err
154+
flattenPackageDescription `fmap` readPackageDescription verbosity desc
155+
let -- TODO: allocate a temporary directory for this, more thread safe.
156+
file = packageDir </> "cabal-sdist-list-sources"
157+
flags = defaultSDistFlags {
158+
sDistVerbosity = Flag $ if verbosity == normal
159+
then lessVerbose verbosity else verbosity,
160+
sDistListSources = Flag file
161+
}
162+
setupOpts = defaultSetupScriptOptions {
163+
-- 'sdist --list-sources' was introduced in Cabal 1.18.
164+
useCabalVersion = orLaterVersion $ Version [1,18,0] [],
165+
useWorkingDir = Just packageDir
166+
}
167+
168+
doListSources :: IO [FilePath]
169+
doListSources = do
170+
setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags) []
171+
fmap lines . readFile $ file
172+
173+
onFailedListSources :: IOException -> IO ()
174+
onFailedListSources e = do
175+
warn verbosity $
176+
"Could not list sources of the package '"
177+
++ display (packageName pkg) ++ "'."
178+
warn verbosity $
179+
"Exception was: " ++ show e
180+
181+
-- Run setup sdist --list-sources=TMPFILE
182+
ret <- doListSources `catchIO` (\e -> onFailedListSources e >> return [])
183+
removeExistingFile file
184+
return ret

0 commit comments

Comments
 (0)