[Git][haskell-team/tools][master] 2 commits: binNMUs: Support --priority

[Ilias Tsitsimpis]

Ilias Tsitsimpis pushed to branch master at Debian Haskell Group / tools


Commits:
8611fccd by Joachim Breitner at 2017-06-27T23:16:03-04:00
binNMUs: Support --priority

- - - - -
94c4d408 by Joachim Breitner at 2017-07-21T18:42:00-04:00
Group bp commands more efficiently

- - - - -


1 changed file:

- binNMUs.hs


Changes:

=====================================
binNMUs.hs
=====================================
--- a/binNMUs.hs
+++ b/binNMUs.hs
@@ -24,10 +24,12 @@ import Control.Arrow
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as BL
 import Data.Time
-import Control.Lens
+import Data.Monoid ((<>))
+import Control.Lens hiding (argument)
 import Control.Seq
 import GHC.Generics (Generic)
 import Control.DeepSeq
+import Data.Foldable (for_)
 
 
 #ifdef SQL
@@ -171,15 +173,24 @@ alignAt d lines = unlines (map expands rows)
 presentBinNMUs :: Conf -> [CBinNMU] -> IO ()
 presentBinNMUs conf cBinNMUs = do
     forM_ (ordGroupBy fst cBinNMUs) $ \(s, cBinNMUs) -> do
+        let binNMUs = map snd cBinNMUs
+
         unless (ignoreStatus s) $ do
         putCLn $ statusHeader s
         putStr $ alignAt " . "
-            [ (if actStatus s then "" else "# ") ++ formatNMU (distribution conf) nmu
+            [ (if actStatus s then "" else "# ") ++
+              formatNMU (distribution conf) nmu
             | nmu <- sortBy (compare `on` (^. _1)) $
-              groupNMUs conf $
-              map snd cBinNMUs
+                     groupNMUs conf binNMUs
             ]
-        putStrLn ""
+        when (actStatus s) $ for_ (mbPriority conf) $ \prio -> do
+            putStr $ alignAt " . "
+                [ formatBP prio (distribution conf) nmu
+                | nmu <- sortBy (compare `on` (^. _1)) $
+                         groupBPs conf binNMUs
+                ]
+            putStrLn ""
+
 
 groupNMUs :: (Ord a, Ord b, Ord c) => Conf -> [(a, b, c)] -> [([a], [b], c)]
 groupNMUs conf =
@@ -195,6 +206,22 @@ groupNMUs conf =
   where
     gbp = groupPkgs conf
 
+groupBPs :: (Ord a, Ord b) => Conf -> [(a, b, c)] -> [(a, [b])]
+groupBPs conf =
+    groupEqual .
+    map (\(a,b,c) -> (a,b))
+  where
+    gbp = groupPkgs conf
+
+formatBP :: Int -> String -> ((SourceName, Version), [Arch]) -> String
+formatBP prio dist (s, as) =
+    printf "bp %d %s . %s . %s"
+        prio
+        (uncurry (printf "%s_%s") s :: String)
+        (unwords (nub as))
+        dist
+
+
 formatNMU :: String -> ([(SourceName, Version)], [Arch], [Reason]) -> String
 formatNMU dist (ss, as, d) =
     printf "nmu %s . %s . %s . -m '%s'"
@@ -519,6 +546,7 @@ data Conf = Conf
     , regex :: Regex
     , roughRegex :: Regex
     , regexS :: String -- A regex is not Show'able, so we need to keep the string
+    , mbPriority :: Maybe Int
     , offline :: Bool
     , quiet :: Bool
     , sql :: Bool
@@ -526,9 +554,9 @@ data Conf = Conf
     , presentProblems :: Bool
     }
 
-mkConf :: String -> [Arch] -> String -> Bool -> Bool -> Bool -> Bool -> Bool -> Conf
-mkConf d a r =
-    Conf d a (makeRegex ("^"++r++"$")) (makeRegex r) r
+mkConf :: String -> [Arch] -> String -> Maybe Int -> Bool -> Bool -> Bool -> Bool -> Bool -> Conf
+mkConf d a r p =
+    Conf d a (makeRegex ("^"++r++"$")) (makeRegex r) r p
 
 parseArches :: ReadM [Arch]
 parseArches = do
@@ -562,6 +590,11 @@ conf = mkConf
     showDefault <>
     value haskellRegex
     )
+ <*> optional (option auto (
+        long "priority" <>
+        metavar "N" <>
+        help "build priority to assign to the binNMUed packages"
+    ))
  <*> switch (
     long "offline" <>
     help "do not download files (cached files must be available)"



View it on GitLab: https://salsa.debian.org/haskell-team/tools/compare/dda30656e739bf0624234e13f3e72e3af3b4203c...94c4d408ee70353aa0e7f58ea56124cfbb67204f

---
View it on GitLab: https://salsa.debian.org/haskell-team/tools/compare/dda30656e739bf0624234e13f3e72e3af3b4203c...94c4d408ee70353aa0e7f58ea56124cfbb67204f
You're receiving this email because of your account on salsa.debian.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.alioth.debian.org/pipermail/pkg-haskell-commits/attachments/20180121/c74329e5/attachment-0001.html>