distromap: only print the versions available in hackage

DistroMap.hs

@@ -28,7 +28,9 @@ Setup:
 Algorithm;
   1. Take a package from hackage
   2. Look for it in the map
-    a. For each version, yield the PVULine
+    a. For each version:
+        find a match in the list of versions:
+          yield the PVULine
 -}
 
 module DistroMap
@@ -40,13 +42,14 @@ import qualified Data.Map as Map
 import Data.Map ( Map )
 import System.FilePath ( (</>) )
 import Debug.Trace ( trace )
-import Data.Maybe ( catMaybes )
+import Data.Maybe ( fromJust )
 
 import Distribution.Verbosity
 import Distribution.Text ( display )
-import Distribution.Client.Types ( Repo, AvailablePackageDb )
+import Distribution.Client.Types ( Repo, AvailablePackageDb(..), AvailablePackage(..) )
 import Distribution.Simple.Utils ( info, warn, notice )
 
+import qualified Data.Version as Cabal
 import qualified Distribution.Package as Cabal
 import qualified Distribution.Client.PackageIndex as CabalInstall
 import qualified Distribution.Client.IndexUtils as CabalInstall
@@ -55,9 +58,9 @@ import Portage.Overlay ( Overlay(..), readOverlayByPackage, getDirectoryTree, Di
 import qualified Portage.PackageId as Portage
 import qualified Portage.Version as Portage
 
-type PVU = (Cabal.PackageName, String, Maybe String)
-type PVU_Map = Map Portage.PackageName [(Portage.Version, Maybe String)]
-type PVU_Item = (Portage.PackageName, [(Portage.Version, Maybe String)])
+type PVU = (Cabal.PackageName, Cabal.Version, Maybe String)
+type PVU_Map = Map Portage.PackageName [(Cabal.Version, Maybe String)]
+type PVU_Item = (Portage.PackageName, [(Cabal.Version, Maybe String)])
 
 distroMap :: Verbosity -> Repo -> FilePath -> FilePath -> [String] -> IO ()
 distroMap verbosity repo portagePath overlayPath args = do
@@ -73,26 +76,31 @@ distroMap verbosity repo portagePath overlayPath args = do
   putStrLn ("portage packages: " ++ show (length portage))
   putStrLn ("overlay packages: " ++ show (length overlay))
 
-  let portageMap = buildPortageMap [ (p, reduceVersions vs) | (p,vs) <- portage ]
-      overlayMap = buildOverlayMap [ (p, reduceVersions vs) | (p,vs) <- overlay ]
+  let portageMap = buildPortageMap portage
+      overlayMap = buildOverlayMap overlay
       completeMap = unionMap portageMap overlayMap
 
   putStrLn ("portage map: " ++ show (Map.size portageMap))
   putStrLn ("overlay map: " ++ show (Map.size overlayMap))
   putStrLn ("complete map: " ++ show (Map.size completeMap))
 
-  (packageIndex, _dep) <- CabalInstall.readRepoIndex verbosity repo
-  let names = CabalInstall.allPackageNames packageIndex
-  putStrLn ("cabal packages: " ++ show (length names))
+  AvailablePackageDb { packageIndex = packageIndex } <-
+    CabalInstall.getAvailablePackages verbosity [repo]
 
-  let pvus = concat $ catMaybes (map (lookupPVU completeMap) names)
+  let pkgs0 = map (map packageInfoId) (CabalInstall.allPackagesByName packageIndex)
+      hackagePkgs = [ (Cabal.pkgName (head p), map Cabal.pkgVersion p) | p <- pkgs0 ]
+
+  putStrLn ("cabal packages: " ++ show (length hackagePkgs))
+
+  let pvus = concat $ map (\(p,vs) -> lookupPVU completeMap p vs) hackagePkgs
   putStrLn ("found pvus: " ++ show (length pvus))
 
   mapM_ (putStrLn . showPVU) pvus
+  return ()
 
 
 showPVU :: PVU -> String
-showPVU (p,v,u) = show $ (display p, v, u)
+showPVU (p,v,u) = show $ (display p, display v, u)
 
 -- building the PVU_Map
 
@@ -105,44 +113,46 @@ reduceVersions = List.nub . map reduceVersion
 buildMap :: [(Portage.PackageName, [Portage.Version])]
          -> (Portage.PackageName -> Portage.Version -> Maybe String)
          -> PVU_Map
-buildMap pvs f = Map.mapWithKey (\p vs -> [ (v, f p v) | v <- vs ]) (Map.fromList pvs)
+buildMap pvs f = Map.mapWithKey (\p vs -> [ (fromJust $ Portage.toCabalVersion v, f p v)
+                                          | v <- reduceVersions vs ])
+                                (Map.fromList pvs)
 
-buildPortageMap :: [(Portage.PackageName, [Portage.Version])]
-                -> PVU_Map
-buildPortageMap lst = buildMap lst f
-  where
-  f (Portage.PackageName c p) _v = Just $ "http://packages.gentoo.org/package" </> display c </> display p
+buildPortageMap :: [(Portage.PackageName, [Portage.Version])] -> PVU_Map
+buildPortageMap lst = buildMap lst $ \ (Portage.PackageName c p) _v ->
+  Just $ "http://packages.gentoo.org/package" </> display c </> display p
 
-buildOverlayMap :: [(Portage.PackageName, [Portage.Version])]
-                -> PVU_Map
-buildOverlayMap lst = buildMap lst (\_ _ -> Just "http://en.gentoo-wiki.com/wiki/Haskell/overlay")
+buildOverlayMap :: [(Portage.PackageName, [Portage.Version])] -> PVU_Map
+buildOverlayMap lst = buildMap lst $ \_ _ -> Just "http://en.gentoo-wiki.com/wiki/Haskell/overlay"
 
 unionMap :: PVU_Map -> PVU_Map -> PVU_Map
 unionMap = Map.unionWith f
   where
-  f :: [(Portage.Version, Maybe String)]
-    -> [(Portage.Version, Maybe String)]
-    -> [(Portage.Version, Maybe String)]
+  f :: [(Cabal.Version, Maybe String)]
+    -> [(Cabal.Version, Maybe String)]
+    -> [(Cabal.Version, Maybe String)]
   f vas vbs = Map.toList (Map.union (Map.fromList vas) (Map.fromList vbs))
 
 
-
 -- resolving Cabal.PackageName to Portage.PackageName
 
 resolveCategories :: PVU_Map
                   -> Cabal.PackageName
                   -> [PVU_Item]
 resolveCategories pvu_map cpn = Map.toList $ Map.filterWithKey f pvu_map
   where
-  f (Portage.PackageName cat pn) vs = cpn == pn
+  f (Portage.PackageName _cat pn) _vs = cpn == pn
 
-lookupPVU :: PVU_Map -> Cabal.PackageName -> Maybe [PVU]
-lookupPVU pvu_map pn =
+lookupPVU :: PVU_Map -> Cabal.PackageName -> [Cabal.Version] -> [PVU]
+lookupPVU pvu_map pn cvs =
   case resolveCategories pvu_map (Portage.normalizeCabalPackageName pn) of
-    [] -> Nothing
+    [] -> []
     [item] -> ret item
     --items | (cat@(:_) <- (filter (`elem` cats) priority) -> ret cat
     --     | otherwise -> trace ("Ambiguous package name: " ++ show pn ++ ", hits: " ++ show cats) Nothing
-    _ -> trace ("too many packages: " ++ show pn) Nothing
+    _ -> trace ("too many packages: " ++ show pn) []
   where
-  ret (_, vs) = Just [ (pn, display v, u) | (v, u) <- vs ]
+  ret (_, vs) = [ (pn, v, u) | (v, u) <- vs, v `elem` cvs ]
+  preferableItem items =
+    [ item
+    | item@(Portage.PackageName cat _pn, _vs) <- items
+    , cat == Portage.Category "dev-haskell"]