diff --git a/.gitignore b/.gitignore --- a/.gitignore +++ b/.gitignore @@ -1,1 +1,2 @@ dist/ +cabal-dev/ diff --git a/Merge.hs b/Merge.hs --- a/Merge.hs +++ b/Merge.hs @@ -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]) diff --git a/Merge/Dependencies.hs b/Merge/Dependencies.hs --- a/Merge/Dependencies.hs +++ b/Merge/Dependencies.hs @@ -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)) ] diff --git a/Portage/Dependency.hs b/Portage/Dependency.hs --- a/Portage/Dependency.hs +++ b/Portage/Dependency.hs @@ -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 diff --git a/Portage/EBuild.hs b/Portage/EBuild.hs --- a/Portage/EBuild.hs +++ b/Portage/EBuild.hs @@ -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 diff --git a/Portage/GHCCore.hs b/Portage/GHCCore.hs --- a/Portage/GHCCore.hs +++ b/Portage/GHCCore.hs @@ -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 diff --git a/Portage/Use.hs b/Portage/Use.hs --- a/Portage/Use.hs +++ b/Portage/Use.hs @@ -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 diff --git a/cabal/.git b/cabal/.git new file mode 100644 --- /dev/null +++ b/cabal/.git @@ -0,0 +1,1 @@ +gitdir: /home/slyfox/portage/hackport/.git/modules/cabal diff --git a/hackport.cabal b/hackport.cabal --- a/hackport.cabal +++ b/hackport.cabal @@ -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, diff --git a/tests/MergeDeps.hs b/tests/MergeDeps.hs new file mode 100644 --- /dev/null +++ b/tests/MergeDeps.hs @@ -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 diff --git a/tests/Portage/Use.hs b/tests/Portage/Use.hs new file mode 100644 --- /dev/null +++ b/tests/Portage/Use.hs @@ -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