[Pkg-haskell-commits] [tools] 07/07: Improvements to binNMU

Joachim Breitner nomeata at moszumanska.debian.org
Mon Sep 8 07:29:41 UTC 2014


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

nomeata pushed a commit to branch master
in repository tools.

commit 281a2725f2cd27424c7ebc058915c8c249df1dd7
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Mon Sep 8 09:29:34 2014 +0200

    Improvements to binNMU
---
 binNMUs.hs | 36 +++++++++++++++++++++++++-----------
 1 file changed, 25 insertions(+), 11 deletions(-)

diff --git a/binNMUs.hs b/binNMUs.hs
index 3e27b37..82af180 100644
--- a/binNMUs.hs
+++ b/binNMUs.hs
@@ -78,7 +78,7 @@ run conf = do
     --let cBinNMUs = concat (cBinNMUss `using` parList (evalList (evalTuple2 rseq rseq)))
     let cBinNMUs = concat cBinNMUss
     presentProblems cBinNMUs
-    presentBinNMUs cBinNMUs
+    presentBinNMUs conf cBinNMUs
 
 
 printHeader :: Conf -> IO ()
@@ -135,30 +135,32 @@ alignAt d lines = unlines (map expands rows)
         expands [] = ""
         expands r = concat (zipWith expand colwidths (init r)) ++ last r
 
-presentBinNMUs :: [CBinNMU] -> IO ()
-presentBinNMUs cBinNMUs = do
+presentBinNMUs :: Conf -> [CBinNMU] -> IO ()
+presentBinNMUs conf cBinNMUs = do
     forM_ (ordGroupBy fst cBinNMUs) $ \(s, cBinNMUs) -> do
         unless (ignoreStatus s) $ do
         putCLn $ statusHeader s
         putStr $ alignAt " . "
             [ (if actStatus s then "" else "# ") ++ formatNMU nmu
             | nmu <- sortBy (compare `on` (^. _1)) $
-              groupNMUs $
+              groupNMUs conf $
               map snd cBinNMUs
             ]
         putStrLn ""
 
-groupNMUs :: (Ord a, Ord b, Ord c) => [(a, b, c)] -> [([a], [b], c)]
-groupNMUs =
+groupNMUs :: (Ord a, Ord b, Ord c) => Conf -> [(a, b, c)] -> [([a], [b], c)]
+groupNMUs conf =
     concat .
     map (\(c,abs) ->
         map (\(bs,as) -> (as,bs,c)) $
-        groupEqual $
+        (if gbp then groupEqual else dontGroup) $
         map (\(a,bs) -> (bs,a)) $
         groupEqual $
         abs) .
     groupEqual .
     map (\(a,b,c) -> (c,(a,b)))
+  where
+    gbp = groupPkgs conf
 
 formatNMU :: ([(SourceName, Version)], [Arch], [Reason]) -> String
 formatNMU (ss, as, d) =
@@ -202,10 +204,14 @@ categorize available wbmap (p,deps) =
         | s == "installed" && bv /= bVersion p
                                   -> WrongVersion
         | s `elem` waiting        -> Waiting
+        | any (isMissing) deps    -> DepsMissing
         | s == "installed"        -> Needed
         | otherwise               -> Failed
   where waiting = words "bd-uninstallable built uploaded"
 
+isMissing (MissingDep _) = True
+isMissing _ = False
+
 
 -- Calculating required binNMUs
 
@@ -256,7 +262,7 @@ fetchWannaBuildSQL conf arch = do
   where
     q = quiet conf
     go :: (String, String, Maybe Int, String) -> (SourceName, (Version, Version, WBState))
-    go (src,sv,b,status) = (src, (sv, bv, status))
+    go (src,sv,b,status) = (src, (sv, bv, map toLower status))
       where bv = case b of Nothing -> sv
                            Just n  -> sv ++ "+b" ++ show n
 
@@ -446,11 +452,12 @@ data Conf = Conf
     , offline :: Bool
     , quiet :: Bool
     , sql :: Bool
+    , groupPkgs :: Bool
     }
 
-mkConf :: [Arch] -> String -> Bool -> Bool -> Bool -> Conf
-mkConf a r b1 b2 b3 =
-    Conf a (makeRegex ("^"++r++"$")) (makeRegex r) r b1 b2 b3
+mkConf :: [Arch] -> String -> Bool -> Bool -> Bool -> Bool -> Conf
+mkConf a r =
+    Conf a (makeRegex ("^"++r++"$")) (makeRegex r) r
 
 parseArches :: String -> ReadM [Arch]
 parseArches s =
@@ -490,6 +497,10 @@ conf = mkConf
     long "sql" <>
     help "use sql instead of downloading files. (e.g. on wuiet.debian.org)"
     )
+ <*> switch (
+    long "group-pkgs" <>
+    help "group commands for different packages (fewer, but longer lines)"
+    )
 
 haskellRegex :: String
 haskellRegex = "libghc-(.*)-dev-([0-9.]+-[0-9a-f]{5})"
@@ -521,6 +532,9 @@ putCLn s = putStrLn ("# " ++ s)
 groupEqual :: Ord a => [(a,b)] -> [(a, [b])]
 groupEqual xs = M.toList (M.fromListWith (++) (map (second ((:[]))) xs))
 
+dontGroup :: [(a,b)] -> [(a, [b])]
+dontGroup xs = [(a,[b]) | (a,b) <- xs]
+
 -- Main program
 
 main :: IO ()

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



More information about the Pkg-haskell-commits mailing list