[Pkg-haskell-commits] darcs: tools: Format NMU commands nicely

[Joachim Breitner]

Tue Mar  4 09:43:50 UTC 2014  Joachim Breitner <mail at joachim-breitner.de>
  * Format NMU commands nicely

    M ./haskell-pkg-debcheck.hs -6 +11

Tue Mar  4 09:43:50 UTC 2014  Joachim Breitner <mail at joachim-breitner.de>
  * Format NMU commands nicely
diff -rN -u old-tools/haskell-pkg-debcheck.hs new-tools/haskell-pkg-debcheck.hs
--- old-tools/haskell-pkg-debcheck.hs	2014-03-04 09:44:00.298347811 +0000
+++ new-tools/haskell-pkg-debcheck.hs	2014-03-04 09:44:00.370347804 +0000
@@ -131,7 +131,7 @@
 
         -- Do not scheulde binNMUs if not in Installed state
         guard (fst (wbMap ! (s,a)) == "Installed")
-        return (s,(S.singleton a, sv, formatReason x))
+        return (s,(S.singleton a, sv, x))
     
     forM (M.toList nmus) $ \(s,(as,sv,exp)) -> putStrLn $ "nmu " ++ show (pretty s) ++ "_" ++ show (prettyDebianVersion sv) ++ " . " ++ unwords (S.toList as) ++ " . -m '" ++ exp ++ "'"
     
@@ -292,7 +292,7 @@
     fromReport (Object o) = ( BinPkgName $ str "package"
                    , str "architecture"
                    , parseDebianVersion $ str "version"
-                   , show (o M.! "reasons")
+                   , formatReason (o M.! "reasons")
                    )
          where str n = let String s = o M.! n in T.unpack s
 
@@ -302,10 +302,15 @@
 isNotIgnored :: BinPkgName -> Bool
 isNotIgnored pkg = not ("-doc" `isSuffixOf` unBinPkgName pkg || "-prof" `isSuffixOf` unBinPkgName pkg)
 
-formatReason :: String -> String
-formatReason s  = "Dependency " ++ packageName ++ " not available any more"
-  where lastLine = last (lines s)
-        packageName = drop 4 lastLine
+formatReason :: Value -> String
+formatReason (Array rs) =
+    intercalate ", "
+    [ "missing " ++ T.unpack dep
+    | Object r <- V.toList rs
+    , let Just (Object m) = M.lookup "missing" r
+    , let Just (Object p) = M.lookup "pkg" m
+    , let Just (String dep) = M.lookup "unsat-dependency" p
+    ]
 
 filterExistingDepWaits wbMap = mapWithKey $ \(s,v) -> mapWithKey $ \a dw -> 
     case (s,a) `M.lookup` wbMap of