diff --git a/cabal-install/Distribution/Client/IndexUtils.hs b/cabal-install/Distribution/Client/IndexUtils.hs index 871a09383f9..680e9854b68 100644 --- a/cabal-install/Distribution/Client/IndexUtils.hs +++ b/cabal-install/Distribution/Client/IndexUtils.hs @@ -129,8 +129,6 @@ convert index' = PackageIndex.fromList -- -- This is a higher level wrapper used internally in cabal-install. -- --- FIXME: 'getSourcePackages' has a lazy IO bug that leads to a 'resource busy' --- error when opening the "index-00.tar" file for a second time. getSourcePackages :: Verbosity -> [Repo] -> IO SourcePackageDb getSourcePackages verbosity [] = do warn verbosity $ "No remote package servers have been specified. Usually " @@ -228,7 +226,8 @@ whenCacheOutOfDate origFile cacheFile action = do else do origTime <- getModificationTime origFile cacheTime <- getModificationTime cacheFile - unless (cacheTime >= origTime) action + -- FIXME: Revert back to >= when we'll add finer-resolution mtime utils. + unless (cacheTime > origTime) action ------------------------------------------------------------------------ @@ -372,9 +371,9 @@ readPackageIndexCacheFile :: Package pkg -> FilePath -> IO (PackageIndex pkg, [Dependency]) readPackageIndexCacheFile mkPkg indexFile cacheFile = do - indexHnd <- openFile indexFile ReadMode cache <- liftM readIndexCache (BSS.readFile cacheFile) - packageIndexFromCache mkPkg indexHnd cache + withFile indexFile ReadMode $ \indexHnd -> + packageIndexFromCache mkPkg indexHnd cache packageIndexFromCache :: Package pkg diff --git a/cabal-install/Distribution/Client/Sandbox.hs b/cabal-install/Distribution/Client/Sandbox.hs index bc92a850c90..12656730f73 100644 --- a/cabal-install/Distribution/Client/Sandbox.hs +++ b/cabal-install/Distribution/Client/Sandbox.hs @@ -248,7 +248,8 @@ doAddSource verbosity buildTreeRefs sandboxDir pkgEnv = do -- If we're running 'sandbox add-source' for the first time for this compiler, -- we need to create an initial timestamp record. (comp, platform, _) <- configCompilerAux . savedConfigureFlags $ savedConfig - maybeAddCompilerTimestampRecord sandboxDir (compilerId comp) platform indexFile + maybeAddCompilerTimestampRecord verbosity sandboxDir indexFile + (compilerId comp) platform withAddTimestamps sandboxDir $ do -- FIXME: path canonicalisation is done in addBuildTreeRefs, but we do it @@ -333,15 +334,20 @@ sandboxDeleteSource verbosity buildTreeRefs _sandboxFlags globalFlags = do sandboxListSources :: Verbosity -> SandboxFlags -> GlobalFlags -> IO () sandboxListSources verbosity _sandboxFlags globalFlags = do - (_sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity + (sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity (globalConfigFile globalFlags) indexFile <- tryGetIndexFilePath (pkgEnvSavedConfig pkgEnv) - refs <- Index.listBuildTreeRefs indexFile + refs <- Index.listBuildTreeRefs verbosity Index.ListIgnored indexFile when (null refs) $ - info verbosity $ "Index file '" ++ indexFile + notice verbosity $ "Index file '" ++ indexFile ++ "' has no references to local build trees." - mapM_ putStrLn refs + when (not . null $ refs) $ do + notice verbosity $ "Source dependencies registered " + ++ "in the current sandbox ('" ++ sandboxDir ++ "'):\n\n" + mapM_ putStrLn refs + notice verbosity $ "\nTo unregister source dependencies, " + ++ "use the 'sandbox delete-source' command." -- | Invoke the @hc-pkg@ tool with provided arguments, restricted to the -- sandbox. @@ -427,7 +433,8 @@ reinstallAddSourceDeps verbosity config numJobsFlag sandboxDir globalFlags = do globalFlags' = savedGlobalFlags config `mappend` globalFlags indexFile <- tryGetIndexFilePath config - buildTreeRefs <- Index.listBuildTreeRefs indexFile + buildTreeRefs <- Index.listBuildTreeRefs verbosity + Index.DontListIgnored indexFile retVal <- newIORef NoDepsReinstalled unless (null buildTreeRefs) $ do diff --git a/cabal-install/Distribution/Client/Sandbox/Index.hs b/cabal-install/Distribution/Client/Sandbox/Index.hs index 044a95d7553..07dd4584958 100644 --- a/cabal-install/Distribution/Client/Sandbox/Index.hs +++ b/cabal-install/Distribution/Client/Sandbox/Index.hs @@ -11,6 +11,7 @@ module Distribution.Client.Sandbox.Index ( createEmpty, addBuildTreeRefs, removeBuildTreeRefs, + ListIgnoredBuildTreeRefs(..), listBuildTreeRefs, validateIndexPath, @@ -18,6 +19,11 @@ module Distribution.Client.Sandbox.Index ( ) where import qualified Distribution.Client.Tar as Tar +import Distribution.Client.IndexUtils ( getSourcePackages ) +import Distribution.Client.PackageIndex ( allPackages ) +import Distribution.Client.Types ( Repo(..), LocalRepo(..) + , SourcePackageDb(..) + , SourcePackage(..), PackageLocation(..) ) import Distribution.Client.Utils ( byteStringToFilePath, filePathToByteString , makeAbsoluteToCwd, tryCanonicalizePath ) @@ -160,14 +166,32 @@ removeBuildTreeRefs verbosity path l' = do Nothing -> True (Just pth) -> pth `notElem` l +-- | A build tree ref can become ignored if the user later adds a build tree ref +-- with the same package ID. We display ignored build tree refs when the user +-- runs 'cabal sandbox list-sources', but do not look at their timestamps in +-- 'reinstallAddSourceDeps'. +data ListIgnoredBuildTreeRefs = ListIgnored | DontListIgnored + -- | List the local build trees that are referred to from the index. -listBuildTreeRefs :: FilePath -> IO [FilePath] -listBuildTreeRefs path = do +listBuildTreeRefs :: Verbosity -> ListIgnoredBuildTreeRefs -> FilePath + -> IO [FilePath] +listBuildTreeRefs verbosity listIgnored path = do checkIndexExists path - buildTreeRefs <- readBuildTreePathsFromFile path + buildTreeRefs <- + case listIgnored of + DontListIgnored -> do + let repo = Repo { repoKind = Right LocalRepo + , repoLocalDir = takeDirectory path } + pkgIndex <- fmap packageIndex . getSourcePackages verbosity $ [repo] + return [ pkgPath | (LocalUnpackedPackage pkgPath) <- + map packageSource . allPackages $ pkgIndex ] + + ListIgnored -> readBuildTreePathsFromFile path + _ <- evaluate (length buildTreeRefs) return buildTreeRefs + -- | Check that the package index file exists and exit with error if it does not. checkIndexExists :: FilePath -> IO () checkIndexExists path = do diff --git a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs b/cabal-install/Distribution/Client/Sandbox/Timestamp.hs index aff044e4f0b..a9b6b3cdedd 100644 --- a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs +++ b/cabal-install/Distribution/Client/Sandbox/Timestamp.hs @@ -45,7 +45,8 @@ import Distribution.Text (display) import Distribution.Verbosity (Verbosity) import Distribution.Client.Utils (inDir, tryCanonicalizePath) -import Distribution.Client.Sandbox.Index (listBuildTreeRefs) +import Distribution.Client.Sandbox.Index + (ListIgnoredBuildTreeRefs(..), listBuildTreeRefs) import Distribution.Compat.Exception (catchIO) import Distribution.Compat.Time (EpochTime, getCurTime, @@ -135,11 +136,12 @@ removeTimestamps l pathsToRemove = foldr removeTimestamp [] l else t : rest -- | If a timestamp record for this compiler doesn't exist, add a new one. -maybeAddCompilerTimestampRecord :: FilePath -> CompilerId -> Platform - -> FilePath +maybeAddCompilerTimestampRecord :: Verbosity -> FilePath -> FilePath + -> CompilerId -> Platform -> IO () -maybeAddCompilerTimestampRecord sandboxDir compId platform indexFile = do - buildTreeRefs <- listBuildTreeRefs indexFile +maybeAddCompilerTimestampRecord verbosity sandboxDir indexFile + compId platform = do + buildTreeRefs <- listBuildTreeRefs verbosity DontListIgnored indexFile withTimestampFile sandboxDir $ \timestampRecords -> do let key = timestampRecordKey compId platform case lookup key timestampRecords of @@ -267,6 +269,7 @@ isDepModified verbosity now (packageDir, timestamp) = do when (modTime > now) $ warn verbosity $ "File '" ++ dep ++ "' has a modification time that is in the future." + -- FIXME: Revert back to >= when we'll add finer-resolution mtime utils. if modTime > timestamp then do debug verbosity ("Dependency has a modified source file: " ++ dep) diff --git a/cabal-install/Distribution/Compat/Time.hs b/cabal-install/Distribution/Compat/Time.hs index 0ab99432ffa..63a24c2a4f8 100644 --- a/cabal-install/Distribution/Compat/Time.hs +++ b/cabal-install/Distribution/Compat/Time.hs @@ -16,6 +16,10 @@ import System.Time (ClockTime(..), getClockTime -- | The number of seconds since the UNIX epoch type EpochTime = Int64 +-- FIXME: 'getModificationTime' has a very low (second-level) resolution in all +-- released GHCs, which is bad for our purposes. +-- See hackage.haskell.org/trac/ghc/ticket/7473 +-- We should copy the file modification utils that Shake uses. getModTime :: FilePath -> IO EpochTime getModTime path = do #if MIN_VERSION_directory(1,2,0) diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index 7f0c2f92df8..940422d553d 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -241,8 +241,8 @@ configureAction (configFlags, configExFlags) extraArgs globalFlags = do -- If we've switched to a new compiler, we need to add a timestamp record -- for this compiler to the timestamp file. indexFile <- tryGetIndexFilePath config - maybeAddCompilerTimestampRecord sandboxDir - (compilerId comp) platform indexFile + maybeAddCompilerTimestampRecord verbosity sandboxDir indexFile + (compilerId comp) platform maybeWithSandboxDirOnSearchPath useSandbox $ configure verbosity