[tools] 01/01: binNMUs: Switch to Packages.xz

[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 ec922337a3f8745496daf1d24bb8f8961a7d159c
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Thu Mar 31 09:24:38 2016 +0200

    binNMUs: Switch to Packages.xz
---
 AcquireFile.hs | 10 +++-------
 binNMUs.hs     | 28 ++++++++++++++++++----------
 2 files changed, 21 insertions(+), 17 deletions(-)

diff --git a/AcquireFile.hs b/AcquireFile.hs
index 9fb6c79..e79a0fa 100644
--- a/AcquireFile.hs
+++ b/AcquireFile.hs
@@ -1,6 +1,5 @@
 module AcquireFile (acquireFile) where
 
-import Codec.Compression.GZip (decompress)
 import qualified System.IO.Strict as S
 import System.IO
 import System.IO.Error
@@ -15,8 +14,8 @@ import Data.List
 
 -- File acquirance
 
-acquireFile :: String -> Bool -> Bool -> IO B.ByteString
-acquireFile url ungz offline = do
+acquireFile :: String -> Bool -> IO B.ByteString
+acquireFile url offline = do
       cachePath <- chooseCachePath
       case cachePath of
         Nothing -> do
@@ -44,10 +43,7 @@ acquireFile url ungz offline = do
                         hPutStrLn stderr $ "File " ++ savename ++ " does not exist after invoking"
                         hPutStrLn stderr $ intercalate " " ("curl" : args)
                         exitFailure
-                   text <- B.readFile savename
-                   return $ if ungz
-                            then BL.toStrict $ decompress $ BL.fromStrict text 
-                            else text
+                   B.readFile savename
     where fixChar '/' = '_'
           fixChar ':' = '_'
           fixChar c   = c
diff --git a/binNMUs.hs b/binNMUs.hs
index 7cd8676..9b5f7d6 100644
--- a/binNMUs.hs
+++ b/binNMUs.hs
@@ -5,6 +5,8 @@ import Data.List
 import Data.List.Split
 import Data.Maybe
 import Data.Char
+import qualified Codec.Compression.GZip
+import qualified Codec.Compression.Lzma
 import Data.Ord
 import Data.Function
 import Options.Applicative
@@ -20,6 +22,7 @@ import System.IO
 import System.Exit
 import Control.Arrow
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as BL
 import Data.Time
 import Control.Lens
 import Control.Seq
@@ -322,7 +325,7 @@ fetchWB = Query $ B.pack $ "\
 
 fetchWannaBuildHTTP :: Conf -> Arch -> IO WBMap
 fetchWannaBuildHTTP conf a = do
-    s <- acquireFile' conf True url
+    s <- unGZ <$> acquireFile' conf url
     case parseControl url s of
         Left pe -> error $ show pe
         Right c -> return $! M.fromList $! (map parsePara (unControl c) `using` seqList rdeepseq)
@@ -347,14 +350,14 @@ debianMirror :: String
 debianMirror = "http://cdn-fastly.deb.debian.org/debian"
 
 packageURL :: String -> Arch -> String
-packageURL "sid" a        = printf "%s/dists/sid/main/binary-%s/Packages.gz" debianMirror a
-packageURL "buildd-sid" a = printf "http://incoming.debian.org/debian-buildd/dists/buildd-sid/main/binary-%s/Packages.gz" a
-packageURL "experimental" a    = printf "%s/dists/experimental/main/binary-%s/Packages.gz" debianMirror a
-packageURL "buildd-experimental" a = printf "http://incoming.debian.org/debian-buildd/dists/buildd-experimental/main/binary-%s/Packages.gz" a
+packageURL "sid" a        = printf "%s/dists/sid/main/binary-%s/Packages.xz" debianMirror a
+packageURL "buildd-sid" a = printf "http://incoming.debian.org/debian-buildd/dists/buildd-sid/main/binary-%s/Packages.xz" a
+packageURL "experimental" a    = printf "%s/dists/experimental/main/binary-%s/Packages.xz" debianMirror a
+packageURL "buildd-experimental" a = printf "http://incoming.debian.org/debian-buildd/dists/buildd-experimental/main/binary-%s/Packages.xz" a
 
 acquirePackagesHTTP :: Conf -> String -> Arch -> IO [Binary]
 acquirePackagesHTTP conf suite arch = do
-    s <- acquireFile' conf True url
+    s <- unXZ <$> acquireFile' conf url
     case parseControl url s of
         Left pe -> error $ show pe
         Right c -> return $!
@@ -424,11 +427,11 @@ fetchArchiveHTTP conf a = do
     let pkgs2' = [ p | p <- pkgs2 , bPkgName p `S.notMember` pkg1_names ]
     return $ pkgs1 ++ pkgs2'
 
-acquireFile' :: Conf -> Bool -> String -> IO B.ByteString
-acquireFile' conf ungz url = do
+acquireFile' :: Conf -> String -> IO B.ByteString
+acquireFile' conf url = do
     unless q $ hPutStr stderr $ printf "Fetching %s ..." url
     unless q $ hFlush stderr
-    s <- acquireFile url ungz o
+    s <- acquireFile url o
     unless q $ hPutStrLn stderr $ printf " done."
     return s
   where o = offline conf
@@ -492,7 +495,7 @@ wnppDumpUrl = "https://qa.debian.org/data/bts/wnpp_rm"
 
 fetchWnppDump :: Conf -> IO [SourceName]
 fetchWnppDump conf = do
-    s <- acquireFile' conf False url
+    s <- acquireFile' conf url
     return $ mapMaybe parseLine $ map B.unpack $ B.lines s
   where
     url = wnppDumpUrl
@@ -595,8 +598,13 @@ parseFlatRel = flatRels . parseRels
       Left pe ->  error $ printf "Failed to parse relations %s" (show pe)
       Right rel -> rel
 
+-- Unpacking
 
+unGZ :: B.ByteString -> B.ByteString
+unGZ = BL.toStrict . Codec.Compression.GZip.decompress . BL.fromStrict
 
+unXZ :: B.ByteString -> B.ByteString
+unXZ = BL.toStrict . Codec.Compression.Lzma.decompress . BL.fromStrict
 
 -- Utils
 

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