[Pkg-haskell-commits] darcs: tools: Make ./haskell-pkg-debcheck-exp.hs read wanna-build status from, well, wanna-build

[Joachim Breitner]

Sat Nov 10 23:42:59 UTC 2012  Joachim Breitner <mail at joachim-breitner.de>
  * Make ./haskell-pkg-debcheck-exp.hs read wanna-build status from, well, wanna-build
  Ignore-this: 11df152e09d3b304370d07273ac4fd1e

    M ./haskell-pkg-debcheck-exp.hs -15 +11
    M ./mass-build.sh -1 +2

Sat Nov 10 23:42:59 UTC 2012  Joachim Breitner <mail at joachim-breitner.de>
  * Make ./haskell-pkg-debcheck-exp.hs read wanna-build status from, well, wanna-build
  Ignore-this: 11df152e09d3b304370d07273ac4fd1e
diff -rN -u old-tools//haskell-pkg-debcheck-exp.hs new-tools//haskell-pkg-debcheck-exp.hs
--- old-tools//haskell-pkg-debcheck-exp.hs	2012-11-10 23:43:24.030483401 +0000
+++ new-tools//haskell-pkg-debcheck-exp.hs	2012-11-10 23:43:24.050421319 +0000
@@ -86,37 +86,31 @@
             LB.readFile (binariesFiles arch)
     hPutStrLn stderr $ show (M.size binaryMap) ++ " binary/arch tuples selected."
         
-    {-
     hPutStr stderr "# Reading Wanna-Build-State..."
     wbMap <- 
         fmap unions $
         forM arches $ \arch ->
             toWBMap arch sourcesMap <$>
             (either (error.show) id) <$>
-            parseControl "Wanna-Build" <$>
-            BS.concat <$>
-            LB.toChunks <$>
-            GZip.decompress <$>
-            LB.readFile (wbDump arch)
+            parseControl "Wanna-Build" <$> do
+                (_, Just wbOut, _, _) <- createProcess $ (proc "wanna-build" ["-A",arch,"--export","/dev/fd/1","-d", "experimental"]) { std_out = CreatePipe }
+                BS.hGetContents wbOut
     hPutStrLn stderr $ show (M.size wbMap) ++ " source/arch tuples selected."
-    -}
         
     hPutStr stderr "# Reading edos-debcheck output..."
     problems <- removeArchAll <$> collectEdosOutput (filter isNotIgnored (M.keys bToS))
     hPutStrLn stderr $ show (length problems) ++ " problems detected."
 
-    {-
-    let outdatedSources = [] M.fromListWith mergeArches $ do -- list monad
+    let outdatedSources = M.fromListWith mergeArches $ do -- list monad
         ((s,a),(st,dw)) <- M.toList wbMap
         guard $ st /= "Installed"
         let sv = siVersion (sourcesMap ! s)
-        return (s,(S.singleton a, sv, "dummy"))
-        -}
+        return (s::SrcPkgName,(S.singleton a, sv, "dummy"))
 
     let nmus = M.fromListWith mergeArches $ do
         (p,a,_,x) <- problems
         guard $ (p,a) `member` binaryMap
-        let s  = bToS ! p
+        let s  = bToS ! p :: SrcPkgName
             si = sourcesMap ! s
             (_,bsv) = binaryMap ! (p,a)
             sv = siVersion si
@@ -125,7 +119,7 @@
         --guard (not (s `member` outdatedSources)) 
 
         -- Do not scheulde binNMUs if not in Installed state
-        -- guard (fst (wbMap ! (s,a)) == "Installed")
+        guard (fst (wbMap ! (s,a)) == "Installed")
         return (s,(S.singleton a, sv, formatReason x))
     
     forM (M.toList nmus) $ \(s,(as,sv,exp)) -> putStrLn $ "nmu " ++ unPkgName (unSrcPkgName s) ++ "_" ++ show sv ++ " . " ++ unwords (S.toList as) ++ " . experimental . -m '" ++ exp ++ "'"
@@ -228,10 +222,11 @@
     ) .
     unControl
 
+toWBMap :: Arch -> M.HashMap SrcPkgName SourceInfo -> Control' (BS.ByteString) -> M.HashMap (SrcPkgName, Arch) ([Char], Relations)
 toWBMap arch sourcesMap = 
     M.fromList . 
     mapMaybe (\para -> do -- Maybe monad
-        s <- BS.unpack <$>
+        s <- SrcPkgName . PkgName . BS.unpack <$>
              fieldValue "package" para
         guard (s `member` sourcesMap)
         v <- parseDebianVersion <$>
@@ -244,7 +239,7 @@
             unless (st `elem` ["Failed-Removed", "Not-For-Us"]) $ 
                 trace (printf "Version difference for %s on %s in state %s: \
                               \wb knows %s and Sources knows %s"
-                      s
+                      (unPkgName (unSrcPkgName s))
                       arch
                       st
                       (show v)
@@ -353,6 +348,7 @@
 showRelations = intercalate ", " . map (intercalate " | " . map show)
 
 -- Functions from Data.Map missing in Data.HashMap
+unions :: (Eq k, Hashable k) => [M.HashMap k v] -> M.HashMap k v
 unions = foldl M.union M.empty
 member k = isJust . M.lookup k
 unionWith f m1 m2 = M.foldrWithKey (M.insertWith f) m1 m2
diff -rN -u old-tools//mass-build.sh new-tools//mass-build.sh
--- old-tools//mass-build.sh	2012-11-10 23:43:23.906220504 +0000
+++ new-tools//mass-build.sh	2012-11-10 23:43:24.058734078 +0000
@@ -187,7 +187,8 @@
 fi
 dpkg-scansources . > Sources
 schroot -c $schroot -- bash -c "cat /var/lib/apt/lists/*Packages" > Packages
-installable=$(dose-builddebcheck -s --deb-native-arch=amd64 Packages Sources|perl -ne 'print "$1\n" if /package: src%3a(.*)/')
+#dose-builddebcheck --explain --failures --deb-native-arch=amd64 Packages Sources; exit
+installable=$(dose-builddebcheck --successes --deb-native-arch=amd64 Packages Sources|perl -ne 'print "$1\n" if /package: src%3a(.*)/')
 popd >/dev/null
 
 #echo "The following $(echo $uninstallable|wc -w) packages are uninstallable:"