diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Linking.hs b/cabal-install/Distribution/Client/Dependency/Modular/Linking.hs index 184e7fbe69f..f80016032ce 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Linking.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Linking.hs @@ -32,7 +32,7 @@ import qualified Distribution.Client.Dependency.Modular.PSQ as P import qualified Distribution.Client.Dependency.Modular.ConflictSet as CS import Distribution.Client.Types (OptionalStanza(..)) -import Distribution.Client.ComponentDeps (Component) +import Distribution.Client.ComponentDeps (Component(ComponentSetup)) {------------------------------------------------------------------------------- Add linking @@ -206,7 +206,7 @@ conflict = lift' . Left execUpdateState :: UpdateState () -> ValidateState -> Either Conflict ValidateState execUpdateState = execStateT . unUpdateState -pickPOption :: QPN -> POption -> FlaggedDeps comp QPN -> UpdateState () +pickPOption :: QPN -> POption -> FlaggedDeps Component QPN -> UpdateState () pickPOption qpn (POption i Nothing) _deps = pickConcrete qpn i pickPOption qpn (POption i (Just pp')) deps = pickLink qpn i pp' deps @@ -224,7 +224,7 @@ pickConcrete qpn@(Q pp _) i = do Just lg -> makeCanonical lg qpn i -pickLink :: QPN -> I -> PP -> FlaggedDeps comp QPN -> UpdateState () +pickLink :: QPN -> I -> PP -> FlaggedDeps Component QPN -> UpdateState () pickLink qpn@(Q _pp pn) i pp' deps = do vs <- get @@ -279,10 +279,12 @@ makeCanonical lg qpn@(Q pp _) i = -- because having the direct dependencies in a link group means that we must -- have already made or will make sooner or later a link choice for one of these -- as well, and cover their dependencies at that point. -linkDeps :: [Var QPN] -> PP -> FlaggedDeps comp QPN -> UpdateState () +linkDeps :: [Var QPN] -> PP -> FlaggedDeps Component QPN -> UpdateState () linkDeps parents pp' = mapM_ go where - go :: FlaggedDep comp QPN -> UpdateState () + go :: FlaggedDep Component QPN -> UpdateState () + -- Skip setup dependencies. + go (Simple _ ComponentSetup) = return () go (Simple (Dep qpn@(Q _ pn) _) _) = do vs <- get let qpn' = Q pp' pn diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs index e47633df0b9..b015a3052ce 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -40,6 +40,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) @@ -1138,10 +1139,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 diff --git a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs b/cabal-install/Distribution/Client/Sandbox/Timestamp.hs index 1fb749c6acf..5125c4f2ba5 100644 --- a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs +++ b/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.Client.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 diff --git a/cabal-install/Distribution/Client/SrcDist.hs b/cabal-install/Distribution/Client/SrcDist.hs index 4499cc572f9..ce627b48edf 100644 --- a/cabal-install/Distribution/Client/SrcDist.hs +++ b/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 diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs index 8a68ab685eb..2b123493716 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs @@ -56,14 +56,15 @@ tests = [ , runTest $ indep $ mkTest db6 "depsWithTests2" ["C", "D"] (Just [("A", 1), ("B", 1), ("C", 1), ("D", 1)]) ] , testGroup "Setup dependencies" [ - runTest $ mkTest db7 "setupDeps1" ["B"] (Just [("A", 2), ("B", 1)]) - , runTest $ mkTest db7 "setupDeps2" ["C"] (Just [("A", 2), ("C", 1)]) - , runTest $ mkTest db7 "setupDeps3" ["D"] (Just [("A", 1), ("D", 1)]) - , runTest $ mkTest db7 "setupDeps4" ["E"] (Just [("A", 1), ("A", 2), ("E", 1)]) - , runTest $ mkTest db7 "setupDeps5" ["F"] (Just [("A", 1), ("A", 2), ("F", 1)]) - , runTest $ mkTest db8 "setupDeps6" ["C", "D"] (Just [("A", 1), ("B", 1), ("B", 2), ("C", 1), ("D", 1)]) - , runTest $ mkTest db9 "setupDeps7" ["F", "G"] (Just [("A", 1), ("B", 1), ("B",2 ), ("C", 1), ("D", 1), ("E", 1), ("E", 2), ("F", 1), ("G", 1)]) - , runTest $ mkTest db10 "setupDeps8" ["C"] (Just [("C", 1)]) + runTest $ mkTest db7 "setupDeps1" ["B"] (Just [("A", 2), ("B", 1)]) + , runTest $ mkTest db7 "setupDeps2" ["C"] (Just [("A", 2), ("C", 1)]) + , runTest $ mkTest db7 "setupDeps3" ["D"] (Just [("A", 1), ("D", 1)]) + , runTest $ mkTest db7 "setupDeps4" ["E"] (Just [("A", 1), ("A", 2), ("E", 1)]) + , runTest $ mkTest db7 "setupDeps5" ["F"] (Just [("A", 1), ("A", 2), ("F", 1)]) + , runTest $ mkTest db8 "setupDeps6" ["C", "D"] (Just [("A", 1), ("B", 1), ("B", 2), ("C", 1), ("D", 1)]) + , runTest $ mkTest db9 "setupDeps7" ["F", "G"] (Just [("A", 1), ("B", 1), ("B",2 ), ("C", 1), ("D", 1), ("E", 1), ("E", 2), ("F", 1), ("G", 1)]) + , runTest $ mkTest db10 "setupDeps8" ["C"] (Just [("C", 1)]) + , runTest $ indep $ mkTest dbSetupDeps "setupDeps9" ["A", "B"] (Just [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2)]) ] , testGroup "Base shim" [ runTest $ mkTest db11 "baseShim1" ["A"] (Just [("A", 1)]) @@ -397,6 +398,23 @@ db10 = , Right $ exAv "C" 1 [ExFix "A" 2] `withSetupDeps` [ExFix "A" 1] ] +-- | This database tests that linking a package does not also link the package's +-- setup dependencies. +-- +-- When A and B are installed as independent goals, their dependencies on C must +-- be linked, due to the single instance restriction. Since C depends on D, 0.D +-- and 1.D must also be linked. However, C's setup dependency on D should remain +-- independent. The solver should be able to choose D-1 for C's library and D-2 +-- for C's setup script. +dbSetupDeps :: ExampleDb +dbSetupDeps = [ + Right $ exAv "A" 1 [ExAny "C"] + , Right $ exAv "B" 1 [ExAny "C"] + , Right $ exAv "C" 1 [ExFix "D" 1] `withSetupDeps` [ExFix "D" 2] + , Right $ exAv "D" 1 [] + , Right $ exAv "D" 2 [] + ] + -- | Tests for dealing with base shims db11 :: ExampleDb db11 =