[commit: packages/Cabal] ghc-head: Skip the timestamp check for add-source deps that are not installed. (acf0883)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/Cabal

On branch  : ghc-head
Link       : http://git.haskell.org/?p=packages/Cabal.git;a=commit;h=acf08833d5a872fc15c4e6b463d163ad9765c35e

>---------------------------------------------------------------

commit acf08833d5a872fc15c4e6b463d163ad9765c35e
Author: Mikhail Glushenkov <mikhail.glushenkov at gmail.com>
Date:   Tue Jun 4 14:49:59 2013 +0200

    Skip the timestamp check for add-source deps that are not installed.


>---------------------------------------------------------------

acf08833d5a872fc15c4e6b463d163ad9765c35e
 cabal-install/Distribution/Client/Sandbox.hs       |   24 ++++++++++----------
 .../Distribution/Client/Sandbox/Timestamp.hs       |    9 ++++++--
 2 files changed, 19 insertions(+), 14 deletions(-)

diff --git a/cabal-install/Distribution/Client/Sandbox.hs b/cabal-install/Distribution/Client/Sandbox.hs
index 7c84e25..2ad35dd 100644
--- a/cabal-install/Distribution/Client/Sandbox.hs
+++ b/cabal-install/Distribution/Client/Sandbox.hs
@@ -98,6 +98,7 @@ import Data.Bits                              ( shiftL, shiftR, xor )
 import Data.Char                              ( ord )
 import Data.IORef                             ( newIORef, writeIORef, readIORef )
 import Data.List                              ( delete, foldl' )
+import Data.Maybe                             ( fromJust )
 import Data.Monoid                            ( mempty, mappend )
 import Data.Word                              ( Word32 )
 import Numeric                                ( showHex )
@@ -558,20 +559,19 @@ withSandboxPackageInfo verbosity configFlags globalFlags
   -- Get the package descriptions for all add-source deps.
   depsCabalFiles <- mapM findPackageDesc buildTreeRefs
   depsPkgDescs   <- mapM (readPackageDescription verbosity) depsCabalFiles
-  let depsMap     = M.fromList (zip buildTreeRefs depsPkgDescs)
+  let depsMap           = M.fromList (zip buildTreeRefs depsPkgDescs)
+      isInstalled pkgid = not . null
+        . InstalledPackageIndex.lookupSourcePackageId installedPkgIndex $ pkgid
+      installedDepsMap  = M.filter (isInstalled . packageId) depsMap
 
   -- Get the package ids of modified (and installed) add-source deps.
-  -- TODO: Skip the timestamp check for those add-source deps which are not
-  -- installed.
   modifiedAddSourceDeps <- listModifiedDeps verbosity sandboxDir
-                           (compilerId comp) platform
-  let isInstalled pkgid = not . null
-        . InstalledPackageIndex.lookupSourcePackageId installedPkgIndex $ pkgid
-      isModified path   = path `elem` modifiedAddSourceDeps
-      modifiedDepsMap   = M.filterWithKey
-        (\path pkgDesc -> isInstalled (packageId pkgDesc) && isModified path )
-        depsMap
-      modifiedDeps      = M.assocs modifiedDepsMap
+                           (compilerId comp) platform installedDepsMap
+  -- 'fromJust' here is safe because 'modifiedAddSourceDeps' are guaranteed to
+  -- be a subset of the keys of 'depsMap'.
+  let modifiedDeps    = [ (modDepPath, fromJust $ M.lookup modDepPath depsMap)
+                        | modDepPath <- modifiedAddSourceDeps ]
+      modifiedDepsMap = M.fromList modifiedDeps
 
   assert (all (`S.member` allAddSourceDepsSet) modifiedAddSourceDeps) (return ())
   unless (null modifiedDeps) $
@@ -580,7 +580,7 @@ withSandboxPackageInfo verbosity configFlags globalFlags
 
   -- Get the package ids of the remaining add-source deps (some are possibly not
   -- installed).
-  let otherDeps         = M.assocs (depsMap `M.difference` modifiedDepsMap)
+  let otherDeps = M.assocs (depsMap `M.difference` modifiedDepsMap)
 
   -- Finally, assemble a 'SandboxPackageInfo'.
   cont $ SandboxPackageInfo (map toSourcePackage modifiedDeps)
diff --git a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs b/cabal-install/Distribution/Client/Sandbox/Timestamp.hs
index b75337d..699e50d 100644
--- a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs
+++ b/cabal-install/Distribution/Client/Sandbox/Timestamp.hs
@@ -23,6 +23,7 @@ import Data.Char                                     (isSpace)
 import Data.List                                     (partition)
 import System.Directory                              (renameFile)
 import System.FilePath                               ((<.>), (</>))
+import qualified Data.Map as M
 
 import Distribution.Compiler                         (CompilerId)
 import Distribution.PackageDescription.Configuration (flattenPackageDescription)
@@ -257,14 +258,18 @@ isDepModified verbosity now (packageDir, timestamp) = do
 
 -- | List all modified dependencies.
 listModifiedDeps :: Verbosity -> FilePath -> CompilerId -> Platform
+                    -> M.Map FilePath a
+                       -- ^ The set of all installed add-source deps.
                     -> IO [FilePath]
-listModifiedDeps verbosity sandboxDir compId platform = do
+listModifiedDeps verbosity sandboxDir compId platform installedDepsMap = do
   timestampRecords <- readTimestampFile (sandboxDir </> timestampFileName)
   let needle        = timestampRecordKey compId platform
   timestamps       <- maybe noTimestampRecord return
                       (lookup needle timestampRecords)
   now <- getCurTime
-  fmap (map fst) . filterM (isDepModified verbosity now) $ timestamps
+  fmap (map fst) . filterM (isDepModified verbosity now)
+    . filter (\ts -> fst ts `M.member` installedDepsMap)
+    $ timestamps
 
   where
     noTimestampRecord = die $ "Сouldn't find a timestamp record for the given "