Update platform repo URL
[darcs-mirror-hpvt.git] / Index.hs
1 module Index where
2
3 import qualified Data.Set as Set
4 import qualified Data.Map as Map
5 import Data.Version (Version,parseVersion)
6 import Codec.Compression.GZip(decompress)
7 import Data.ByteString.Lazy.Char8(ByteString,unpack)
8 import qualified Codec.Archive.Tar as Tar
9 import qualified Codec.Archive.Tar.Entry as Tar
10 import Distribution.PackageDescription
11 import Distribution.PackageDescription.Parse
12 import Distribution.Package
13 import System.FilePath.Posix
14 import MaybeRead (readPMaybe)
15 import Data.Maybe
16
17 type Index = [(String,String,PackageDescription)]
18 type IndexMap = Map.Map String (Set.Set Version)
19
20 {-
21 readIndex :: ByteString -> Index
22 readIndex str = do
23     let unziped = decompress str
24         untared = Tar.read unziped
25     entr <- archiveEntries untared
26     case splitDirectories (tarFileName (entryHeader entr)) of
27         [".",pkgname,vers,file] -> do
28             let descr = case parsePackageDescription (unpack (entryData entr)) of
29                     ParseOk _ genDescr -> flattenPackageDescription genDescr
30                     _  -> error $ "Couldn't read cabal file "++show file
31             return (pkgname,vers,descr)
32         _ -> fail "doesn't look like the proper path"
33 -}
34
35 readIndex :: ByteString -> Index
36 readIndex str = do
37     catMaybes . Tar.foldEntries extract [] error $ Tar.read $ decompress str
38   where extract entry = (:) $ case Tar.entryContent entry of
39          Tar.NormalFile content _ -> 
40             case splitDirectories' (Tar.entryPath  entry) of
41                 [pkgname,vers,file] -> do
42                     let descr = case parsePackageDescription (unpack content) of
43                             ParseOk _ genDescr -> packageDescription genDescr
44                             _  -> error $ "Couldn't read cabal file "++show file
45                     Just (pkgname,vers,descr)
46                 _ -> fail $ "doesn't look like the proper path: " ++ Tar.entryPath entry
47          _ -> Nothing
48         splitDirectories' s = case splitDirectories s of
49             ".":ds -> ds
50             ds -> ds
51
52 searchIndex :: (String -> String -> Bool) -> Index -> [PackageDescription]
53 searchIndex f ind = map snd $ filter (uncurry f . fst) $ map (\(p,v,d) -> ((p,v),d)) ind
54
55 indexMapFromList :: [PackageIdentifier] -> IndexMap
56 indexMapFromList pids = Map.unionsWith Set.union $
57     [ Map.singleton name (Set.singleton vers)
58     | (PackageIdentifier {pkgName = PackageName name,pkgVersion = vers}) <- pids ]
59
60 indexToPackageIdentifier :: Index -> [PackageIdentifier]
61 indexToPackageIdentifier index = do
62     (name,vers_str,_) <- index
63     Just vers <- return $ readPMaybe parseVersion vers_str
64     return $ PackageIdentifier {pkgName = PackageName name,pkgVersion = vers}
65
66 bestVersions :: IndexMap -> Map.Map String Version
67 bestVersions = Map.map Set.findMax