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,16 +173,25 @@ 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 binNMUs
+            ]
+        when (actStatus s) $ for_ (mbPriority conf) $ \prio -> do
+            putStr $ alignAt " . "
+                [ formatBP prio (distribution conf) nmu
                 | nmu <- sortBy (compare `on` (^. _1)) $
-              groupNMUs conf $
-              map snd cBinNMUs
+                         groupBPs conf binNMUs
                 ]
             putStrLn ""
 
+
 groupNMUs :: (Ord a, Ord b, Ord c) => Conf -> [(a, b, c)] -> [([a], [b], c)]
 groupNMUs conf =
     concat .
@@ -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)"