hackport 0.3.2 → 0.3.3
raw patch · 11 files changed
+456/−85 lines, 11 filesdep ~basedep ~xml
Dependency ranges changed: base, xml
Files
- .gitignore +1/−0
- Merge.hs +181/−41
- Merge/Dependencies.hs +68/−24
- Portage/Dependency.hs +49/−8
- Portage/EBuild.hs +8/−1
- Portage/GHCCore.hs +41/−8
- Portage/Use.hs +11/−2
- cabal/.git +1/−0
- hackport.cabal +23/−1
- tests/MergeDeps.hs +35/−0
- tests/Portage/Use.hs +38/−0
.gitignore view
@@ -1,1 +1,2 @@ dist/+cabal-dev/
Merge.hs view
@@ -1,14 +1,17 @@-{-# OPTIONS -XPatternGuards #-}+{-# LANGUAGE PatternGuards, BangPatterns #-} module Merge ( merge , mergeGenericPackageDescription ) where +import Control.Arrow (first, second) import Control.Monad.Error import Control.Exception import qualified Data.ByteString.Lazy.Char8 as BL import Data.Char (isSpace)+import Data.Function (on) import Data.Maybe+import Data.Monoid import Data.List as L import Data.Version @@ -16,12 +19,13 @@ import qualified Distribution.Package as Cabal import qualified Distribution.Version as Cabal import qualified Distribution.PackageDescription as Cabal ( PackageDescription(..)+ , Flag(..)+ , FlagAssignment , FlagName(..) , GenericPackageDescription(..) )-import qualified Distribution.PackageDescription.Configuration as Cabal ( finalizePackageDescription )+import qualified Distribution.PackageDescription.Parse as Cabal (showPackageDescription) -import Distribution.System (buildPlatform) import Distribution.Text (display) import Distribution.Verbosity import Distribution.Simple.Utils@@ -54,6 +58,8 @@ import qualified Portage.Metadata as Portage import qualified Portage.Overlay as Overlay import qualified Portage.Resolve as Portage+import qualified Portage.Use as Portage+import qualified Portage.Dependency as Portage import qualified Portage.GHCCore as GHCCore @@ -161,79 +167,203 @@ overlay <- Overlay.loadLazy overlayPath let merged_cabal_pkg_name = Cabal.pkgName (Cabal.package (Cabal.packageDescription pkgGenericDesc)) - let Right (pkgDesc0, flags) =- Cabal.finalizePackageDescription- [ -- XXX: common things we should enable/disable?- -- (FlagName "small_base", True) -- try to use small base- (Cabal.FlagName "cocoa", False)- ]- (\_dep -> True)- -- (Nothing :: Maybe (Index.PackageIndex PackageIdentifier))- buildPlatform- (fst GHCCore.defaultGHC)- [] pkgGenericDesc+ let Just (compilerId, ghc_packages, pkgDesc0, _flags, pix) = GHCCore.minimumGHCVersionToBuildPackage pkgGenericDesc - mminimumGHC = GHCCore.minimumGHCVersionToBuildPackage pkgGenericDesc- (compilerId, excludePkgs) = maybe GHCCore.defaultGHC id mminimumGHC+ -- , Right (pkg_desc, picked_flags) <- return (packageBuildableWithGHCVersion gpd g)]+ (accepted_deps, skipped_deps, dropped_deps) = genSimple (Cabal.buildDepends pkgDesc0)+ pkgDesc = pkgDesc0 { Cabal.buildDepends = accepted_deps }+ aflags = map Cabal.flagName (Cabal.genPackageFlags pkgGenericDesc)+ lflags :: [Cabal.Flag] -> [Cabal.FlagAssignment]+ lflags [] = [[]]+ lflags (x:xs) = let tp = lflags xs+ in (map ((Cabal.flagName x,False) :) tp)+ ++ (map ((Cabal.flagName x,True):) tp)+ -- key idea is to generate all possible list of flags+ deps1 :: [(Cabal.FlagAssignment, Merge.EDep)]+ deps1 = [ (f `updateFa` fr, genDeps pkgDesc1)+ | f <- lflags (Cabal.genPackageFlags pkgGenericDesc)+ , Right (pkgDesc1,fr) <- return (GHCCore.finalizePackageDescription f+ (GHCCore.dependencySatisfiable pix)+ (GHCCore.platform)+ compilerId+ []+ pkgGenericDesc)+ ]+ where + updateFa :: Cabal.FlagAssignment -> Cabal.FlagAssignment -> Cabal.FlagAssignment+ updateFa [] _ = []+ updateFa (x:xs) y = case lookup (fst x) y of+ Nothing -> x:(updateFa xs y)+ Just y' -> (fst x,y'):(updateFa xs y)+ -- then remove all flags that can't be changed+ commonFlags = foldl1 intersect $ map fst deps1+ aflags' | null commonFlags = aflags+ | otherwise = filter (\a -> all (a/=) $ map fst commonFlags) aflags+ aflags'' = filter (\x -> Cabal.flagName x `elem` aflags') $ Cabal.genPackageFlags pkgGenericDesc+ -- flags that are faild to build+ deadFlags = filter (\x -> all (x/=) $ map fst deps1) (lflags (Cabal.genPackageFlags pkgGenericDesc))+ -- and finaly prettify all deps:+ tdeps = (foldl (\x y -> x `mappend` (snd y)) mempty deps1){+ Merge.dep = Portage.sortDeps . simplify $ map (\x -> (x,[])) $ map (first (filter (\x -> all (x/=) commonFlags))) $ map (second Merge.dep) deps1+ , Merge.rdep = Portage.sortDeps . simplify $ map (\x -> (x,[])) $ map (first (filter (\x -> all (x/=) commonFlags))) $ map (second Merge.rdep) deps1+ } - (accepted_deps, skipped_deps, dropped_deps) =+ common :: [FlagDepH] -> FlagDepH+ common xs = + let n = go xs+ k m = case m of + [] -> error "impossible"+ [x] -> x+ _ -> k (go m)+ in k n + where + go [] = []+ go [y] = [y]+ go (y1:y2:ys) = y1 `merge1` y2 : go ys++ merge1 :: FlagDepH -> FlagDepH -> FlagDepH+ merge1 ((f1, d1),x1) ((f2, d2),x2) = ((f1 `intersect` f2, Portage.simplify_deps $ d1 `intersect` d2)+ , (f1, filter (`notElem` d2) d1)+ : (f2, filter (`notElem` d1) d2)+ : x1+ ++ x2+ )++ simplify :: [FlagDepH] -> [Portage.Dependency]+ simplify xs = + let -- extract common part of the depends+ -- filtering out empty groups+ ((fl,c), zs) = second (filter (not.null.snd)) $ common xs + -- Regroup flags according to packages, i.e.+ -- if 2 groups of flagged deps containg same package, then+ -- extract common flags, but if common flags will be empty+ -- then remove repacked package from the result list.+ -- This is simplify packages but will not break if depend+ -- is required but non intersecting groups.+ mergeD :: (Cabal.FlagAssignment, Portage.Dependency)+ -> [(Cabal.FlagAssignment, Portage.Dependency)]+ -> [(Cabal.FlagAssignment, Portage.Dependency)]+ mergeD x [] = [x]+ mergeD x@(f1,d1) (t@(f2,d2):ts) = + let is = f1 `intersect` f2+ in if d1 == d2+ then if null is + then ts+ else (is,d1):ts+ else t:mergeD x ts+ sd :: [(Cabal.FlagAssignment, [Portage.Dependency])]+ sd = foldl (\o (f,d) -> case lookup f o of+ Just ds -> (f,d:ds):filter ((f/=).fst) o+ Nothing -> (f,[d]):o+ ) [] $ foldl (\o n -> n `mergeD` o) + [] + (concatMap (\(f,d) -> map ((,) f) d) zs)+ -- filter out splitted packages from common cgroup+ ys = filter (not.null.snd) $ map (second (filter (\d -> all (d/=) + (concatMap snd sd))+ )) zs+ -- Now we need to find noniteracting use flags if they are then we + -- don't need to simplify them more, and output as-is+ simplifyMore :: [(Cabal.FlagAssignment,[Portage.Dependency])] -> [Portage.Dependency]+ simplifyMore [] = []+ simplifyMore ws = + let us = getMultiFlags ws+ (u,_) = maximumBy (compare `on` snd) $ getMultiFlags ws+ (xs, ls) = (hasFlag u) `partition` ws+ in if null us + then concatMap (\(a, b) -> liftFlags a b) ws+ else liftFlags [u] (simplify $ map (\x -> (x,[])) $ dropFlag u xs)++simplifyMore ls+ in (liftFlags fl c) ++ simplifyMore (sd ++ ys)++ -- drop selected use flag from a list+ getMultiFlags :: [FlagDep] -> [((Cabal.FlagName,Bool),Int)]+ getMultiFlags ys = go [] (concatMap fst ys)+ where go a [] = a+ go a (x:xs) = case lookup x a of+ Nothing -> go ((x,1):a) xs+ Just n -> go ((x,n+1):filter ((x/=).fst) a) xs + dropFlag :: (Cabal.FlagName,Bool) -> [FlagDep] -> [FlagDep]+ dropFlag f = map (first (filter (f /=)))+ hasFlag :: (Cabal.FlagName,Bool) -> FlagDep -> Bool+ hasFlag u = any ((u ==)) . fst++ liftFlags :: Cabal.FlagAssignment -> [Portage.Dependency] -> [Portage.Dependency]+ liftFlags fs e = let k = foldr (\(y,b) x -> Portage.DependIfUse ((if b then id else Portage.X) . Portage.mkQUse $ unFlagName y) . x)+ (id::Portage.Dependency->Portage.Dependency) fs+ in Portage.simplify_deps [k $! Portage.AllOf e]+++ genSimple = foldl (\(ad, sd, rd) (Cabal.Dependency pn vr) -> let dep = (Cabal.Dependency pn (Cabal.simplifyVersionRange vr)) in case () of- _ | pn `elem` excludePkgs -> ( ad, dep:sd, rd)+ _ | pn `elem` ghc_packages -> ( ad, dep:sd, rd) _ | pn == merged_cabal_pkg_name -> ( ad, sd, dep:rd) _ -> (dep:ad, sd, rd) ) ([],[],[])- (Cabal.buildDepends pkgDesc0)- pkgDesc = pkgDesc0 { Cabal.buildDepends = accepted_deps }+ genDeps pkg = Merge.resolveDependencies overlay pkg (Just compilerId) - edeps = Merge.resolveDependencies overlay pkgDesc (Just compilerId)+ debug verbosity $ "buildDepends pkgDesc0 raw: " ++ Cabal.showPackageDescription pkgDesc0+ debug verbosity $ "buildDepends pkgDesc0: " ++ show (map display (Cabal.buildDepends pkgDesc0))+ debug verbosity $ "buildDepends pkgDesc: " ++ show (map display (Cabal.buildDepends pkgDesc)) notice verbosity $ "Accepted depends: " ++ show (map display accepted_deps) notice verbosity $ "Skipped depends: " ++ show (map display skipped_deps) notice verbosity $ "Dropped depends: " ++ show (map display dropped_deps)- notice verbosity $ "Selected flags: " ++ show flags- info verbosity ("Guessing GHC version: " ++ maybe "could not guess" (display.fst) mminimumGHC)- forM_ excludePkgs $+ notice verbosity $ "Dead flags: " ++ show deadFlags+ notice verbosity $ "Dropped flags: " ++ show (map (unFlagName.fst) commonFlags)+ -- mapM_ print tdeps++ forM_ ghc_packages $ \(Cabal.PackageName name) -> info verbosity $ "Excluded packages (comes with ghc): " ++ name - let p_flag (Cabal.FlagName fn, True) = fn- p_flag (Cabal.FlagName fn, False) = '-':fn+ let -- p_flag (Cabal.FlagName fn, True) = fn+ -- p_flag (Cabal.FlagName fn, False) = '-':fn + -- appends 's' to each line except the last one -- handy to build multiline shell expressions icalate _s [] = [] icalate _s [x] = [x] icalate s (x:xs) = (x ++ s) : icalate s xs + selected_flags :: [String] -> [String] selected_flags [] = []- selected_flags fs = icalate " \\" $ "haskell-cabal_src_configure" : map (("\t--flag=" ++) . p_flag) fs+ selected_flags fs = icalate " \\" $ "haskell-cabal_src_configure"+ : map (\p -> "\t$(cabal_flag "++ p ++" "++ p ++")") fs+ to_iuse x = let fn = unFlagName $ Cabal.flagName x+ p = if Cabal.flagDefault x then "+" else ""+ in p++fn - ebuild = (\e -> e { E.depend = Merge.dep edeps } )- . (\e -> e { E.depend_extra = Merge.dep_e edeps } )- . (\e -> e { E.rdepend = Merge.rdep edeps } )- . (\e -> e { E.rdepend_extra = Merge.rdep_e edeps } )- . (\e -> e { E.src_configure = selected_flags flags } )+ ebuild = (\e -> e { E.depend = Merge.dep tdeps} )+ . (\e -> e { E.depend_extra = Merge.dep_e tdeps } )+ . (\e -> e { E.rdepend = Merge.rdep tdeps} )+ . (\e -> e { E.rdepend_extra = Merge.rdep_e tdeps } )+ . (\e -> e { E.src_configure = selected_flags $ sort $ map unFlagName aflags' } )+ . (\e -> e { E.iuse = E.iuse e ++ map to_iuse aflags'' }) $ C2E.cabal2ebuild pkgDesc mergeEbuild verbosity overlayPath (Portage.unCategory cat) ebuild when fetch $ do let cabal_pkgId = Cabal.packageId pkgDesc norm_pkgName = Cabal.packageName (Portage.normalizeCabalPackageId cabal_pkgId)- fetchAndDigest+ fetchDigestAndCheck verbosity (overlayPath </> display cat </> display norm_pkgName) -fetchAndDigest :: Verbosity- -> FilePath -- ^ directory of ebuild- -> IO ()-fetchAndDigest verbosity ebuildDir =+fetchDigestAndCheck :: Verbosity+ -> FilePath -- ^ directory of ebuild+ -> IO ()+fetchDigestAndCheck verbosity ebuildDir = withWorkingDirectory ebuildDir $ do notice verbosity "Recalculating digests (repoman manifest)..."- r <- system "repoman manifest"- when (r /= ExitSuccess) $+ rm <- system "repoman manifest"+ when (rm /= ExitSuccess) $ notice verbosity "repoman manifest failed horribly. Do something about it!"+ rf <- system "repoman full --include-dev"+ when (rf /= ExitSuccess) $+ notice verbosity "repoman full --include-dev found an error. Do something about it!" return () withWorkingDirectory :: FilePath -> IO a -> IO a@@ -255,7 +385,9 @@ [kw_ln] -> let kw_line = lns !! kw_ln kw_str = (fst . break (== '"') . tail . snd . break (== '"')) kw_line keywords = words kw_str- in Just keywords+ in if null keywords+ then Nothing+ else Just keywords other -> error $ ebuild_path ++ ": parse_ebuild: strange KEYWORDS lines: " ++ show other findExistingKeywords :: FilePath -> IO (Maybe [String])@@ -278,7 +410,7 @@ '-':_ -> kw _ -> '~':kw -mergeEbuild :: Verbosity -> FilePath -> String -> E.EBuild -> IO () +mergeEbuild :: Verbosity -> FilePath -> String -> E.EBuild -> IO () mergeEbuild verbosity target cat ebuild = do let edir = target </> cat </> E.name ebuild elocal = E.name ebuild ++"-"++ E.version ebuild <.> "ebuild"@@ -305,3 +437,11 @@ else do current_meta <- BL.readFile mpath when (current_meta /= default_meta) $ notice verbosity $ "Default and current " ++ emeta ++ " differ."++unFlagName :: Cabal.FlagName -> String+unFlagName f =+ let Cabal.FlagName y = f+ in y++type FlagDep = (Cabal.FlagAssignment,[Portage.Dependency])+type FlagDepH = (FlagDep,[FlagDep])
Merge/Dependencies.hs view
@@ -1,4 +1,4 @@-{- | Merge a package from hackage to an ebuild. +{- | Merge a package from hackage to an ebuild. Merging a library =================@@ -40,10 +40,12 @@ DEPEND="${RDEPEND} ghc cabal ${DEPS} ${BUILDTOOLS}" -}- module Merge.Dependencies ( EDep(..) , resolveDependencies+ , intersection+ , difference+ , null ) where import Distribution.PackageDescription ( PackageDescription(..)@@ -53,13 +55,16 @@ , extraLibs , buildTools , pkgconfigDepends- , hasLibs , specVersion , TestSuite(..) , targetBuildDepends )+import Prelude hiding (null) import Data.Maybe ( isJust, isNothing )+import Data.Monoid ( Monoid, mempty, mappend) import Data.List ( nub )+import qualified Data.List as L+import qualified Data.Set as S import qualified Distribution.Package as Cabal import qualified Distribution.PackageDescription as Cabal@@ -86,16 +91,40 @@ dep :: [Portage.Dependency], dep_e :: [String] }+ deriving (Show, Eq) -emptyEDep :: EDep-emptyEDep = EDep- {- rdep = [],- rdep_e = [],- dep = [],- dep_e = []- }+instance Monoid EDep where+ mempty = EDep+ {+ rdep = [],+ rdep_e = [],+ dep = [],+ dep_e = []+ }+ (EDep rdepA rdep_eA depA dep_eA) `mappend` (EDep rdepB rdep_eB depB dep_eB) = EDep+ { rdep = Portage.simplify_deps $ rdepA ++ rdepB+ , rdep_e = S.toList $ (S.fromList rdep_eA) `S.union` (S.fromList rdep_eB)+ , dep = Portage.simplify_deps $ depA ++ depB+ , dep_e = S.toList $ (S.fromList dep_eA) `S.union` (S.fromList dep_eB)+ } ++intersection :: EDep -> EDep -> EDep+intersection (EDep a1 a2 a3 a4) (EDep b1 b2 b3 b4) = EDep (L.intersect a1 b1)+ (L.intersect a2 b2)+ (L.intersect a3 b3)+ (L.intersect a4 b4)++difference :: EDep -> EDep -> EDep+difference (EDep a1 a2 a3 a4) (EDep b1 b2 b3 b4) = EDep (f a1 b1)+ (f a2 b2)+ (f a3 b3)+ (f a4 b4)+ where f a b = L.filter (`L.notElem` b) a++null :: EDep -> Bool+null e = e == mempty+ resolveDependencies :: Portage.Overlay -> PackageDescription -> Maybe CompilerId -> EDep resolveDependencies overlay pkg mcompiler = edeps@@ -112,24 +141,24 @@ rdep2 = Portage.simplifyUseDeps rdep1 rdep1 compiler = maybe (fst GHCCore.defaultGHC) id mcompiler - hasBuildableExes p = any (buildable . buildInfo) . executables $ p+ -- hasBuildableExes p = any (buildable . buildInfo) . executables $ p treatAsLibrary = isJust (Cabal.library pkg) haskell_deps- | treatAsLibrary = map set_build_slot $ map add_profile $ haskellDependencies overlay pkg- | otherwise = haskellDependencies overlay pkg+ | treatAsLibrary = map set_build_slot $ map add_profile $ haskellDependencies overlay (buildDepends pkg)+ | otherwise = haskellDependencies overlay (buildDepends pkg) test_deps- | (not . null) (testSuites pkg) = testDependencies overlay pkg+ | (not . L.null) (testSuites pkg) = testDependencies overlay pkg | otherwise = [] -- tests not enabled cabal_dep = cabalDependency overlay pkg compiler ghc_dep = compilerIdToDependency compiler extra_libs = findCLibs pkg pkg_config_libs = pkgConfigDependencies overlay pkg- pkg_config_tools = if null pkg_config_libs+ pkg_config_tools = if L.null pkg_config_libs then [] else [Portage.AnyVersionOf (Portage.mkPackageName "virtual" "pkgconfig") Portage.AnySlot []] build_tools = buildToolsDependencies pkg ++ pkg_config_tools edeps- | treatAsLibrary = emptyEDep+ | treatAsLibrary = mempty { dep = cabal_dep : build_tools@@ -140,7 +169,7 @@ ++ extra_libs ++ pkg_config_libs }- | otherwise = emptyEDep+ | otherwise = mempty { dep = ghc_dep : cabal_dep@@ -159,7 +188,7 @@ testDependencies :: Portage.Overlay -> PackageDescription -> [Portage.Dependency] testDependencies overlay pkg@(PackageDescription { package = Cabal.PackageIdentifier { Cabal.pkgName = Cabal.PackageName name}}) =- [Portage.DependIfUse (Portage.UseFlag "test") (Portage.AllOf $ Portage.simplify_deps deps)]+ [Portage.DependIfUse (Portage.mkQUse "test") (Portage.AllOf $ Portage.simplify_deps deps)] where cabalDeps = concat $ map targetBuildDepends $ map testBuildInfo (testSuites pkg) cabalDeps' = filter (\(Cabal.Dependency (Cabal.PackageName pname) _) -> pname /= name) cabalDeps deps = C2E.convertDependencies overlay (Portage.Category "dev-haskell") cabalDeps'@@ -168,10 +197,10 @@ -- Haskell packages --------------------------------------------------------------- -haskellDependencies :: Portage.Overlay -> PackageDescription -> [Portage.Dependency]-haskellDependencies overlay pkg =+haskellDependencies :: Portage.Overlay -> [Cabal.Dependency] {- PackageDescription -} -> [Portage.Dependency]+haskellDependencies overlay deps = Portage.simplify_deps- $ C2E.convertDependencies overlay (Portage.Category "dev-haskell") (buildDepends pkg)+ $ C2E.convertDependencies overlay (Portage.Category "dev-haskell") deps --------------------------------------------------------------- -- Cabal Dependency@@ -180,7 +209,7 @@ -- | Select the most restrictive dependency on Cabal, either the .cabal -- file's descCabalVersion, or the Cabal GHC shipped with. cabalDependency :: Portage.Overlay -> PackageDescription -> CompilerId -> Portage.Dependency-cabalDependency overlay pkg (CompilerId GHC ghcVersion@(Cabal.Version versionNumbers _)) =+cabalDependency overlay pkg (CompilerId GHC _ghcVersion@(Cabal.Version versionNumbers _)) = head $ C2E.convertDependency overlay (Portage.Category "dev-haskell") (Cabal.Dependency (Cabal.PackageName "Cabal")@@ -215,7 +244,7 @@ [ trace ("WARNING: This package depends on a C library we don't know the portage name for: " ++ p ++ ". Check the generated ebuild.") (Portage.AnyVersionOf (Portage.mkPackageName "unknown-c-lib" p) Portage.AnySlot []) | p <- notFound- ] ++ + ] ++ found where libE = maybe [] (extraLibs.libBuildInfo) lib@@ -257,6 +286,19 @@ , ("sqlite3", Portage.OrLaterVersionOf (Portage.Version [3,0] Nothing [] 0) (Portage.mkPackageName "dev-db" "sqlite") Portage.AnySlot []) , ("stdc++", Portage.AnyVersionOf (Portage.mkPackageName "sys-devel" "gcc") Portage.AnySlot [Portage.mkUse "cxx"]) , ("crack", Portage.AnyVersionOf (Portage.mkPackageName "sys-libs" "cracklib") Portage.AnySlot [])+ , ("exif", Portage.AnyVersionOf (Portage.mkPackageName "media-libs" "libexif") Portage.AnySlot [])+ , ("IL", Portage.AnyVersionOf (Portage.mkPackageName "media-libs" "devil") Portage.AnySlot [])+ , ("Imlib2", Portage.AnyVersionOf (Portage.mkPackageName "media-libs" "imlib2") Portage.AnySlot [])+ , ("pcap", Portage.AnyVersionOf (Portage.mkPackageName "net-libs" "libpcap") Portage.AnySlot [])+ , ("lber", Portage.AnyVersionOf (Portage.mkPackageName "net-nds" "openldap") Portage.AnySlot [])+ , ("ldap", Portage.AnyVersionOf (Portage.mkPackageName "net-nds" "openldap") Portage.AnySlot [])+ , ("expect", Portage.AnyVersionOf (Portage.mkPackageName "dev-tcltk" "expect") Portage.AnySlot [])+ , ("tcl", Portage.AnyVersionOf (Portage.mkPackageName "dev-lang" "tcl") Portage.AnySlot [])+ , ("Xext", Portage.AnyVersionOf (Portage.mkPackageName "x11-libs" "libXext") Portage.AnySlot [])+ , ("Xrandr", Portage.AnyVersionOf (Portage.mkPackageName "x11-libs" "libXrandr") Portage.AnySlot [])+ , ("crypto", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "openssl") Portage.AnySlot [])+ , ("gmp", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "gmp") Portage.AnySlot [])+ , ("fuse", Portage.AnyVersionOf (Portage.mkPackageName "sys-fs" "fuse") Portage.AnySlot []) ] ---------------------------------------------------------------@@ -287,6 +329,7 @@ , ("gtk2hsTypeGen", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools") Portage.AnySlot []) , ("gtk2hsHookGenerator", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools") Portage.AnySlot []) , ("gtk2hsC2hs", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools") Portage.AnySlot [])+ , ("cabal", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "cabal-install") Portage.AnySlot []) ] -- tools that are provided by ghc or some other existing program@@ -386,4 +429,5 @@ ,("gnutls", ("net-libs", "gnutls", Portage.AnySlot)) ,("libidn", ("net-dns", "libidn", Portage.AnySlot)) ,("libxml-2.0", ("dev-libs", "libxml2", Portage.AnySlot))+ ,("yaml-0.1", ("dev-libs", "libyaml", Portage.AnySlot)) ]
Portage/Dependency.hs view
@@ -5,6 +5,7 @@ , simplifyUseDeps , addDepUseFlag , setSlotDep+ , sortDeps ) where import Portage.Version@@ -16,9 +17,10 @@ import qualified Text.PrettyPrint as Disp import Text.PrettyPrint ( (<>), hsep ) +import Data.Function ( on ) import Data.Maybe ( fromJust, catMaybes, mapMaybe )-import Data.List ( nub, groupBy, partition, sortBy )-import Data.Ord (comparing)+import Data.List ( nub, groupBy, partition, sortBy, sort )+import Data.Ord (comparing, Ordering(..)) data SlotDepend = AnySlot -- nothing special | AnyBuildTimeSlot -- ':='@@ -57,7 +59,7 @@ showDepend (OrEarlierVersionOf v p s u) = Disp.text "<=" <> disp p <-> disp v <> dispSlot s <> dispUses u showDepend (ThisMajorOf v p s u) = Disp.char '=' <> disp p <-> disp v <> Disp.char '*' <> dispSlot s <> dispUses u showDepend (DependEither dp ) = Disp.text "|| ( " <> hsep (map showDepend dp) <> Disp.text " )"-showDepend (DependIfUse useflag dep) = disp useflag <> Disp.text "? " <> pp_deps dep+showDepend (DependIfUse useflag dep) = disp useflag <> Disp.text " " <> pp_deps dep where -- special case to avoid double braces: test? ( ( ) ) pp_deps (AllOf _) = disp dep pp_deps _ = Disp.parens (Disp.text " " <> disp dep <> Disp.text " ")@@ -81,7 +83,7 @@ -- simplify_group_table p ol l e oe exact -- 1) trivial cases:-simplify_group_table p _s _u Nothing Nothing Nothing Nothing Nothing = error $ display p ++ ": unsolvable constraints"+simplify_group_table p _s _u Nothing Nothing Nothing Nothing Nothing = error $ "Portage/Dependency.hs: " ++ display p ++ ": unsolvable constraints" simplify_group_table p s u (Just v) Nothing Nothing Nothing Nothing = [OrLaterVersionOf v p s u] simplify_group_table p s u Nothing (Just v) Nothing Nothing Nothing = [LaterVersionOf v p s u] simplify_group_table p s u Nothing Nothing (Just v) Nothing Nothing = [EarlierVersionOf v p s u]@@ -110,6 +112,12 @@ simplify_group :: [Dependency] -> [Dependency] simplify_group [dep@(AnyVersionOf _package _s _u)] = [dep] simplify_group [dep@(ThisMajorOf _v _p _s _u)] = [dep]++-- "zlib, zlib == 0.5.*" => "zlib == 0.5.*"+simplify_group deps+ | any isAVO deps = simplify_group $ filter (not . isAVO) deps+ where isAVO (AnyVersionOf _package _slot _use) = True+ isAVO _ = False simplify_group deps = simplify_group_table package slot uses@@ -155,16 +163,23 @@ -- divide packages to groups (by package name), simplify groups, merge again simplify_deps :: [Dependency] -> [Dependency]-simplify_deps deps = (concatMap (simplify_group.nub) $- groupBy cmpPkgName $- sortBy (comparing getPackagePart) groupable)- ++ ungroupable+simplify_deps deps = flattenDep $ + (concatMap (simplify_group.nub) $+ groupBy cmpPkgName $+ sortBy (comparing getPackagePart) groupable)+ ++ ungroupable where (ungroupable, groupable) = partition ((==Nothing).getPackage) deps -- cmpPkgName p1 p2 = cmpMaybe (getPackage p1) (getPackage p2) cmpMaybe (Just p1) (Just p2) = p1 == p2 cmpMaybe _ _ = False --+ flattenDep :: [Dependency] -> [Dependency]+ flattenDep [] = []+ flattenDep (AllOf ds:xs) = (concatMap (\x -> flattenDep [x]) ds) ++ flattenDep xs+ flattenDep (x:xs) = x:flattenDep xs+ -- TODO concat 2 dep either in the same group+ getPackage :: Dependency -> Maybe PackageName getPackage (AllOf _dependency) = Nothing getPackage (AnyVersionOf package _s _uses) = Just package@@ -255,3 +270,29 @@ isUseDep :: Dependency -> Bool isUseDep (DependIfUse _ _) = True isUseDep _ = False+++sortDeps :: [Dependency] -> [Dependency]+sortDeps = sortBy dsort . map deeper+ where+ deeper :: Dependency -> Dependency+ deeper (DependIfUse u1 d) = DependIfUse u1 $ deeper d+ deeper (AllOf ds) = AllOf $ sortDeps ds+ deeper (DependEither ds) = DependEither $ sortDeps ds+ deeper x = x+ dsort :: Dependency -> Dependency -> Ordering+ dsort (DependIfUse u1 _) (DependIfUse u2 _) = u1 `compare` u2+ dsort (DependIfUse _ _) (DependEither _) = LT+ dsort (DependIfUse _ _) (AllOf _) = LT+ dsort (DependIfUse _ _) _ = GT+ dsort (DependEither _) (DependEither _) = EQ+ dsort (DependEither _) (DependIfUse _ _) = GT+ dsort (DependEither _) (AllOf _) = LT+ dsort (DependEither _) _ = GT+ dsort (AllOf _) (AllOf _) = EQ+ dsort (AllOf _) (DependIfUse _ _) = LT+ dsort (AllOf _) (DependEither _) = GT+ dsort _ (DependIfUse _ _) = LT+ dsort _ (AllOf _) = LT+ dsort _ (DependEither _) = LT+ dsort a b = (compare `on` getPackage) a b
Portage/EBuild.hs view
@@ -12,6 +12,8 @@ import Distribution.License as Cabal import Data.String.Utils+import qualified Data.Function as F+import qualified Data.List as L import Data.Version(Version(..)) import qualified Paths_hackport(version) @@ -105,7 +107,7 @@ else ss "\t#". ss (licenseComment . license $ ebuild)). nl. ss "SLOT=". quote (slot ebuild). nl. ss "KEYWORDS=". quote' (sepBy " " $ keywords ebuild).nl.- ss "IUSE=". quote' (sepBy ", " $ iuse ebuild). nl.+ ss "IUSE=". quote' (sepBy " " . sort_iuse $ iuse ebuild). nl. nl. dep_str "RDEPEND" (rdepend_extra ebuild) (rdepend ebuild). dep_str "DEPEND" ( depend_extra ebuild) ( depend ebuild).@@ -124,6 +126,11 @@ , (hackage_name ebuild, "${HACKAGE_N}") ] toMirror = replace "http://hackage.haskell.org/" "mirror://hackage/"++-- "+a" -> "a"+-- "b" -> "b"+sort_iuse :: [String] -> [String]+sort_iuse = L.sortBy (compare `F.on` dropWhile ( `elem` "+")) type DString = String -> String
Portage/GHCCore.hs view
@@ -5,6 +5,9 @@ , minimumGHCVersionToBuildPackage , cabalFromGHC , defaultGHC+ , finalizePackageDescription+ , platform+ , dependencySatisfiable ) where import Distribution.Package@@ -29,7 +32,7 @@ defaultGHC = let (g,pix) = ghc6123 in (g, packageNamesFromPackageIndex pix) ghcs :: [(CompilerId, PackageIndex)]-ghcs = [ghc6104, ghc6121, ghc6122, ghc6123, ghc704, ghc741, ghc742, ghc761]+ghcs = [ghc6104, ghc6121, ghc6122, ghc6123, ghc704, ghc741, ghc742, ghc761, ghc762] cabalFromGHC :: [Int] -> Maybe Version cabalFromGHC ver = lookup ver table@@ -49,6 +52,7 @@ ,([7,0,1], Version [1,10,0,0] []) ,([7,4,2], Version [1,14,0] []) ,([7,6,1], Version [1,16,0] [])+ ,([7,6,2], Version [1,16,0] []) ] platform :: Platform@@ -92,11 +96,11 @@ -- | Given a 'GenericPackageDescription' it returns the miminum GHC version -- to build a package, and a list of core packages to that GHC version.-minimumGHCVersionToBuildPackage :: GenericPackageDescription -> Maybe (CompilerId, [PackageName])+minimumGHCVersionToBuildPackage :: GenericPackageDescription -> Maybe (CompilerId, [PackageName], PackageDescription, FlagAssignment, PackageIndex) minimumGHCVersionToBuildPackage gpd =- listToMaybe [ (cid, packageNamesFromPackageIndex pix)+ listToMaybe [ (cid, packageNamesFromPackageIndex pix, pkg_desc, picked_flags, pix) | g@(cid, pix) <- ghcs- , Right _ <- return (packageBuildableWithGHCVersion gpd g)]+ , Right (pkg_desc, picked_flags) <- return (packageBuildableWithGHCVersion gpd g)] mkIndex :: [PackageIdentifier] -> PackageIndex mkIndex pids = fromList@@ -113,15 +117,18 @@ ghc :: [Int] -> CompilerId ghc nrs = CompilerId GHC (Version nrs []) +ghc762 :: (CompilerId, PackageIndex)+ghc762 = (ghc [7,6,2], mkIndex ghc762_pkgs)+ ghc761 :: (CompilerId, PackageIndex) ghc761 = (ghc [7,6,1], mkIndex ghc761_pkgs) -ghc741 :: (CompilerId, PackageIndex)-ghc741 = (ghc [7,4,1], mkIndex ghc741_pkgs)- ghc742 :: (CompilerId, PackageIndex) ghc742 = (ghc [7,4,2], mkIndex ghc742_pkgs) +ghc741 :: (CompilerId, PackageIndex)+ghc741 = (ghc [7,4,1], mkIndex ghc741_pkgs)+ ghc704 :: (CompilerId, PackageIndex) ghc704 = (ghc [7,0,1], mkIndex ghc704_pkgs) @@ -140,12 +147,38 @@ -- | Non-upgradeable core packages -- Source: http://haskell.org/haskellwiki/Libraries_released_with_GHC +ghc762_pkgs :: [PackageIdentifier]+ghc762_pkgs =+ [ p "array" [0,4,0,1]+ , p "base" [4,6,0,1]+-- , p "binary" [0,5,1,1] package is upgradeable+ , p "bytestring" [0,10,0,2]+-- , p "Cabal" [1,16,0] package is upgradeable+ , p "containers" [0,5,0,0]+-- , p "deepseq" [1,3,0,1] -- package is upgradeable+ , p "directory" [1,2,0,1]+ , p "filepath" [1,3,0,1]+ , p "ghc-prim" [0,3,0,0]+ , p "haskell2010" [1,1,1,0]+ , p "haskell98" [2,0,0,2]+ , p "hoopl" [3,9,0,0] -- used by libghc+ , p "hpc" [0,6,0,0] -- used by libghc+ , p "integer-gmp" [0,5,0,0]+ , p "old-locale" [1,0,0,5]+ , p "old-time" [1,1,0,1]+ , p "pretty" [1,1,1,0]+ , p "process" [1,1,0,2]+ , p "template-haskell" [2,8,0,0] -- used by libghc+ , p "time" [1,4,0,1] -- used by haskell98, unix, directory, hpc, ghc. unsafe to upgrade+ , p "unix" [2,6,0,1]+ ]+ ghc761_pkgs :: [PackageIdentifier] ghc761_pkgs = [ p "array" [0,4,0,1] , p "base" [4,6,0,0] -- , p "binary" [0,5,1,1] package is upgradeable- , p "bytestring" [0,10,0,8]+ , p "bytestring" [0,10,0,0] -- , p "Cabal" [1,16,0] package is upgradeable , p "containers" [0,5,0,0] -- , p "deepseq" [1,3,0,1] -- package is upgradeable
Portage/Use.hs view
@@ -21,12 +21,21 @@ | N UseFlag -- ^ - modificator deriving (Eq,Show,Ord,Read) --- |++{-+instance IsString UseFlag where+ fromString ('!':str) = X (fromString str)+ fromString ('-':str) = N (fromString str)+ fromString str = case last str of+ '?' -> Q (fromString (init str))+ '=' -> E (fromString (init str))+ s -> UseFlag s+-} mkUse :: Use -> UseFlag mkUse = UseFlag mkNotUse :: Use -> UseFlag-mkNotUse = UseFlag+mkNotUse = N . UseFlag mkQUse :: Use -> UseFlag mkQUse = Q . UseFlag
+ cabal/.git view
@@ -0,0 +1,1 @@+gitdir: /home/slyfox/portage/hackport/.git/modules/cabal
hackport.cabal view
@@ -1,5 +1,5 @@ Name: hackport-Version: 0.3.2+Version: 0.3.3 License: GPL License-file: LICENSE Author: Henning Günther, Duncan Coutts, Lennart Kolmodin@@ -130,6 +130,28 @@ Type: exitcode-stdio-1.0 Default-Language: Haskell98 Main-Is: tests/resolveCat.hs+ Hs-Source-Dirs: ., cabal, cabal/Cabal, cabal/cabal-install+ Build-Depends: base >= 3 && < 5,+ deepseq >= 1.3 && < 1.4,+ bytestring,+ containers,+ directory,+ extensible-exceptions,+ filepath,+ HUnit,+ mtl,+ pretty,+ process,+ time,+ unix,+ xml++Test-Suite test-merge-deps+ -- Build is broken for now+ Buildable: False+ Type: exitcode-stdio-1.0+ Default-Language: Haskell98+ Main-Is: tests/MergeDeps.hs Hs-Source-Dirs: ., cabal, cabal/Cabal, cabal/cabal-install Build-Depends: base >= 3 && < 5, deepseq >= 1.3 && < 1.4,
+ tests/MergeDeps.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}+import Control.Monad (when)++import qualified Distribution.Package as Cabal++import qualified Portage.Dependency as Portage++import System.Exit (exitFailure)+import Test.HUnit++tests = TestList [ TestLabel "simple merge" test_merge1+ ]++test_merge1 = map (\(a,b,c) -> assertEqual "excepting merge" c (a `Portage.mergeDeps` b)) cases+ where + cases = + [ (["foo/bar"],["foo/baz"],["foo/bar", "foo/baz"]) -- a /= b => a+b+ --, (["foo/bar","foo/baz"],["foo/baz"],["foo/bar","foo/baz"]) -- a == b => a+ --, (["foo/bar"],["use? (foo/baz)"],["foo/bar", "use? (foo/baz)"]) -- covered by 1st+ --, (["foo/bar"],["use? (foo/bar)"],["foo/bar"]) -- a <> (use? a) => a+ --, (["foo/bar"],["use? ( use2? (foo/bar))"],["foo/bar"])+ -- , ([!use? ("foo/bar")],["use? (foo/baz)"],["!use? (foo/bar)","use? (foo/baz)"]) -- extract dep+ ]++-- A <> B+-- rules: +-- 1). \forall b \in B: \exists a \in A a ~= b -> {A <> B \ b}+-- 2). \forall b \in B: \not \exists a \in A ~=b++something_broke :: Counts -> Bool+something_broke stats = errors stats + failures stats > 0++main =+ do stats <- runTestTT tests+ when (something_broke stats) exitFailure
+ tests/Portage/Use.hs view
@@ -0,0 +1,38 @@+module Main++import Control.Monad (when)++import qualified Distribution.Package as Cabal++import qualified Portage.Overlay as Portage+import qualified Portage.Resolve as Portage+import qualified Portage.PackageId as Portage+import qualified Portage.Host as Portage++import System.Exit (exitFailure)+import Test.HUnit++tests = TestList [ TestLabel "resolve cabal" (test_resolveCategory "dev-haskell" "cabal")+ , TestLabel "resolve ghc" (test_resolveCategory "dev-lang" "ghc")+ , TestLabel "resolve Cabal" (test_resolveCategory "dev-haskell" "Cabal")+ , TestLabel "resolve DaRsC" (test_resolveCategory "dev-vcs" "darcs")+ ]++uses = [ ("use", UseFlag "use")+ , ("use?", Q (UseFlag "use"))+ , ("!use", X (UseFlag "use"))]+test_resolveCategory :: String -> String -> Test+test_resolveCategory cat pkg = TestCase $ do+ portage_dir <- Portage.portage_dir `fmap` Portage.getInfo+ portage <- Portage.loadLazy portage_dir+ let cabal = Cabal.PackageName pkg+ hits = Portage.resolveFullPortageName portage cabal+ expected = Just (Portage.PackageName (Portage.Category cat) (Portage.normalizeCabalPackageName cabal))+ assertEqual ("expecting to find package " ++ pkg) expected hits++something_broke :: Counts -> Bool+something_broke stats = errors stats + failures stats > 0++main =+ do stats <- runTestTT tests+ when (something_broke stats) exitFailure