[Pkg-haskell-commits] [tools] 01/03: Minor improvements to the binNMU script

[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 1acda29090bfb7ff674022db13f6f7940cf683d6
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Aug 26 00:14:45 2014 -0700

    Minor improvements to the binNMU script
---
 AcquireFile.hs        |  3 ++-
 binNMUs.hs            | 39 +++++++++++++++++++++++++++++++--------
 make-static-binary.sh |  1 +
 3 files changed, 34 insertions(+), 9 deletions(-)

diff --git a/AcquireFile.hs b/AcquireFile.hs
index f711e35..0afd68d 100644
--- a/AcquireFile.hs
+++ b/AcquireFile.hs
@@ -29,7 +29,8 @@ acquireFile url ungz offline = do
                    when (offline && not ex) $ do
                       hPutStrLn stderr $ "Cached file for " ++ url ++ " does not exist, cannot use offline mode."
                       exitFailure
-                   let args = [ "-R" , "-s", "-S", "-L", "-o", savename] ++
+                   -- --insecure due to curl failing on paradis :-(
+                   let args = [ "-R" , "--insecure", "-s", "-S", "-L", "-o", savename] ++
                               (if ex then ["-z", savename] else []) ++
                               [ url ]
                    unless offline $ do
diff --git a/binNMUs.hs b/binNMUs.hs
index 80a2dd1..ff36cc9 100644
--- a/binNMUs.hs
+++ b/binNMUs.hs
@@ -16,6 +16,7 @@ import Text.Regex
 import System.IO
 import Control.Arrow
 import qualified Data.ByteString.Char8 as B
+import Data.Time
 
 import AcquireFile
 
@@ -60,11 +61,22 @@ data Binary = Binary
 -- The main action
 
 run :: Conf -> IO ()
-run c = do
-    cBinNMUs <- concat <$> mapM (getNMUs c) (arches c)
+run conf = do
+    printHeader conf
+    cBinNMUs <- concat <$> mapM (getNMUs conf) (arches conf)
     presentBinNMUs cBinNMUs
 
 
+printHeader :: Conf -> IO ()
+printHeader conf = do
+    putStrLn $ "# This is nomeata's binNMU script. Send questions to <nomeata at debian.org>"
+    putStrLn $ "# My source is in git+ssh://git.debian.org/git/pkg-haskell/tools"
+    t <- getZonedTime
+    putStrLn $ "# It is now " ++ show t
+    putStrLn $ "# I am processing these architectures: " ++ intercalate ", " (arches conf)
+    putStrLn $ "# I am looking for virtual packages matching " ++ regexS conf
+    putStrLn ""
+
 -- | Presentation of binNMUs
 
 presentBinNMUs :: [(Status, BinNMU)] -> IO ()
@@ -175,7 +187,7 @@ parseVirtPackage conf p = case matchRegex (regex conf) p of
 
 -- Reading wannabuild dumps
 wannaBuildDumpUrl :: Arch -> String
-wannaBuildDumpUrl a = printf "http://buildd.debian.org/stats/%s-dump.txt.gz" a
+wannaBuildDumpUrl a = printf "https://buildd.debian.org/stats/%s-dump.txt.gz" a
 
 type WBState = String
 type WBMap = M.Map SourceName (Version, Version, WBState)
@@ -271,20 +283,26 @@ fetchArchive conf a = do
 
 acquireFile' :: Conf -> String -> IO B.ByteString
 acquireFile' conf url = do
-    unless o $ hPutStr stderr $ printf "Fetching %s ..." url
-    unless o $ hFlush stderr
+    unless q $ hPutStr stderr $ printf "Fetching %s ..." url
+    unless q $ hFlush stderr
     s <- acquireFile url True o
-    unless o $ hPutStrLn stderr $ printf " done."
+    unless q $ hPutStrLn stderr $ printf " done."
     return s
   where o = offline conf
+        q = o || quiet conf
 
 -- Option parsing
 data Conf = Conf
     { arches :: [Arch]
     , regex :: Regex
+    , regexS :: String -- A regex is not Show'able, so we need to keep the string
     , offline :: Bool
+    , quiet :: Bool
     }
 
+mkConf :: [Arch] -> String -> Bool -> Bool -> Conf
+mkConf a r b1 b2 = Conf a (mkRegex r) r b1 b2
+
 parseArches :: String -> ReadM [Arch]
 parseArches s =
     case split (dropBlanks $ dropDelims $ oneOf ";, ") s of
@@ -294,7 +312,7 @@ parseArches s =
             bad -> readerError $ "Unknown architectures: " ++ intercalate ", " bad
 
 conf :: Parser Conf
-conf = Conf
+conf = mkConf
  <$> nullOption (
     long "arches" <>
     metavar "ARCH,ARCH,..." <>
@@ -303,7 +321,7 @@ conf = Conf
     showDefaultWith (intercalate ", ") <>
     reader parseArches
     )
- <*> mkRegex `fmap` strOption (
+ <*> strOption (
     long "regex" <>
     metavar "REGEX" <>
     help "regular expression matching virtual package names, with two groups" <>
@@ -314,6 +332,11 @@ conf = Conf
     long "offline" <>
     help "do not download files (cached files must be available)"
     )
+ <*> switch (
+    short 'q' <>
+    long "quiet" <>
+    help "don't be chatty on stderr"
+    )
 
 haskellRegex :: String
 haskellRegex = "libghc-(.*)-dev-([0-9.]+-[0-9a-f]{5})"
diff --git a/make-static-binary.sh b/make-static-binary.sh
index 8a90135..606dc92 100755
--- a/make-static-binary.sh
+++ b/make-static-binary.sh
@@ -1,2 +1,3 @@
 ghc -O2 -optl-static -optl-pthread -package transformers --make haskell-pkg-debcheck.hs
 #ghc -O2 -optl-static -optl-pthread -package transformers --make haskell-pkg-debcheck-exp.hs
+ghc -O2 -optl-static -optl-pthread --make binNMUs

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