Permalink
Browse files

Update the CLI and start using cabal-install features

Code ported to get the CLI like cabal-install style
Use cabal-install for updating
  • Loading branch information...
1 parent f2749d2 commit 8273e68c910c2b9a62d104a762f87bdd4a236b46 @kolmodin kolmodin committed Feb 7, 2009
Showing with 258 additions and 145 deletions.
  1. +10 −12 Cabal2Ebuild.hs
  2. +4 −0 Cache.hs
  3. +106 −27 Diff.hs
  4. +4 −7 GenerateEbuild.hs
  5. +27 −26 Index.hs
  6. +99 −68 Main.hs
  7. +4 −2 Merge.hs
  8. +2 −2 Overlays.hs
  9. +2 −1 hackport.cabal
View
@@ -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
View
@@ -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
+
+-}
View
133 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
+-}
View
@@ -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
View
@@ -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
+
+
+-}
Oops, something went wrong.

0 comments on commit 8273e68

Please sign in to comment.