[Pkg-haskell-commits] darcs: tools: Port ./haskell-pkg-debcheck-exp.hs to new haskell-debian api

[Joachim Breitner]

Wed Jan 30 11:53:02 UTC 2013  Joachim Breitner <mail at joachim-breitner.de>
  * Port ./haskell-pkg-debcheck-exp.hs to new haskell-debian api
  Ignore-this: eeb4feed2ccd80c88ff66868cd132b1a

    M ./haskell-pkg-debcheck-exp.hs -15 +14

Wed Jan 30 11:53:02 UTC 2013  Joachim Breitner <mail at joachim-breitner.de>
  * Port ./haskell-pkg-debcheck-exp.hs to new haskell-debian api
  Ignore-this: eeb4feed2ccd80c88ff66868cd132b1a
diff -rN -u old-tools//haskell-pkg-debcheck-exp.hs new-tools//haskell-pkg-debcheck-exp.hs
--- old-tools//haskell-pkg-debcheck-exp.hs	2013-01-30 12:01:57.474221152 +0000
+++ new-tools//haskell-pkg-debcheck-exp.hs	2013-01-30 12:01:57.530225249 +0000
@@ -27,6 +27,7 @@
 import qualified Data.HashSet as S
 import Debug.Trace
 import Text.Printf
+import Text.PrettyPrint.ANSI.Leijen (displayS, renderCompact)
 
 m ! k = case M.lookup k m of
     Just x -> x 
@@ -45,8 +46,8 @@
 unstableBinariesFiles arch = "data/unstable-main-binary-" ++ arch ++ "-Packages.gz"
 -- wbDump arch = "data/wanna-build-dump-" ++ arch ++ ".gz"
 
-instance Show DebianVersion where show v = render (prettyDebianVersion v)
-instance Show Relation where show v = render (prettyRelation v)
+instance Show DebianVersion where showsPrec _ = displayS . renderCompact . prettyDebianVersion
+instance Show Relation where showsPrec _ = displayS . renderCompact . prettyRelation
 
 data SourceInfo = SourceInfo
     { siName :: SrcPkgName
@@ -124,7 +125,7 @@
         guard (fst (wbMap ! (s,a)) == "Installed")
         return (s,(S.singleton a, sv, formatReason x))
     
-    forM (M.toList nmus) $ \(s,(as,sv,exp)) -> putStrLn $ "nmu " ++ unPkgName (unSrcPkgName s) ++ "_" ++ show sv ++ " . " ++ unwords (S.toList as) ++ " . experimental . -m '" ++ exp ++ "'"
+    forM (M.toList nmus) $ \(s,(as,sv,exp)) -> putStrLn $ "nmu " ++ unSrcPkgName s ++ "_" ++ show sv ++ " . " ++ unwords (S.toList as) ++ " . experimental . -m '" ++ exp ++ "'"
     
     {-
     let buildingSources = unionWith mergeArches outdatedSources nmus
@@ -173,8 +174,8 @@
             when f $ putStrLn $ "dw " ++ s ++ "_" ++ show sv ++ " . " ++ unwords (S.toList as) ++ " . -m '" ++ showRelations dws ++ "'"
     -}
 
-interestingSource si = BinPkgName (PkgName "haskell-devscripts") `elem` (flattenRelations (siBuildDepends si)) &&
-                       BinPkgName (PkgName "ghc6") `notElem` (flattenRelations (siBuildDepends si)) 
+interestingSource si = BinPkgName "haskell-devscripts" `elem` (flattenRelations (siBuildDepends si)) &&
+                       BinPkgName "ghc6" `notElem` (flattenRelations (siBuildDepends si)) 
 
 mergeArches n1@(as1, v1, x1) n2@(as2, v2, x2)
     | v1 == v2 = (as1 `S.union` as2, v1, x1)
@@ -184,7 +185,7 @@
 toSourcesMap = 
     M.fromListWith higherSourceVersion . 
     mapMaybe (\para -> do -- Maybe monad
-        p <- SrcPkgName . PkgName . BS.unpack <$> fieldValue "Package" para
+        p <- SrcPkgName . BS.unpack <$> fieldValue "Package" para
         a <- BS.unpack <$> fieldValue "Architecture" para
         guard (a /= "all")
         v <- parseDebianVersion <$>
@@ -207,7 +208,7 @@
 toBinaryMap arch bToS = 
     M.fromList . 
     mapMaybe (\para -> do -- Maybe monad
-        p <- BinPkgName . PkgName . BS.unpack <$>
+        p <- BinPkgName . BS.unpack <$>
              fieldValue "Package" para
         guard (p `member` bToS)
         guard (isNotIgnored p)
@@ -219,7 +220,7 @@
         let (s,sv) = case words sf of
                     [s,('(':sv)] -> (s, parseDebianVersion (init sv))
                     [s]          -> (s,v)
-        guard (SrcPkgName (PkgName s) == bToS ! p)
+        guard (SrcPkgName s == bToS ! p)
         return ((p,arch), (v,sv))
     ) .
     unControl
@@ -228,7 +229,7 @@
 toWBMap arch sourcesMap = 
     M.fromList . 
     mapMaybe (\para -> do -- Maybe monad
-        s <- SrcPkgName . PkgName . BS.unpack <$>
+        s <- SrcPkgName . BS.unpack <$>
              fieldValue "package" para
         guard (s `member` sourcesMap)
         v <- parseDebianVersion <$>
@@ -241,7 +242,7 @@
             unless (st `elem` ["Failed-Removed", "Not-For-Us"]) $ 
                 trace (printf "Version difference for %s on %s in state %s: \
                               \wb knows %s and Sources knows %s"
-                      (unPkgName (unSrcPkgName s))
+                      (unSrcPkgName s)
                       arch
                       st
                       (show v)
@@ -272,20 +273,20 @@
 collectEdosOutput :: [BinPkgName] -> IO [(BinPkgName, Arch, DebianVersion, String)]
 collectEdosOutput pkgs = fmap concat $ forM arches $ \arch -> do
     --(_, Just zcatOut, _, _) <- createProcess $ (proc "zcat" [binariesFiles arch]) { std_out = CreatePipe }
-    (Just edosIn, Just edosOut, _, _) <- createProcess $ (proc "edos-debcheck" ["-xml","-failures","-explain","-checkonly", intercalate "," (map (unPkgName.unBinPkgName) pkgs)]) { std_in = CreatePipe, std_out = CreatePipe }
+    (Just edosIn, Just edosOut, _, _) <- createProcess $ (proc "edos-debcheck" ["-xml","-failures","-explain","-checkonly", intercalate "," (map unBinPkgName pkgs)]) { std_in = CreatePipe, std_out = CreatePipe }
     LB.readFile (unstableBinariesFiles arch) >>= LB.hPutStr edosIn . GZip.decompress
     LB.readFile (binariesFiles arch) >>= LB.hPutStr edosIn . GZip.decompress
     hClose edosIn
     Document _ _ root  _ <- xmlParse "edos output" <$> hGetContents edosOut
     -- How do you actually use this HaXmL? This can not be the correct way:
     let filter = concatMap ((attributed "package" `x` attributed "architecture" `x` attributed "version" `x` extracted (concat . mapMaybe fst . textlabelled (txt `o` children)) ) keep) . (elm `o` children)
-    return $ map (\((((p,a),v),s),_) -> (BinPkgName (PkgName p), a, parseDebianVersion v, s)) (filter (CElem root noPos))
+    return $ map (\((((p,a),v),s),_) -> (BinPkgName p, a, parseDebianVersion v, s)) (filter (CElem root noPos))
 
 removeArchAll :: [(BinPkgName, Arch, DebianVersion, String)] -> [(BinPkgName, Arch, DebianVersion, String)]
 removeArchAll = filter (\(_,a,_,_) -> a /= "all")
 
 isNotIgnored :: BinPkgName -> Bool
-isNotIgnored pkg = not ("-doc" `isSuffixOf` (unPkgName.unBinPkgName) pkg || "-prof" `isSuffixOf` (unPkgName.unBinPkgName) pkg)
+isNotIgnored pkg = not ("-doc" `isSuffixOf` unBinPkgName pkg || "-prof" `isSuffixOf` unBinPkgName pkg)
 
 formatReason :: String -> String
 formatReason s  = "Dependency " ++ packageName ++ " not available any more"
@@ -369,8 +370,6 @@
     hashWithSalt s (EEQ v) = hashWithSalt s (3::Int,v)
     hashWithSalt s (GRE v) = hashWithSalt s (4::Int,v)
     hashWithSalt s (SGR v) = hashWithSalt s (5::Int,v)
-instance Hashable PkgName  where
-    hashWithSalt s = hashWithSalt s . unPkgName
 instance Hashable SrcPkgName  where
     hashWithSalt s = hashWithSalt s . unSrcPkgName
 instance Hashable BinPkgName where