[tools] 01/01: binNMUs: Support --priority

[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 8611fccd2273fd85e76d2c8cc3c3d9dc5c1ebf4e
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Jun 27 23:16:03 2017 -0400

    binNMUs: Support --priority
---
 binNMUs.hs | 41 ++++++++++++++++++++++++++++++++---------
 1 file changed, 32 insertions(+), 9 deletions(-)

diff --git a/binNMUs.hs b/binNMUs.hs
index 6526247..fd0e4b5 100644
--- 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,21 @@ alignAt d lines = unlines (map expands rows)
 presentBinNMUs :: Conf -> [CBinNMU] -> IO ()
 presentBinNMUs conf cBinNMUs = do
     forM_ (ordGroupBy fst cBinNMUs) $ \(s, cBinNMUs) -> do
+        let groupedBinNMUs = sortBy (compare `on` (^. _1)) $
+                             groupNMUs conf $
+                             map snd cBinNMUs
+
         unless (ignoreStatus s) $ do
         putCLn $ statusHeader s
         putStr $ alignAt " . "
             [ (if actStatus s then "" else "# ") ++ formatNMU (distribution conf) nmu
-            | nmu <- sortBy (compare `on` (^. _1)) $
-              groupNMUs conf $
-              map snd cBinNMUs
-            ]
-        putStrLn ""
+            | nmu <- groupedBinNMUs ]
+        when (actStatus s) $ for_ (mbPriority conf) $ \prio -> do
+            putStr $ alignAt " . "
+                [ formatBP prio (distribution conf) nmu
+                | nmu <- groupedBinNMUs ]
+            putStrLn ""
+
 
 groupNMUs :: (Ord a, Ord b, Ord c) => Conf -> [(a, b, c)] -> [([a], [b], c)]
 groupNMUs conf =
@@ -195,6 +203,15 @@ groupNMUs conf =
   where
     gbp = groupPkgs conf
 
+formatBP :: Int -> String -> ([(SourceName, Version)], [Arch], [Reason]) -> String
+formatBP prio dist (ss, as, d) =
+    printf "bp %d %s . %s . %s"
+        prio
+        (intercalate " " $ map (uncurry (printf "%s_%s")) ss)
+        (intercalate " " $ nub as)
+        dist
+
+
 formatNMU :: String -> ([(SourceName, Version)], [Arch], [Reason]) -> String
 formatNMU dist (ss, as, d) =
     printf "nmu %s . %s . %s . -m '%s'"
@@ -519,6 +536,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 +544,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 +580,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)"

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