[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