Adjust some code to newer APIs
authorJoachim Breitner <mail@joachim-breitner.de>
Tue, 8 Sep 2009 17:05:21 +0000 (17:05 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Tue, 8 Sep 2009 17:05:21 +0000 (17:05 +0000)
Debian.hs
Index.hs
Main.hs

index c265ed4..3511b41 100644 (file)
--- a/Debian.hs
+++ b/Debian.hs
@@ -1,6 +1,6 @@
 module Debian where
 
-import Linspire.Debian.Control.ByteString
+import Debian.Control.ByteString
 import qualified Data.ByteString.Char8 as BS
 
 import Types
index e413410..302c8b0 100644 (file)
--- a/Index.hs
+++ b/Index.hs
@@ -5,19 +5,23 @@ import qualified Data.Map as Map
 import Data.Version (Version,parseVersion)
 import Codec.Compression.GZip(decompress)
 import Data.ByteString.Lazy.Char8(ByteString,unpack)
-import Codec.Archive.Tar
+import qualified Codec.Archive.Tar as Tar
+import qualified Codec.Archive.Tar.Entry as Tar
 import Distribution.PackageDescription
+import Distribution.PackageDescription.Parse
 import Distribution.Package
 import System.FilePath.Posix
 import MaybeRead (readPMaybe)
+import Data.Maybe
 
 type Index = [(String,String,PackageDescription)]
 type IndexMap = Map.Map String (Set.Set Version)
 
+{-
 readIndex :: ByteString -> Index
 readIndex str = do
     let unziped = decompress str
-        untared = readTarArchive unziped
+        untared = Tar.read unziped
     entr <- archiveEntries untared
     case splitDirectories (tarFileName (entryHeader entr)) of
         [".",pkgname,vers,file] -> do
@@ -26,6 +30,22 @@ readIndex str = do
                     _  -> error $ "Couldn't read cabal file "++show file
             return (pkgname,vers,descr)
         _ -> fail "doesn't look like the proper path"
+-}
+
+readIndex :: ByteString -> Index
+readIndex str = do
+    let unziped = decompress str
+    catMaybes . Tar.foldEntries extract [] error $ Tar.read $ decompress str
+  where extract entry = (:) $ case Tar.entryContent entry of
+        Tar.NormalFile content _ -> 
+           case splitDirectories (Tar.entryPath  entry) of
+               [".",pkgname,vers,file] -> do
+                   let descr = case parsePackageDescription (unpack content) of
+                           ParseOk _ genDescr -> packageDescription genDescr
+                           _  -> error $ "Couldn't read cabal file "++show file
+                   Just (pkgname,vers,descr)
+               _ -> fail "doesn't look like the proper path"
+        _ -> Nothing
 
 searchIndex :: (String -> String -> Bool) -> Index -> [PackageDescription]
 searchIndex f ind = map snd $ filter (uncurry f . fst) $ map (\(p,v,d) -> ((p,v),d)) ind
@@ -33,13 +53,13 @@ searchIndex f ind = map snd $ filter (uncurry f . fst) $ map (\(p,v,d) -> ((p,v)
 indexMapFromList :: [PackageIdentifier] -> IndexMap
 indexMapFromList pids = Map.unionsWith Set.union $
     [ Map.singleton name (Set.singleton vers)
-    | (PackageIdentifier {pkgName = name,pkgVersion = vers}) <- pids ]
+    | (PackageIdentifier {pkgName = PackageName name,pkgVersion = vers}) <- pids ]
 
 indexToPackageIdentifier :: Index -> [PackageIdentifier]
 indexToPackageIdentifier index = do
     (name,vers_str,_) <- index
     Just vers <- return $ readPMaybe parseVersion vers_str
-    return $ PackageIdentifier {pkgName = name,pkgVersion = vers}
+    return $ PackageIdentifier {pkgName = PackageName name,pkgVersion = vers}
 
 bestVersions :: IndexMap -> Map.Map String Version
 bestVersions = Map.map Set.findMax
diff --git a/Main.hs b/Main.hs
index e97e10d..06d6140 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -7,6 +7,7 @@ import Hackage as H
 import Debian as D
 
 import HTMLOutput
+import CabalDebianMap
 import Types
 import Utils
 
@@ -24,8 +25,8 @@ main = do
        putStrLn $ "Found " ++ show (M.size combined) ++ " total packages"
 
        time <- getClockTime
-       let html = outputHTML combined time
-       writeFile "output.html" html
+       writeFile "output.html" $ outputHTML combined time
+       writeFile "cabalDebianMap.txt" $ outputCabalDebianMap combined