Update the CLI and start using cabal-install features

Code ported to get the CLI like cabal-install style
Use cabal-install for updating

Cabal2Ebuild.hs

@@ -28,7 +28,9 @@ module Cabal2Ebuild
 
 import qualified Distribution.PackageDescription as Cabal
                                                 (PackageDescription(..))
-import qualified Distribution.Package as Cabal  (PackageIdentifier(..), Dependency(..))
+import qualified Distribution.Package as Cabal  (PackageIdentifier(..)
+                                                , Dependency(..)
+                                                , PackageName(..))
 import qualified Distribution.Version as Cabal  (VersionRange(..), versionBranch, Version)
 import qualified Distribution.License as Cabal  (License(..))
 import qualified Distribution.Text as Cabal  (display)
@@ -39,8 +41,6 @@ import Data.List          (intercalate, groupBy, partition, nub, sortBy, init, l
 import Data.Ord           (comparing)
 import Data.Maybe         (catMaybes, fromJust)
 
-import Index (pName, mkPackage)
-
 data EBuild = EBuild {
     name :: String,
     version :: String,
@@ -89,8 +89,6 @@ ebuildTemplate = EBuild {
     my_pn = Nothing
   }
 
-
-
 cabal2ebuild :: Cabal.PackageDescription -> EBuild
 cabal2ebuild pkg = ebuildTemplate {
     name        = map toLower cabalPkgName,
@@ -103,15 +101,15 @@ cabal2ebuild pkg = ebuildTemplate {
     licenseComments = licenseComment (Cabal.license pkg),
     depend          = defaultDepGHC
                     : (simplify_deps $
-                         convertDependency (Cabal.Dependency (mkPackage "Cabal")
+                         convertDependency (Cabal.Dependency (Cabal.PackageName "Cabal")
                                            (Cabal.descCabalVersion pkg))
                         ++ convertDependencies (Cabal.buildDepends pkg)),
     my_pn           = if any isUpper cabalPkgName then Just cabalPkgName else Nothing,
     features        = features ebuildTemplate
                    ++ (if null (Cabal.executables pkg) then [] else ["bin"])
                    ++ maybe [] (const ["lib","profile","haddock","hscolour"]) (Cabal.library pkg)
   } where
-        cabalPkgName = pName $ Cabal.pkgName (Cabal.package pkg)
+        cabalPkgName = Cabal.display $ Cabal.pkgName (Cabal.package pkg)
 
 defaultDepGHC :: Dependency
 defaultDepGHC     = OrLaterVersionOf (Version [6,6,1]) "dev-lang/ghc"
@@ -137,15 +135,15 @@ convertDependencies :: [Cabal.Dependency] -> [Dependency]
 convertDependencies = concatMap convertDependency
 
 convertDependency :: Cabal.Dependency -> [Dependency]
-convertDependency (Cabal.Dependency pname _)
-  | (pName pname) `elem` coreLibs = []      -- no explicit dep on core libs
+convertDependency (Cabal.Dependency pname@(Cabal.PackageName name) _)
+  | pname `elem` coreLibs = []      -- no explicit dep on core libs
 convertDependency (Cabal.Dependency pname versionRange)
   = case versionRange of
       (Cabal.IntersectVersionRanges v1 v2) -> [convert v1, convert v2]
       v                                    -> [convert v]
 
   where
-    ebuildName = "dev-haskell/" ++ map toLower (pName pname)
+    ebuildName = "dev-haskell/" ++ map toLower (Cabal.display pname)
 
     convert :: Cabal.VersionRange -> Dependency
     convert Cabal.AnyVersion = AnyVersionOf ebuildName
@@ -166,8 +164,8 @@ cabalVtoHPv = Version . Cabal.versionBranch
 instance Show Version where
     show (Version v) = intercalate "." $ map show v
 
-coreLibs :: [String]
-coreLibs =
+coreLibs :: [Cabal.PackageName]
+coreLibs = map Cabal.PackageName
   ["array"
   ,"base"
 --,"bytestring"   --already has ebuild

Cache.hs

@@ -1,5 +1,6 @@
 module Cache where
 
+{-
 import CacheFile
 import Error
 import Index
@@ -26,6 +27,7 @@ import qualified Data.Map as Map
 import Distribution.Verbosity
 import Distribution.Simple.Utils
 
+
 -- | A long time
 alarmingLongTime :: TimeDiff
 alarmingLongTime = TimeDiff
@@ -88,3 +90,5 @@ indexToPortage index port = second nub . runWriter $ do
                       | otherwise = head xs
                 tell ["WARNING: Category clash for package " ++ p ++ ", defaulting to " ++ c ++ ". Other categories: " ++ unwords (delete c xs)]
                 return c
+
+-}

Diff.hs

@@ -3,18 +3,34 @@ module Diff
     , DiffMode(..)
     ) where
 
-import Control.Monad ( forM_ )
+import Control.Monad ( forM_, mplus )
 import Data.Char
 import qualified Data.Map as Map
 import Network.URI
+import Control.Exception ( assert )
+import Data.Maybe ( fromJust, listToMaybe )
+import Data.List ( sortBy, groupBy )
+import Data.Ord ( comparing )
 
-import Cache
-import P2
 import qualified Portage.Version as Portage
+import qualified Portage.Overlay as Portage
+import qualified Portage.Cabal as Portage
+import qualified Portage.PackageId as Portage
+
+import qualified Data.Version as Cabal
 
 -- cabal
 import Distribution.Verbosity
 import Distribution.Text(display)
+import qualified Distribution.Package as Cabal
+import qualified Distribution.Simple.PackageIndex as Cabal
+import qualified Distribution.InstalledPackageInfo as Cabal
+import Distribution.Simple.Utils (equating)
+
+-- cabal-install
+import qualified Distribution.Client.IndexUtils as Index (getAvailablePackages )
+import qualified Distribution.Client.Types as Cabal
+import Distribution.Client.Utils (mergeBy, MergeResult(..))
 
 data DiffMode
 	= ShowAll
@@ -25,40 +41,102 @@ data DiffMode
         | ShowPackages [String]
 	deriving Eq
 
-data DiffState a
-	= OnlyLeft a
-	| OnlyRight a
-	| Both a a
+type DiffState a = MergeResult a a
 
 tabs :: String -> String
 tabs str = let len = length str in str++(if len < 3*8
 	then replicate (3*8-len) ' '
 	else "")
 
-showDiffState :: Package -> DiffState Portage.Version -> String
-showDiffState pkg st = (tabs (show pkg)) ++ " [" ++ (case st of
-  Both x y -> display x ++ (case compare x y of
+showDiffState :: Cabal.PackageName -> DiffState Portage.Version -> String
+showDiffState pkg st = (tabs (display pkg)) ++ " [" ++ (case st of
+  InBoth x y -> display x ++ (case compare x y of
     EQ -> "="
     GT -> ">"
     LT -> "<") ++ display y
-  OnlyLeft x -> display x ++ ">none"
-  OnlyRight y -> "none<" ++ display y) ++ "]"
-
-runDiff :: Verbosity -> FilePath -> URI -> DiffMode -> IO ()
-runDiff verbosity overlayPath serverURI dm = do
-  cache <- readCache verbosity overlayPath serverURI
-  overlayTree <- readPortageTree overlayPath
-  let (hackageTree, clashes) = indexToPortage cache overlayTree
-  mapM_ putStrLn clashes
-  case dm of
-    ShowPackages pkgs ->
-      forM_ pkgs $ \ pkg -> do
-        let criteria = Map.filterWithKey (\k _ -> pPackage k == pkg)
-            subHackage = criteria hackageTree
-            subOverlay = criteria overlayTree
-        diff subHackage subOverlay dm
-    _ -> diff hackageTree overlayTree dm
+  OnlyInLeft x -> display x ++ ">none"
+  OnlyInRight y -> "none<" ++ display y) ++ "]"
+
+runDiff :: Verbosity -> FilePath -> DiffMode -> Cabal.Repo -> IO ()
+runDiff verbosity overlayPath dm repo = do
+  -- get package list from hackage
+  pkgDB <- Index.getAvailablePackages verbosity [ repo ]
+  let (Cabal.AvailablePackageDb hackageIndex _) = pkgDB
+
+  -- get package list from the overlay
+  overlay0 <- (Portage.loadLazy overlayPath)
+  let overlayIndex = Portage.fromOverlay (Portage.reduceOverlay overlay0)
+
+  let (subHackage, subOverlay)
+        = case dm of
+            ShowPackages pkgs ->
+              (concatMap (Cabal.searchByNameSubstring hackageIndex) pkgs
+              ,concatMap (Cabal.searchByNameSubstring overlayIndex) pkgs)
+            _ ->
+              (Cabal.allPackages hackageIndex
+              ,Cabal.allPackages overlayIndex)
+  diff subHackage subOverlay dm
+
+data PackageCompareInfo = PackageCompareInfo {
+    name :: Cabal.PackageName,
+    hackageVersions :: [ Cabal.Version ],
+    overlayVersions :: [ Portage.Version ]
+  }
+
+diff :: [Cabal.AvailablePackage]
+     -> [Portage.ExistingEbuild]
+     -> DiffMode
+     -> IO ()
+diff hackage overlay dm =
+
+  error "Diff.diff not implemented"
+
+-- | We get the 'PackageCompareInfo' by combining the info for the overlay
+-- and hackage versions of a package.
+--
+-- * We're building info about a various versions of a single named package so
+-- the input package info records are all supposed to refer to the same
+-- package name.
+--
+mergePackageInfo :: [Portage.ExistingEbuild]
+                 -> [Cabal.AvailablePackage]
+                 -> PackageCompareInfo
+mergePackageInfo overlay hackage =
+  assert (length overlay + length hackage > 0) $
+  PackageCompareInfo {
+    name              = combine (Cabal.pkgName . Cabal.packageId) latestHackage
+                                (Cabal.pkgName . Cabal.packageId) latestOverlay,
+    hackageVersions = map (Cabal.pkgVersion   . Cabal.packageId) hackage,
+    overlayVersions = map (Portage.pkgVersion . Portage.ebuildId) overlay
+  }
+  where
+    combine f x g y = fromJust (fmap f x `mplus` fmap g y)
+    latestHackage = latestOf hackage
+    latestOverlay = latestOf overlay
+    latestOf :: Cabal.Package pkg => [pkg] -> Maybe pkg
+    latestOf = listToMaybe . sortBy (comparing (Cabal.pkgVersion . Cabal.packageId))
+
+-- | Rearrange installed and available packages into groups referring to the
+-- same package by name. In the result pairs, the lists are guaranteed to not
+-- both be empty.
+--
+mergePackages ::   [Cabal.InstalledPackageInfo] -> [Cabal.AvailablePackage]
+              -> [([Cabal.InstalledPackageInfo],   [Cabal.AvailablePackage])]
+mergePackages installed available =
+    map collect
+  $ mergeBy (\i a -> fst i `compare` fst a)
+            (groupOn (Cabal.pkgName . Cabal.packageId) installed)
+            (groupOn (Cabal.pkgName . Cabal.packageId) available)
+  where
+    collect (OnlyInLeft  (_,is)       ) = (is, [])
+    collect (    InBoth  (_,is) (_,as)) = (is, as)
+    collect (OnlyInRight        (_,as)) = ([], as)
 
+groupOn :: Ord key => (a -> key) -> [a] -> [(key,[a])]
+groupOn key = map (\xs -> (key (head xs), xs))
+            . groupBy (equating key)
+            . sortBy (comparing key)
+{-
 diff :: Portage -> Portage -> DiffMode -> IO ()
 diff pt1 pt2 mode = do
   let pkgs1 = Map.map (OnlyLeft  . eVersion . maximum) pt1
@@ -85,3 +163,4 @@ diff pt1 pt2 mode = do
           ShowPackages _ -> True
   let packages = filter (showFilter . snd) (Map.assocs union)
   mapM_ (putStrLn . uncurry showDiffState) packages
+-}

GenerateEbuild.hs

@@ -8,8 +8,7 @@ import Data.Version (showVersion)
 import Network.URI
 import System.Directory
 import System.FilePath
-
-import Index (pName)
+import Distribution.Text (display)
 
 mergeEbuild :: FilePath -> String -> EBuild -> IO ()
 mergeEbuild target category ebuild = do
@@ -24,14 +23,12 @@ fixSrc serverURI p ebuild =
     src_uri = show $ serverURI {
       uriPath =
         (uriPath serverURI)
-          </> pname
-          </> showVersion (pkgVersion p)
-          </> pname ++ "-" ++ showVersion (pkgVersion p)
+          </> display (pkgName p)
+          </> display (pkgVersion p)
+          </> display (pkgName p) ++ "-" ++ display (pkgVersion p)
           <.> "tar.gz"
       }
     }
-    where
-      pname = pName (pkgName p)
 
 {-hackage2ebuild ::
 	(PackageIdentifier,String,String) ->	-- ^ the package

Index.hs

@@ -1,44 +1,37 @@
 module Index where
 
+{-
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import Data.Version (Version,parseVersion)
 import Data.ByteString.Lazy.Char8(ByteString,unpack)
-import qualified Codec.Archive.Tar       as Tar
-import qualified Codec.Archive.Tar.Entry as Tar
-import Codec.Archive.Tar.Entry(Entry(..), EntryContent(..))
-import qualified Codec.Compression.GZip as GZip
+import Codec.Archive.Tar
 import Distribution.PackageDescription
 import Distribution.PackageDescription.Parse
+^ ^ ^ ^ ^ ^ ^
 import Distribution.Package
+import Distribution.Text
 import System.FilePath.Posix
 import MaybeRead (readPMaybe)
 
-type Index = [(String,String,GenericPackageDescription)]
-type IndexMap = Map.Map String (Set.Set Version)
+type Index = [(Cabal.PackageName, Version, GenericPackageDescription)]
+type IndexMap = Map.Map Cabal.PackageName (Set.Set Version)
 
 readIndex :: ByteString -> Index
-readIndex = createIndex
-            . Tar.read . GZip.decompress
-    where
-      createIndex = Tar.foldEntries getEntry [] (const [])
-
-getEntry         :: Entry -> Index -> Index
-getEntry ent ind = case (splitDirectories . Tar.entryPath $ ent) of
-                     [".",name,vers,file] -> case (cabalIndex ent) of
-                                               (Just desc) -> (name,vers,desc) : ind
-                                               _           -> error $ "Couldn't read cabal file " ++ (show file)
-                     _                    -> ind
-
-cabalIndex       :: Entry -> Maybe GenericPackageDescription
-cabalIndex entry = case (Tar.entryContent entry) of
-                     (NormalFile file _) -> case (parsePackageDescription . unpack $ file) of
-                                              (ParseOk _ pkg_desc) -> Just pkg_desc
-                                              _                    -> Nothing
-                     _                   -> Nothing
+readIndex str = do
+    let unziped = decompress str
+        untared = readTarArchive unziped
+    entr <- archiveEntries untared
+    case splitDirectories (tarFileName (entryHeader entr)) of
+        [".",pkgname,vers,file] -> do
+            let descr = case parsePackageDescription (unpack (entryData entr)) of
+                    ParseOk _ pkg_desc -> pkg_desc
+                    _  -> error $ "Couldn't read cabal file "++show file
+            return (pkgname,vers,descr)
+        _ -> fail "doesn't look like the proper path"
 
 filterIndexByPV :: (String -> String -> Bool) -> Index -> Index
-filterIndexByPV cond index = [ x | x@(p,v,_d) <- index, cond p v]
+filterIndexByPV cond index = [ x | x@(p,v,_d) <- index, cond (display p) (display v)]
 
 indexMapFromList :: [PackageIdentifier] -> IndexMap
 indexMapFromList pids = Map.unionsWith Set.union $
@@ -53,9 +46,17 @@ mkPackage = PackageName
 
 indexToPackageIdentifier :: Index -> [PackageIdentifier]
 indexToPackageIdentifier index = do
+v v v v v v v
+    (name,vers,_) <- index
+    return $ PackageIdentifier {pkgName = name, pkgVersion = vers}
+*************
     (name,vers_str,_) <- index
     Just vers <- return $ readPMaybe parseVersion vers_str
     return $ PackageIdentifier {pkgName = PackageName name,pkgVersion = vers}
+^ ^ ^ ^ ^ ^ ^
 
-bestVersions :: IndexMap -> Map.Map String Version
+bestVersions :: IndexMap -> Map.Map Cabal.PackageName Version
 bestVersions = Map.map Set.findMax
+
+
+-}