[pkg-haskell-tools] 01/01: Only provide the recursive dependencies of the build in the temporary repository

[Joachim Breitner]

This is an automated email from the git hooks/post-receive script.

nomeata pushed a commit to branch recursive-deps
in repository pkg-haskell-tools.

commit 9bccdeb4477ff22743d09f0a647706df06204656
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Aug 14 13:51:39 2015 +0200

    Only provide the recursive dependencies of the build in the temporary repository
    
    Im putting this on hold when I noticed that I would have to resolve
    virtual packages to make this work...
---
 src/make-all.hs | 44 +++++++++++++++++++++++++++++++++-----------
 1 file changed, 33 insertions(+), 11 deletions(-)

diff --git a/src/make-all.hs b/src/make-all.hs
index 631755b..88f83e2 100644
--- a/src/make-all.hs
+++ b/src/make-all.hs
@@ -301,6 +301,12 @@ shakeMain conf@(Conf {..}) = do
 
     getBinToDeb <- addOracle $ \(GetBinToDeb bin) -> M.lookup bin <$> binToDebMap ()
 
+
+    let debToBin :: String -> String
+        debToBin filename = pkgname
+          where [pkgname, _version, _] = splitOn "_" $ takeFileName filename
+
+
     let binToDeb :: String -> Action (Maybe String)
         binToDeb = getBinToDeb . GetBinToDeb
 
@@ -342,6 +348,28 @@ shakeMain conf@(Conf {..}) = do
         ok <- doesFileExist out
         unless ok $ fail $ "Building " ++ source ++ " failed, remove " ++ logfile ++ " to retry."
 
+    depsOfBin <- newCache $ \debFileName -> do
+        need [debFileName]
+        dependsLine <- fromStdout <$>
+            cmd (Traced ("reading deps of " ++ debToBin debFileName))
+                ["dpkg-deb", "-f", debFileName, "Depends"]
+        return $ nub $ parseFlatRel dependsLine
+
+    let enumerateDeps :: [String] -> [String] -> [String] -> Action [String]
+        enumerateDeps seen depDebs [] = return depDebs
+
+        -- For the sake of packages like alex, uuagc etc, we exclude ourselves
+        -- from this, thus allowing the use of the binary from the archive to
+        -- bootstrap. So we initialize seen with our packages
+        enumerateDeps seen depDebs (p:todo) | p `elem` seen = enumerateDeps seen depDebs todo
+
+        enumerateDeps seen depDebs (p:todo) = do
+            debMB <- binToDeb p
+            case debMB of
+                Nothing -> enumerateDeps seen depDebs todo
+                Just deb -> do
+                    newDeps <- depsOfBin (targetDir </> deb)
+                    enumerateDeps (p:seen) (deb:depDebs) (newDeps ++ todo)
 
     -- Build log depends on the corresponding source, and the dependencies
     targetDir </> "*.build" %> \out -> do
@@ -356,18 +384,12 @@ shakeMain conf@(Conf {..}) = do
         need [targetDir </> dsc]
 
         -- This ensures all dependencies are up-to-date
-        deps <- liftIO $ dependsOfDsc $ targetDir </> dsc
-        putLoud $ "# " ++ source ++ " depends on:"
-        putLoud $ "# packages: " ++ intercalate "," deps
-        depFileNames <- catMaybes <$> mapM binToDeb deps
-        putLoud $ "# dependencies: " ++ intercalate "," depFileNames
-
+        -- and simultaneously collect their names
+        initialDeps <- liftIO $ dependsOfDsc $ targetDir </> dsc
         ourBins <- readFileLines $ targetDir </> "cache" </> "binaries" </> source <.> "txt"
+        let ourPkgs = map debToBin ourBins
+        dependencyDebFiles <- enumerateDeps ourPkgs [] initialDeps
 
-        -- For the sake of packages like alex, uuagc etc, we exclude ourselves
-        -- from this, thus allowing the use of the binary from the archive to
-        -- bootstrap.
-        need $ map (targetDir </>) $ filter (`notElem` ourBins) depFileNames
 
         -- What files do we have built locally?
         -- Make sure the build uses only them
@@ -388,7 +410,7 @@ shakeMain conf@(Conf {..}) = do
             -- Create a dummy repository
             let repoDir = tmpdir </> "repo"
             liftIO $ createDirectory repoDir
-            forM_ localDebs $ \p -> liftIO $ copyFile ("lab" </> p) (repoDir </> p)
+            forM_ dependencyDebFiles $ \p -> liftIO $ copyFile ("lab" </> p) (repoDir </> p)
             unit $ cmd (Cwd repoDir)  (EchoStderr False) (FileStdout (repoDir </> "Packages"))
                 ["dpkg-scanpackages", "."]
 

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-haskell/pkg-haskell-tools.git