[Pkg-haskell-commits] [tools] 02/03: Print summary of observed problems

[Joachim Breitner]

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

nomeata pushed a commit to branch master
in repository tools.

commit a3a6477386bbeee0549a0c0c7ad5ccba1a61e43a
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Aug 26 11:29:46 2014 -0700

    Print summary of observed problems
---
 binNMUs.hs | 49 +++++++++++++++++++++++++++++++++----------------
 1 file changed, 33 insertions(+), 16 deletions(-)

diff --git a/binNMUs.hs b/binNMUs.hs
index ff36cc9..e0f5757 100644
--- a/binNMUs.hs
+++ b/binNMUs.hs
@@ -28,7 +28,7 @@ type Version = String
 type Arch = String
 
 data VirtPackage = VirtPackage {vpFull :: String, vpBase :: VirtPackageBase, vpHash :: String}
-    deriving (Eq, Show)
+    deriving (Eq, Ord, Show)
 type VirtPackageBase = String -- just the part without the hash (and without libghc-)
 
 data Status -- ^ Status of a binNMU
@@ -44,8 +44,10 @@ data Status -- ^ Status of a binNMU
 data Reason
     = MissingDep VirtPackage
     | UpgradedDep VirtPackage VirtPackage
+  deriving (Eq, Ord, Show)
 
 type BinNMU = (Binary, [Reason])
+type CBinNMU = (Status, (SourceName, Version, Arch, [Reason]))
 
 data Binary = Binary
     { bPkgName :: String
@@ -64,29 +66,40 @@ run :: Conf -> IO ()
 run conf = do
     printHeader conf
     cBinNMUs <- concat <$> mapM (getNMUs conf) (arches conf)
+    presentProblems cBinNMUs
     presentBinNMUs cBinNMUs
 
 
 printHeader :: Conf -> IO ()
 printHeader conf = do
-    putStrLn $ "# This is nomeata's binNMU script. Send questions to <nomeata at debian.org>"
-    putStrLn $ "# My source is in git+ssh://git.debian.org/git/pkg-haskell/tools"
+    putCLn $ "This is nomeata's binNMU script. Send questions to <nomeata at debian.org>"
+    putCLn $ "My source is in git+ssh://git.debian.org/git/pkg-haskell/tools"
     t <- getZonedTime
-    putStrLn $ "# It is now " ++ show t
-    putStrLn $ "# I am processing these architectures: " ++ intercalate ", " (arches conf)
-    putStrLn $ "# I am looking for virtual packages matching " ++ regexS conf
+    putCLn $ "It is now " ++ show t
+    putCLn $ "I am processing these architectures: " ++ intercalate ", " (arches conf)
+    putCLn $ "I am looking for virtual packages matching " ++ regexS conf
     putStrLn ""
 
 -- | Presentation of binNMUs
 
-presentBinNMUs :: [(Status, BinNMU)] -> IO ()
+presentProblems :: [CBinNMU] -> IO ()
+presentProblems cBinNMUs
+    | S.null problems  = do
+        putCLn "No problems detected"
+    | otherwise = do
+        putCLn "These dependency changes are observed:"
+        mapM_ (putCLn . formatReason) (S.toAscList problems)
+        putStrLn ""
+  where problems = S.fromList $ [ p | (_,(_,_,_,ps)) <- cBinNMUs, p <- ps ]
+
+presentBinNMUs :: [CBinNMU] -> IO ()
 presentBinNMUs cBinNMUs = do
     forM_ (ordGroupBy fst cBinNMUs) $ \(s, cBinNMUs) -> do
         unless (ignoreStatus s) $ do
-        putStrLn ("# " ++ statusHeader s)
+        putCLn $ statusHeader s
         putStr $ alignAt " . "
             [ (if actStatus s then "" else "# ") ++ formatNMU nmu
-            | nmu <- sortBy (compare `on` bSrcVersion . fst) $ map snd cBinNMUs ]
+            | nmu <- sortBy (compare `on` (\(a,b,c,d) -> a)) $ map snd cBinNMUs ]
         putStrLn ""
 
 statusHeader :: Status -> String
@@ -115,12 +128,10 @@ alignAt d lines = unlines (map expands rows)
         expands [] = ""
         expands r = concat (zipWith expand colwidths (init r)) ++ last r
 
-formatNMU :: BinNMU -> String
-formatNMU (b, d) =
+formatNMU :: (SourceName, Version, Arch, [Reason]) -> String
+formatNMU (s, v, a, d) =
     printf "nmu %s_%s . %s . -m '%s'"
-        (bSourceName b)
-        (bSrcVersion b)
-        (bArchitecture b)
+        s v a
         (intercalate ", " $ map formatReason d)
 
 formatReason :: Reason -> String
@@ -135,7 +146,7 @@ ordGroupBy f = M.toAscList . M.fromListWith (++) . map (f &&& (:[]))
 
 
 -- | Data aquisition and processing
-getNMUs :: Conf -> Arch -> IO [(Status, BinNMU)]
+getNMUs :: Conf -> Arch -> IO [CBinNMU]
 getNMUs conf a = do
     pkgs <- fetchArchive conf a
     wbmap <- fetchWannaBuild conf a
@@ -143,7 +154,8 @@ getNMUs conf a = do
                                         | p <- pkgs, v <- bProvides p
                                         ]
     let binNMUs = mapMaybe (needsRebuild available) pkgs
-    let cBinNMUs = map (categorize available wbmap &&& id) binNMUs
+    let cBinNMUs = map (categorize available wbmap &&&
+         (\(p,r) -> (bSourceName p, bSrcVersion p, bArchitecture p, r))) binNMUs
     return cBinNMUs
 
 -- Categorizing nmus
@@ -342,6 +354,11 @@ haskellRegex :: String
 haskellRegex = "libghc-(.*)-dev-([0-9.]+-[0-9a-f]{5})"
 
 
+-- Utils
+
+putC s = putStr  ("# " ++ s)
+putCLn s = putStrLn ("# " ++ s)
+
 -- Main program
 
 main :: IO ()

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