hackport 0.3.3 → 0.3.4
raw patch · 20 files changed
+1010/−422 lines, 20 filesdep ~basedep ~xml
Dependency ranges changed: base, xml
Files
- Cabal2Ebuild.hs +21/−14
- Merge.hs +8/−6
- Merge/Dependencies.hs +91/−68
- Portage/Dependency.hs +51/−230
- Portage/Dependency/Builder.hs +25/−0
- Portage/Dependency/Normalize.hs +261/−0
- Portage/Dependency/Print.hs +87/−0
- Portage/Dependency/Print.hs-boot +10/−0
- Portage/Dependency/Types.hs +96/−0
- Portage/EBuild.hs +20/−1
- Portage/Version.hs +9/−3
- Status.hs +8/−7
- cabal/.git +0/−1
- hackport.cabal +31/−10
- tests/MergeDeps.hs +0/−35
- tests/Portage/Use.hs +0/−38
- tests/RunTests.hs +15/−0
- tests/normalize_deps.hs +134/−0
- tests/print_deps.hs +138/−0
- tests/resolveCat.hs +5/−9
Cabal2Ebuild.hs view
@@ -73,27 +73,34 @@ else Cabal.homepage pkg convertDependencies :: O.Overlay -> Portage.Category -> [Cabal.Dependency] -> [Dependency]-convertDependencies overlay category = concatMap (convertDependency overlay category)+convertDependencies overlay category = map (convertDependency overlay category) -convertDependency :: O.Overlay -> Portage.Category -> Cabal.Dependency -> [Dependency]+convertDependency :: O.Overlay -> Portage.Category -> Cabal.Dependency -> Dependency convertDependency _overlay _category (Cabal.Dependency pname@(Cabal.PackageName _name) _)- | pname `elem` Portage.coreLibs = [] -- no explicit dep on core libs+ -- no explicit dep on core libs.+ -- TODO: the same is done when filtering in+ -- merge phase in a more robust way. Do we need it?+ | pname `elem` Portage.coreLibs = empty_dependency convertDependency overlay category (Cabal.Dependency pname versionRange) = convert versionRange where pn = case Portage.resolveFullPortageName overlay pname of Just r -> r Nothing -> Portage.PackageName category (Portage.normalizeCabalPackageName pname)- convert :: Cabal.VersionRange -> [Dependency]+ mk_p :: DRange -> Dependency+ mk_p dr = Atom pn dr (DAttr AnySlot [])+ p_v v = fromCabalVersion v++ convert :: Cabal.VersionRange -> Dependency convert = Cabal.foldVersionRange'- ( [AnyVersionOf pn AnySlot []] -- ^ @\"-any\"@ version- )(\v -> [ThisVersionOf (fromCabalVersion v) pn AnySlot []] -- ^ @\"== v\"@- )(\v -> [LaterVersionOf (fromCabalVersion v) pn AnySlot []] -- ^ @\"> v\"@- )(\v -> [EarlierVersionOf (fromCabalVersion v) pn AnySlot []] -- ^ @\"< v\"@- )(\v -> [OrLaterVersionOf (fromCabalVersion v) pn AnySlot []] -- ^ @\">= v\"@- )(\v -> [OrEarlierVersionOf (fromCabalVersion v) pn AnySlot []] -- ^ @\"<= v\"@- )(\v _ -> [ThisMajorOf (fromCabalVersion v) pn AnySlot []] -- ^ @\"== v.*\"@ wildcard. (incl lower, excl upper)- )(\g1 g2 -> [DependEither (g1 ++ g2)] -- ^ @\"_ || _\"@ union- )(\r1 r2 -> r1 ++ r2 -- ^ @\"_ && _\"@ intersection- )(\dp -> [AllOf dp ] -- ^ @\"(_)\"@ parentheses+ ( mk_p (DRange ZeroB InfinityB) -- ^ @\"-any\"@ version+ )(\v -> mk_p (DExact (p_v v)) -- ^ @\"== v\"@+ )(\v -> mk_p (DRange (StrictLB (p_v v)) InfinityB) -- ^ @\"> v\"@+ )(\v -> mk_p (DRange ZeroB (StrictUB (p_v v))) -- ^ @\"< v\"@+ )(\v -> mk_p (DRange (NonstrictLB (p_v v)) InfinityB) -- ^ @\">= v\"@+ )(\v -> mk_p (DRange ZeroB (NonstrictUB (p_v v))) -- ^ @\"<= v\"@+ )(\v1 v2 -> mk_p (DRange (NonstrictLB (p_v v1)) (StrictUB (p_v v2))) -- ^ @\"== v.*\"@ wildcard. (incl lower, excl upper)+ )(\g1 g2 -> DependAnyOf [g1, g2] -- ^ @\"_ || _\"@ union+ )(\r1 r2 -> DependAllOf [r1, r2] -- ^ @\"_ && _\"@ intersection+ )(\dp -> dp -- ^ @\"(_)\"@ parentheses )
Merge.hs view
@@ -58,7 +58,6 @@ 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@@ -180,14 +179,17 @@ ++ (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)+ deps1 = [ (f `updateFa` fr, genDeps pkgDesc_filtered_bdeps) | f <- lflags (Cabal.genPackageFlags pkgGenericDesc)- , Right (pkgDesc1,fr) <- return (GHCCore.finalizePackageDescription f+ , Right (pkgDesc1,fr) <- [GHCCore.finalizePackageDescription f (GHCCore.dependencySatisfiable pix) (GHCCore.platform) compilerId []- pkgGenericDesc)+ pkgGenericDesc]+ -- drop circular deps and shipped deps+ , let (ad, _sd, _rd) = genSimple (Cabal.buildDepends pkgDesc1)+ , let pkgDesc_filtered_bdeps = pkgDesc1 { Cabal.buildDepends = ad } ] where updateFa :: Cabal.FlagAssignment -> Cabal.FlagAssignment -> Cabal.FlagAssignment@@ -288,9 +290,9 @@ 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)+ liftFlags fs e = let k = foldr (\(y,b) x -> Portage.DependIfUse (Portage.DUse (b, unFlagName y)) . x) (id::Portage.Dependency->Portage.Dependency) fs- in Portage.simplify_deps [k $! Portage.AllOf e]+ in Portage.simplify_deps [k $! Portage.DependAllOf e] genSimple =
Merge/Dependencies.hs view
@@ -76,7 +76,6 @@ import qualified Portage.Overlay as Portage import qualified Portage.PackageId as Portage import qualified Portage.Use as Portage-import qualified Portage.Version as Portage import qualified Cabal2Ebuild as C2E import qualified Portage.GHCCore as GHCCore@@ -155,7 +154,7 @@ pkg_config_libs = pkgConfigDependencies overlay pkg pkg_config_tools = if L.null pkg_config_libs then []- else [Portage.AnyVersionOf (Portage.mkPackageName "virtual" "pkgconfig") Portage.AnySlot []]+ else [any_c_p "virtual" "pkgconfig"] build_tools = buildToolsDependencies pkg ++ pkg_config_tools edeps | treatAsLibrary = mempty@@ -188,7 +187,7 @@ testDependencies :: Portage.Overlay -> PackageDescription -> [Portage.Dependency] testDependencies overlay pkg@(PackageDescription { package = Cabal.PackageIdentifier { Cabal.pkgName = Cabal.PackageName name}}) =- [Portage.DependIfUse (Portage.mkQUse "test") (Portage.AllOf $ Portage.simplify_deps deps)]+ [Portage.DependIfUse (Portage.DUse (True, "test")) (Portage.DependAllOf $ 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'@@ -210,18 +209,14 @@ -- 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 _)) =- head $ C2E.convertDependency overlay+ C2E.convertDependency overlay (Portage.Category "dev-haskell") (Cabal.Dependency (Cabal.PackageName "Cabal") finalCabalDep) where userCabalVersion = Cabal.orLaterVersion (specVersion pkg) shippedCabalVersion = GHCCore.cabalFromGHC versionNumbers- shippedCabalDep = maybe Cabal.anyVersion- (\shipped -> Cabal.intersectVersionRanges- (Cabal.thisVersion shipped)- (Cabal.laterVersion shipped))- shippedCabalVersion+ shippedCabalDep = maybe Cabal.anyVersion Cabal.orLaterVersion shippedCabalVersion finalCabalDep = Cabal.simplifyVersionRange (Cabal.intersectVersionRanges userCabalVersion@@ -233,7 +228,7 @@ compilerIdToDependency :: CompilerId -> Portage.Dependency compilerIdToDependency (CompilerId GHC versionNumbers) =- Portage.OrLaterVersionOf (Portage.fromCabalVersion versionNumbers) (Portage.mkPackageName "dev-lang" "ghc") Portage.AnySlot []+ at_least_c_p_v "dev-lang" "ghc" (Cabal.versionBranch versionNumbers) --------------------------------------------------------------- -- C Libraries@@ -242,7 +237,7 @@ findCLibs :: PackageDescription -> [Portage.Dependency] findCLibs (PackageDescription { library = lib, executables = exes }) = [ 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 [])+ (any_c_p "unknown-c-lib" p) | p <- notFound ] ++ found@@ -254,51 +249,77 @@ notFound = [ p | p <- allE, isNothing (staticTranslateExtraLib p) ] found = [ p | Just p <- map staticTranslateExtraLib allE ] +any_c_p_s_u :: String -> String -> Portage.SlotDepend -> [Portage.UseFlag] -> Portage.Dependency+any_c_p_s_u cat pn slot uses = Portage.Atom (Portage.mkPackageName cat pn)+ (Portage.DRange Portage.ZeroB Portage.InfinityB)+ (Portage.DAttr slot uses)++any_c_p :: String -> String -> Portage.Dependency+any_c_p cat pn = any_c_p_s_u cat pn Portage.AnySlot []++at_least_c_p_v :: String -> String -> [Int] -> Portage.Dependency+at_least_c_p_v cat pn v = Portage.Atom (Portage.mkPackageName cat pn)+ (Portage.DRange (Portage.NonstrictLB (Portage.Version v Nothing [] 0)) Portage.InfinityB)+ (Portage.DAttr Portage.AnySlot [])+ staticTranslateExtraLib :: String -> Maybe Portage.Dependency staticTranslateExtraLib lib = lookup lib m where- m = [ ("z", Portage.AnyVersionOf (Portage.mkPackageName "sys-libs" "zlib") Portage.AnySlot [])- , ("bz2", Portage.AnyVersionOf (Portage.mkPackageName "app-arch" "bzip2") Portage.AnySlot [])- , ("mysqlclient", Portage.LaterVersionOf (Portage.Version [4,0] Nothing [] 0) (Portage.mkPackageName "virtual" "mysql") Portage.AnySlot [])- , ("pq", Portage.LaterVersionOf (Portage.Version [7] Nothing [] 0) (Portage.mkPackageName "dev-db" "postgresql-base") Portage.AnySlot [])- , ("ev", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "libev") Portage.AnySlot [])- , ("expat", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "expat") Portage.AnySlot [])- , ("curl", Portage.AnyVersionOf (Portage.mkPackageName "net-misc" "curl") Portage.AnySlot [])- , ("xml2", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "libxml2") Portage.AnySlot [])- , ("mecab", Portage.AnyVersionOf (Portage.mkPackageName "app-text" "mecab") Portage.AnySlot [])- , ("zmq", Portage.AnyVersionOf (Portage.mkPackageName "net-libs" "zeromq") Portage.AnySlot [])- , ("SDL", Portage.AnyVersionOf (Portage.mkPackageName "media-libs" "libsdl") Portage.AnySlot [])- , ("adns", Portage.AnyVersionOf (Portage.mkPackageName "net-libs" "adns") Portage.AnySlot [])- , ("pcre", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "libpcre") Portage.AnySlot [])- , ("GL", Portage.AnyVersionOf (Portage.mkPackageName "virtual" "opengl") Portage.AnySlot [])- , ("GLU", Portage.AnyVersionOf (Portage.mkPackageName "virtual" "glu") Portage.AnySlot [])- , ("glut", Portage.AnyVersionOf (Portage.mkPackageName "media-libs" "freeglut") Portage.AnySlot [])- , ("X11", Portage.AnyVersionOf (Portage.mkPackageName "x11-libs" "libX11") Portage.AnySlot [])- , ("libzip", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "libzip") Portage.AnySlot [])- , ("ssl", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "openssl") Portage.AnySlot [])- , ("Judy", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "judy") Portage.AnySlot [])- , ("fcgi", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "fcgi") Portage.AnySlot [])- , ("gnutls", Portage.AnyVersionOf (Portage.mkPackageName "net-libs" "gnutls") Portage.AnySlot [])- , ("idn", Portage.AnyVersionOf (Portage.mkPackageName "net-dns" "libidn") Portage.AnySlot [])- , ("tre", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "tre") Portage.AnySlot [])- , ("m", Portage.AnyVersionOf (Portage.mkPackageName "virtual" "libc") Portage.AnySlot [])- , ("asound", Portage.AnyVersionOf (Portage.mkPackageName "media-libs" "alsa-lib") Portage.AnySlot [])- , ("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 [])+ m = [ ("z", any_c_p "sys-libs" "zlib")+ , ("bz2", any_c_p "app-arch" "bzip2")+ , ("mysqlclient", at_least_c_p_v "virtual" "mysql" [4,0])+ , ("pq", at_least_c_p_v "dev-db" "postgresql-base" [7])+ , ("ev", any_c_p "dev-libs" "libev")+ , ("expat", any_c_p "dev-libs" "expat")+ , ("curl", any_c_p "net-misc" "curl")+ , ("xml2", any_c_p "dev-libs" "libxml2")+ , ("mecab", any_c_p "app-text" "mecab")+ , ("zmq", any_c_p "net-libs" "zeromq")+ , ("SDL", any_c_p "media-libs" "libsdl")+ , ("adns", any_c_p "net-libs" "adns")+ , ("pcre", any_c_p "dev-libs" "libpcre")+ , ("GL", any_c_p "virtual" "opengl")+ , ("GLU", any_c_p "virtual" "glu")+ , ("glut", any_c_p "media-libs" "freeglut")+ , ("X11", any_c_p "x11-libs" "libX11")+ , ("libzip", any_c_p "dev-libs" "libzip")+ , ("ssl", any_c_p "dev-libs" "openssl")+ , ("Judy", any_c_p "dev-libs" "judy")+ , ("fcgi", any_c_p "dev-libs" "fcgi")+ , ("gnutls", any_c_p "net-libs" "gnutls")+ , ("idn", any_c_p "net-dns" "libidn")+ , ("tre", any_c_p "dev-libs" "tre")+ , ("m", any_c_p "virtual" "libc")+ , ("asound", any_c_p "media-libs" "alsa-lib")+ , ("sqlite3", at_least_c_p_v "dev-db" "sqlite" [3,0])+ , ("stdc++", any_c_p_s_u "sys-devel" "gcc" Portage.AnySlot [Portage.mkUse "cxx"])+ , ("crack", any_c_p "sys-libs" "cracklib")+ , ("exif", any_c_p "media-libs" "libexif")+ , ("IL", any_c_p "media-libs" "devil")+ , ("Imlib2", any_c_p "media-libs" "imlib2")+ , ("pcap", any_c_p "net-libs" "libpcap")+ , ("lber", any_c_p "net-nds" "openldap")+ , ("ldap", any_c_p "net-nds" "openldap")+ , ("expect", any_c_p "dev-tcltk" "expect")+ , ("tcl", any_c_p "dev-lang" "tcl")+ , ("Xext", any_c_p "x11-libs" "libXext")+ , ("Xrandr", any_c_p "x11-libs" "libXrandr")+ , ("crypto", any_c_p "dev-libs" "openssl")+ , ("gmp", any_c_p "dev-libs" "gmp")+ , ("fuse", any_c_p "sys-fs" "fuse")+ , ("zip", any_c_p "dev-libs" "libzip")+ , ("QtCore", any_c_p "dev-qt" "qtcore")+ , ("QtGui", any_c_p "dev-qt" "qtgui")+ , ("QtOpenGL", any_c_p "dev-qt" "qtopengl")+ , ("gsl", any_c_p "sci-libs" "gsl")+ , ("gslcblas", any_c_p "sci-libs" "gsl")+ , ("mkl_core", any_c_p "sci-libs" "mkl")+ , ("mkl_intel_lp64", any_c_p "sci-libs" "mkl")+ , ("mkl_lapack", any_c_p "sci-libs" "mkl")+ , ("mkl_sequential", any_c_p "sci-libs" "mkl")+ , ("Xi", any_c_p "x11-libs" "libXi")+ , ("Xxf86vm", any_c_p "x11-libs" "libXxf86vm")+ , ("pthread", any_c_p "virtual" "libc") ] ---------------------------------------------------------------@@ -310,9 +331,9 @@ [ case pkg of Just p -> p Nothing -> trace ("WARNING: Unknown build tool '" ++ pn ++ "'. Check the generated ebuild.")- (Portage.AnyVersionOf (Portage.mkPackageName "unknown-build-tool" pn) Portage.AnySlot [])+ (any_c_p "unknown-build-tool" pn) | Cabal.Dependency (Cabal.PackageName pn) _range <- cabalDeps- , pkg <- return (lookup pn buildToolsTable) + , pkg <- return (lookup pn buildToolsTable) ] where cabalDeps = filter notProvided $ depL ++ depE@@ -322,14 +343,15 @@ buildToolsTable :: [(String, Portage.Dependency)] buildToolsTable =- [ ("happy", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "happy") Portage.AnySlot [])- , ("alex", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "alex") Portage.AnySlot [])- , ("c2hs", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "c2hs") Portage.AnySlot [])- , ("cabal-install", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "cabal-install") Portage.AnySlot [])- , ("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 [])+ [ ("happy", any_c_p "dev-haskell" "happy")+ , ("alex", any_c_p "dev-haskell" "alex")+ , ("c2hs", any_c_p "dev-haskell" "c2hs")+ , ("cabal-install", any_c_p "dev-haskell" "cabal-install")+ , ("gtk2hsTypeGen", any_c_p "dev-haskell" "gtk2hs-buildtools")+ , ("gtk2hsHookGenerator", any_c_p "dev-haskell" "gtk2hs-buildtools")+ , ("gtk2hsC2hs", any_c_p "dev-haskell" "gtk2hs-buildtools")+ , ("cabal", any_c_p "dev-haskell" "cabal-install")+ , ("llvm-config", any_c_p "sys-devel" "llvm") ] -- tools that are provided by ghc or some other existing program@@ -354,16 +376,16 @@ [ case resolvePkgConfig overlay pkg of Just d -> d Nothing -> trace ("WARNING: Could not resolve pkg-config: " ++ pn ++ ". Check generated ebuild.")- (Portage.AnyVersionOf (Portage.mkPackageName "unknown-pkg-config" pn) Portage.AnySlot [])+ (any_c_p "unknown-pkg-config" pn) | pkg@(Cabal.Dependency (Cabal.PackageName pn) _range) <- cdeps ] resolvePkgConfig :: Portage.Overlay -> Cabal.Dependency -> Maybe Portage.Dependency resolvePkgConfig _overlay (Cabal.Dependency (Cabal.PackageName pn) _cabalVersion) = do- (cat,portname, slot) <- lookup pn table- return $ Portage.AnyVersionOf (Portage.mkPackageName cat portname) slot []+ (cat,portname, slot) <- lookup pn pkgconfig_table+ return $ any_c_p_s_u cat portname slot [] -table :: [(String, (String, String, Portage.SlotDepend))]-table =+pkgconfig_table :: [(String, (String, String, Portage.SlotDepend))]+pkgconfig_table = [ ("alsa", ("media-libs", "alsa-lib", Portage.AnySlot)) ,("gconf-2.0", ("gnome-base", "gconf", Portage.AnySlot))@@ -430,4 +452,5 @@ ,("libidn", ("net-dns", "libidn", Portage.AnySlot)) ,("libxml-2.0", ("dev-libs", "libxml2", Portage.AnySlot)) ,("yaml-0.1", ("dev-libs", "libyaml", Portage.AnySlot))+ ,("QtCore", ("dev-qt", "qtcore", Portage.AnySlot)) ]
Portage/Dependency.hs view
@@ -1,170 +1,48 @@ module Portage.Dependency- ( Dependency(..)- , SlotDepend(..)- , simplify_deps+ (+ simplify_deps , simplifyUseDeps- , addDepUseFlag- , setSlotDep , sortDeps- ) where -import Portage.Version-import Portage.Use-import Distribution.Text ( display, Text(..) )--import Portage.PackageId--import qualified Text.PrettyPrint as Disp-import Text.PrettyPrint ( (<>), hsep )+ -- reexports+ , module Portage.Dependency.Builder+ , module Portage.Dependency.Print+ , module Portage.Dependency.Types+ ) where import Data.Function ( on )-import Data.Maybe ( fromJust, catMaybes, mapMaybe )-import Data.List ( nub, groupBy, partition, sortBy, sort )-import Data.Ord (comparing, Ordering(..))--data SlotDepend = AnySlot -- nothing special- | AnyBuildTimeSlot -- ':='- | GivenSlot String -- ':slotno'- deriving (Eq, Show)--dispSlot :: SlotDepend -> Disp.Doc-dispSlot AnySlot = Disp.empty-dispSlot AnyBuildTimeSlot = Disp.text ":="-dispSlot (GivenSlot slot) = Disp.text (':' : slot)--data Dependency = AnyVersionOf PackageName SlotDepend [UseFlag]- | ThisVersionOf Version PackageName SlotDepend [UseFlag] -- ~package-version- | LaterVersionOf Version PackageName SlotDepend [UseFlag] -- >package-version- | EarlierVersionOf Version PackageName SlotDepend [UseFlag] -- <package-version- | OrLaterVersionOf Version PackageName SlotDepend [UseFlag] -- >=package-version- | OrEarlierVersionOf Version PackageName SlotDepend [UseFlag] -- <=package-version- | ThisMajorOf Version PackageName SlotDepend [UseFlag] -- =package-version*- | DependIfUse UseFlag Dependency -- use? ( depend )- | DependEither [Dependency] -- || ( depend1 depend2 ... )- | AllOf [Dependency] -- ( depend1 depend2 ... )- deriving (Eq,Show)--instance Text Dependency where- disp = showDepend--(<->) :: Disp.Doc -> Disp.Doc -> Disp.Doc-a <-> b = a <> Disp.char '-' <> b--showDepend :: Dependency -> Disp.Doc-showDepend (AnyVersionOf p s u) = disp p <> dispSlot s <> dispUses u-showDepend (ThisVersionOf v p s u) = Disp.char '~' <> disp p <-> disp v { versionRevision = 0 } <> dispSlot s <> dispUses u-showDepend (LaterVersionOf v p s u) = Disp.char '>' <> disp p <-> disp v <> dispSlot s <> dispUses u-showDepend (EarlierVersionOf v p s u) = Disp.char '<' <> disp p <-> disp v <> dispSlot s <> dispUses u-showDepend (OrLaterVersionOf v p s u) = Disp.text ">=" <> disp p <-> disp v <> dispSlot s <> dispUses u-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- where -- special case to avoid double braces: test? ( ( ) )- pp_deps (AllOf _) = disp dep- pp_deps _ = Disp.parens (Disp.text " " <> disp dep <> Disp.text " ")-showDepend (AllOf []) = Disp.empty-showDepend (AllOf (d:dp) ) =- Disp.text "( " <> showDepend d <> line- <> Disp.hcat (map (\x -> Disp.text "\t\t\t" <> (showDepend x) <> line) dp)- <> Disp.text "\t\t)"- where line = Disp.char '\n'--{- Here goes code for dependencies simplification -}--simplify_group_table :: PackageName ->- SlotDepend ->- [UseFlag] ->- Maybe Version ->- Maybe Version ->- Maybe Version ->- Maybe Version ->- Maybe Version -> [Dependency]---- simplify_group_table p ol l e oe exact--- 1) trivial cases:-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]-simplify_group_table p s u Nothing Nothing Nothing (Just v) Nothing = [OrEarlierVersionOf v p s u]-simplify_group_table p s u Nothing Nothing Nothing Nothing (Just v) = [ThisVersionOf v p s u]---- 2) simplification passes-simplify_group_table p s u (Just (Version v1 _ _ _)) Nothing (Just (Version v2 _ _ _)) Nothing Nothing- -- special case: >=a-v.N a<v.(N+1) => =a-v.N*- | (init v1 == init v2) && (last v2 == last v1 + 1) = [ThisMajorOf (Version v1 Nothing [] 0) p s u]- | otherwise = [OrLaterVersionOf (Version v1 Nothing [] 0) p s u, EarlierVersionOf (Version v2 Nothing [] 0) p s u]---- TODO: simplify constraints of type: >=a-v1; > a-v2 and such---- 3) otherwise sink:-simplify_group_table p s u (Just v) l@(_) e@(_) oe@(_) exact@(_) = OrLaterVersionOf v p s u: simplify_group_table p s u Nothing l e oe exact-simplify_group_table p s u ol@(Nothing) (Just v) e@(_) oe@(_) exact@(_) = LaterVersionOf v p s u: simplify_group_table p s u ol Nothing e oe exact-simplify_group_table p s u ol@(Nothing) l@(Nothing) (Just v) oe@(_) exact@(_) = EarlierVersionOf v p s u: simplify_group_table p s u ol l Nothing oe exact-simplify_group_table p s u ol@(Nothing) l@(Nothing) e@(Nothing) (Just v) exact@(_) = OrEarlierVersionOf v p s u: simplify_group_table p s u ol l e Nothing exact--- already defined earlier--- simplify_group_table p s u ol@(Nothing) l@(Nothing) e@(Nothing) oe@(Nothing) (Just v) = OrEarlierVersionOf v p : simplify_group_table p ol l e oe Nothing---- >a-v1 >a-v2 => >a-(max v1 v2)--- key idea: all constraints are enforcing constraints, so we can't get--- more, than one interval.-simplify_group :: [Dependency] -> [Dependency]-simplify_group [dep@(AnyVersionOf _package _s _u)] = [dep]-simplify_group [dep@(ThisMajorOf _v _p _s _u)] = [dep]+import Data.List ( nub, groupBy, partition, sortBy )+import Data.Maybe ( fromJust, mapMaybe )+import Data.Ord ( comparing ) --- "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- min_or_later_v -- >=- min_later_v -- >- max_earlier_v -- <- max_or_earlier_v -- <=- exact_this_v -- ==- where- package = fromJust.getPackage $ head deps- slot = fromJust.getSlot $ head deps- uses = fromJust.getUses $ head deps- max_earlier_v = safe_minimum $ map earlier_v deps- max_or_earlier_v = safe_minimum $ map or_earlier_v deps- min_later_v = safe_maximum $ map later_v deps- min_or_later_v = safe_maximum $ map or_later_v deps- exact_this_v = case catMaybes (map this_v deps) of- [] -> Nothing- [v] -> Just v- xs -> error $ "too many exact versions:" ++ show xs- --- earlier_v (EarlierVersionOf v _p _s _u) = Just v- earlier_v _ = Nothing+import Portage.PackageId - or_earlier_v (OrEarlierVersionOf v _p _s _u) = Just v- or_earlier_v _ = Nothing+import Portage.Dependency.Builder+import Portage.Dependency.Print+import Portage.Dependency.Types - later_v (LaterVersionOf v _p _s _u) = Just v- later_v _ = Nothing+mergeDRanges :: DRange -> DRange -> DRange+mergeDRanges _ r@(DExact _) = r+mergeDRanges l@(DExact _) _ = l+mergeDRanges (DRange ll lu) (DRange rl ru) = DRange (max ll rl) (min lu ru) - or_later_v (OrLaterVersionOf v _p _s _u) = Just v- or_later_v _ = Nothing+merge_pair :: Dependency -> Dependency -> Dependency+merge_pair (Atom lp ld la) (Atom rp rd ra)+ | lp /= rp = error "merge_pair got different 'PackageName's"+ | la /= ra = error "merge_pair got different 'DAttr's"+ | otherwise = Atom lp (mergeDRanges ld rd) la+merge_pair l r = error $ unwords ["merge_pair can't merge non-atoms:", show l, show r] - this_v (ThisVersionOf v _p _s _u) = Just v- this_v _ = Nothing- --- safe_minimum xs = case catMaybes xs of- [] -> Nothing- xs' -> Just $ minimum xs'- safe_maximum xs = case catMaybes xs of- [] -> Nothing- xs' -> Just $ maximum xs'+-- TODO: remove it in favour of more robust 'normalize_depend'+simplify_group :: [Dependency] -> Dependency+simplify_group [x] = x+simplify_group xs = foldl1 merge_pair xs +-- TODO: remove it in favour of more robust 'normalize_depend' -- divide packages to groups (by package name), simplify groups, merge again simplify_deps :: [Dependency] -> [Dependency] simplify_deps deps = flattenDep $ - (concatMap (simplify_group.nub) $+ (map (simplify_group.nub) $ groupBy cmpPkgName $ sortBy (comparing getPackagePart) groupable) ++ ungroupable@@ -176,76 +54,19 @@ -- flattenDep :: [Dependency] -> [Dependency] flattenDep [] = []- flattenDep (AllOf ds:xs) = (concatMap (\x -> flattenDep [x]) ds) ++ flattenDep xs+ flattenDep (DependAllOf 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-getPackage (ThisVersionOf _version package _s _uses) = Just package-getPackage (LaterVersionOf _version package _s _uses) = Just package-getPackage (EarlierVersionOf _version package _s _uses) = Just package-getPackage (OrLaterVersionOf _version package _s _uses) = Just package-getPackage (OrEarlierVersionOf _version package _s _uses) = Just package-getPackage (ThisMajorOf _version package _s _uses) = Just package-getPackage (DependEither _dependency ) = Nothing+getPackage (DependAllOf _dependency) = Nothing+getPackage (Atom pn _dr _attrs) = Just pn+getPackage (DependAnyOf _dependency ) = Nothing getPackage (DependIfUse _useFlag _Dependency) = Nothing -getUses :: Dependency -> Maybe [UseFlag]-getUses (AllOf _d) = Nothing-getUses (AnyVersionOf _p _s u) = Just u-getUses (ThisVersionOf _v _p _s u) = Just u-getUses (LaterVersionOf _v _p _s u) = Just u-getUses (EarlierVersionOf _v _p _s u) = Just u-getUses (OrLaterVersionOf _v _p _s u) = Just u-getUses (OrEarlierVersionOf _v _p _s u) = Just u-getUses (ThisMajorOf _v _p _s u) = Just u-getUses (DependEither _d) = Nothing-getUses (DependIfUse _u _d) = Nothing--getSlot :: Dependency -> Maybe SlotDepend-getSlot (AllOf _d) = Nothing-getSlot (AnyVersionOf _p s _u) = Just s-getSlot (ThisVersionOf _v _p s _u) = Just s-getSlot (LaterVersionOf _v _p s _u) = Just s-getSlot (EarlierVersionOf _v _p s _u) = Just s-getSlot (OrLaterVersionOf _v _p s _u) = Just s-getSlot (OrEarlierVersionOf _v _p s _u) = Just s-getSlot (ThisMajorOf _v _p s _u) = Just s-getSlot (DependEither _d) = Nothing-getSlot (DependIfUse _u _d) = Nothing---- getPackagePart :: Dependency -> PackageName getPackagePart dep = fromJust (getPackage dep) ----setSlotDep :: SlotDepend -> Dependency -> Dependency-setSlotDep n (AllOf d) = AllOf $ map (setSlotDep n) d-setSlotDep n (AnyVersionOf p _s u) = AnyVersionOf p n u-setSlotDep n (ThisVersionOf v p _s u) = ThisVersionOf v p n u-setSlotDep n (LaterVersionOf v p _s u) = LaterVersionOf v p n u-setSlotDep n (EarlierVersionOf v p _s u) = EarlierVersionOf v p n u-setSlotDep n (OrLaterVersionOf v p _s u) = OrLaterVersionOf v p n u-setSlotDep n (OrEarlierVersionOf v p _s u) = OrEarlierVersionOf v p n u-setSlotDep n (ThisMajorOf v p _s u) = ThisMajorOf v p n u-setSlotDep n (DependEither d) = DependEither $ map (setSlotDep n) d-setSlotDep n (DependIfUse u d) = DependIfUse u (setSlotDep n d)--addDepUseFlag :: UseFlag -> Dependency -> Dependency-addDepUseFlag n (AllOf d) = AllOf $ map (addDepUseFlag n) d-addDepUseFlag n (AnyVersionOf p s u) = AnyVersionOf p s (n:u)-addDepUseFlag n (ThisVersionOf v p s u) = ThisVersionOf v p s (n:u)-addDepUseFlag n (LaterVersionOf v p s u) = LaterVersionOf v p s (n:u)-addDepUseFlag n (EarlierVersionOf v p s u) = EarlierVersionOf v p s (n:u)-addDepUseFlag n (OrLaterVersionOf v p s u) = OrLaterVersionOf v p s (n:u)-addDepUseFlag n (OrEarlierVersionOf v p s u) = OrEarlierVersionOf v p s (n:u)-addDepUseFlag n (ThisMajorOf v p s u) = ThisMajorOf v p s (n:u)-addDepUseFlag n (DependEither d) = DependEither $ map (addDepUseFlag n) d-addDepUseFlag n (DependIfUse u d) = DependIfUse u (addDepUseFlag n d)---- -- | remove all Use dependencies that overlap with normal dependencies simplifyUseDeps :: [Dependency] -- list where use deps is taken -> [Dependency] -- list where common deps is taken@@ -257,12 +78,12 @@ intersectD :: [PackageName] -> Dependency -> Maybe Dependency intersectD fs (DependIfUse u d) = intersectD fs d >>= Just . DependIfUse u-intersectD fs (DependEither ds) =+intersectD fs (DependAnyOf ds) = let ds' = mapMaybe (intersectD fs) ds- in if null ds' then Nothing else Just (DependEither ds')-intersectD fs (AllOf ds) =+ in if null ds' then Nothing else Just (DependAnyOf ds')+intersectD fs (DependAllOf ds) = let ds' = mapMaybe (intersectD fs) ds- in if null ds' then Nothing else Just (AllOf ds')+ in if null ds' then Nothing else Just (DependAllOf ds') intersectD fs x = let pkg = fromJust $ getPackage x -- this is unsafe but will save from error later in if any (==pkg) fs then Nothing else Just x@@ -277,22 +98,22 @@ 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 (DependAllOf ds) = DependAllOf $ sortDeps ds+ deeper (DependAnyOf ds) = DependAnyOf $ 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 _ _) (DependAnyOf _) = LT+ dsort (DependIfUse _ _) (DependAllOf _) = 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 (DependAnyOf _) (DependAnyOf _) = EQ+ dsort (DependAnyOf _) (DependIfUse _ _) = GT+ dsort (DependAnyOf _) (DependAllOf _) = LT+ dsort (DependAnyOf _) _ = GT+ dsort (DependAllOf _) (DependAllOf _) = EQ+ dsort (DependAllOf _) (DependIfUse _ _) = LT+ dsort (DependAllOf _) (DependAnyOf _) = GT dsort _ (DependIfUse _ _) = LT- dsort _ (AllOf _) = LT- dsort _ (DependEither _) = LT+ dsort _ (DependAllOf _) = LT+ dsort _ (DependAnyOf _) = LT dsort a b = (compare `on` getPackage) a b
+ Portage/Dependency/Builder.hs view
@@ -0,0 +1,25 @@+{- | Basic helpers to build depend structures -}+module Portage.Dependency.Builder+ (+ empty_dependency+ , addDepUseFlag+ , setSlotDep+ ) where++import Portage.Dependency.Types+import Portage.Use++empty_dependency :: Dependency+empty_dependency = DependAllOf []++addDepUseFlag :: UseFlag -> Dependency -> Dependency+addDepUseFlag n (DependAllOf d) = DependAllOf $ map (addDepUseFlag n) d+addDepUseFlag n (Atom pn dr (DAttr s u)) = Atom pn dr (DAttr s (n:u))+addDepUseFlag n (DependAnyOf d) = DependAnyOf $ map (addDepUseFlag n) d+addDepUseFlag n (DependIfUse u d) = DependIfUse u (addDepUseFlag n d)++setSlotDep :: SlotDepend -> Dependency -> Dependency+setSlotDep n (DependAllOf d) = DependAllOf $ map (setSlotDep n) d+setSlotDep n (Atom pn dr (DAttr _s u)) = Atom pn dr (DAttr n u)+setSlotDep n (DependAnyOf d) = DependAnyOf $ map (setSlotDep n) d+setSlotDep n (DependIfUse u d) = DependIfUse u (setSlotDep n d)
+ Portage/Dependency/Normalize.hs view
@@ -0,0 +1,261 @@+module Portage.Dependency.Normalize+ (+ normalize_depend+ ) where++import qualified Data.List as L++import Portage.Dependency.Types++mergeDRanges :: DRange -> DRange -> DRange+mergeDRanges _ r@(DExact _) = r+mergeDRanges l@(DExact _) _ = l+mergeDRanges (DRange ll lu) (DRange rl ru) = DRange (max ll rl) (min lu ru)++-- TODO: remove it and switch to 'SatisfiedDepend' instead+empty_dependency :: Dependency+empty_dependency = DependAllOf []++is_empty_dependency :: Dependency -> Bool+is_empty_dependency (DependIfUse _use dep) = is_empty_dependency dep+is_empty_dependency (DependAnyOf []) = True -- because any (const True) == False+is_empty_dependency (DependAnyOf deps) = any is_empty_dependency deps+is_empty_dependency (DependAllOf deps) = all is_empty_dependency deps+is_empty_dependency (Atom _pn _dr _dattr) = False++-- remove one layer of redundancy+normalization_step :: Dependency -> Dependency+normalization_step = combine_atoms+ . propagate_context+ . flatten+ . lift_context+ . remove_duplicates+ . remove_empty+ . sort_deps+ . combine_use_guards+ . combine_use_counterguards++remove_empty :: Dependency -> Dependency+remove_empty d =+ case d of+ -- drop full empty nodes+ _ | is_empty_dependency d -> empty_dependency+ -- drop partial empty nodes+ (DependIfUse use dep) -> DependIfUse use $ remove_empty dep+ (DependAllOf deps) -> DependAllOf $ filter (not . is_empty_dependency) $ map remove_empty deps+ (DependAnyOf deps) -> DependAnyOf $ map remove_empty deps+ -- no change+ (Atom _pn _dr _dattr) -> d++-- Ideally 'combine_atoms' should handle those as well+remove_duplicates :: Dependency -> Dependency+remove_duplicates d =+ case d of+ (DependIfUse use dep) -> (DependIfUse use $ remove_duplicates dep)+ (DependAnyOf deps) -> DependAnyOf $ L.nub $ map remove_duplicates deps+ (DependAllOf deps) -> DependAllOf $ L.nub $ map remove_duplicates deps+ (Atom _pn _dr _dattr) -> d++-- TODO: implement flattening (if not done yet in other phases)+-- DependAnyOf [DependAnyOf [something], rest] -> DependAnyOf $ something ++ rest+-- DependAllOf [DependAllOf [something], rest] -> DependAllOf $ something ++ rest+flatten :: Dependency -> Dependency+flatten d =+ case d of+ (DependIfUse use dep) -> DependIfUse use (flatten dep)+ (DependAnyOf [dep]) -> flatten dep+ (DependAllOf [dep]) -> flatten dep+ (DependAnyOf deps) -> DependAnyOf $ map flatten deps+ (DependAllOf deps) -> DependAllOf $ map flatten deps+ (Atom _pn _dr _dattr) -> d++-- TODO: join atoms with different version constraints+-- DependAllOf [ DRange ">=foo-1" Inf, Drange Zero "<foo-2" ] -> DRange ">=foo-1" "<foo-2"+combine_atoms :: Dependency -> Dependency+combine_atoms d =+ case d of+ (DependIfUse use dep) -> DependIfUse use (combine_atoms dep)+ (DependAllOf deps) -> DependAllOf $ map combine_atoms $ find_intersections deps+ (DependAnyOf deps) -> DependAnyOf $ map combine_atoms $ find_concatenations deps+ (Atom _pn _dr _dattr) -> d++find_intersections :: [Dependency] -> [Dependency]+find_intersections = map merge_depends . L.groupBy is_mergeable+ where is_mergeable :: Dependency -> Dependency -> Bool+ is_mergeable (Atom lpn _ldrange lattr) (Atom rpn _rdrange rattr) = (lpn, lattr) == (rpn, rattr)+ is_mergeable _ _ = False++ merge_depends :: [Dependency] -> Dependency+ merge_depends [x] = x+ merge_depends xs = foldl1 merge_pair xs++ merge_pair :: Dependency -> Dependency -> Dependency+ merge_pair (Atom lp ld la) (Atom rp rd ra)+ | lp /= rp = error "merge_pair got different 'PackageName's"+ | la /= ra = error "merge_pair got different 'DAttr's"+ | otherwise = Atom lp (mergeDRanges ld rd) la+ merge_pair l r = error $ unwords ["merge_pair can't merge non-atoms:", show l, show r]++-- TODO+find_concatenations :: [Dependency] -> [Dependency]+find_concatenations = id++-- Eliminate use guarded redundancy:+-- a? ( foo )+-- a? ( bar )+-- gets translated to+-- a? ( foo bar )+combine_use_guards :: Dependency -> Dependency+combine_use_guards d =+ case d of+ (DependIfUse use dep) -> DependIfUse use (combine_use_guards dep)+ (DependAllOf deps) -> DependAllOf $ map combine_use_guards $ find_use_intersections deps+ (DependAnyOf deps) -> DependAnyOf $ map combine_use_guards $ find_use_concatenations deps+ (Atom _pn _dr _dattr) -> d+ where -- TODO+ find_use_concatenations :: [Dependency] -> [Dependency]+ find_use_concatenations = id+ find_use_intersections :: [Dependency] -> [Dependency]+ find_use_intersections = map merge_use_intersections . L.groupBy is_use_mergeable+ where+ is_use_mergeable :: Dependency -> Dependency -> Bool+ is_use_mergeable (DependIfUse lu _ld) (DependIfUse ru _rd)+ | lu == ru = True+ is_use_mergeable _ _ = False+ merge_use_intersections :: [Dependency] -> Dependency+ merge_use_intersections [x] = x+ merge_use_intersections ~(DependIfUse u dep : ds) = DependIfUse u $ DependAllOf (dep : [d' | (DependIfUse _u d') <- ds])++-- Eliminate use guarded redundancy:+-- a? ( foo bar )+-- !a? ( foo baz )+-- gets translated to+-- foo+-- a? ( bar )+-- !a? ( baz )+combine_use_counterguards :: Dependency -> Dependency+combine_use_counterguards d =+ case d of+ (DependIfUse use dep) -> DependIfUse use (combine_use_counterguards dep)+ (DependAllOf deps) -> DependAllOf $ map combine_use_counterguards $ find_use_intersections deps+ (DependAnyOf deps) -> DependAnyOf $ map combine_use_counterguards $ find_use_concatenations deps+ (Atom _pn _dr _dattr) -> d+ where -- TODO+ find_use_concatenations :: [Dependency] -> [Dependency]+ find_use_concatenations = id+ find_use_intersections :: [Dependency] -> [Dependency]+ find_use_intersections = concatMap merge_use_intersections . L.groupBy is_counteruse_mergeable+ where+ is_counteruse_mergeable :: Dependency -> Dependency -> Bool+ is_counteruse_mergeable (DependIfUse (DUse (lb,lu)) _ld) (DependIfUse (DUse (rb, ru)) _rd)+ -- lookup 'a?' and '!a?'+ | lu == ru && lb == not rb = True+ is_counteruse_mergeable _ _ = False+ merge_use_intersections :: [Dependency] -> [Dependency]+ merge_use_intersections [(DependIfUse _lu ld), (DependIfUse _ru rd)]+ -- very simple special case,+ -- as we can't look through nested use guards+ | ld == rd = [ld]+ merge_use_intersections deps@[(DependIfUse _lu ld), (DependIfUse _ru rd)] =+ case common_ctx of+ [] -> deps+ _ -> [propagate_context $ DependAllOf $ common_ctx ++ deps ]+ where ld_ctx = lift_context' ld+ rd_ctx = lift_context' rd+ common_ctx = ld_ctx `L.intersect` rd_ctx+ merge_use_intersections x = x++-- Eliminate top-down redundancy:+-- foo/bar+-- u? ( foo/bar+-- bar/baz )+-- gets translated to+-- foo/bar+-- u? ( bar/baz )+propagate_context :: Dependency -> Dependency+propagate_context = propagate_context' []++-- very simple model: pick all sibling-atom deps and add them to context+-- for downward proparation and remove from 'all_of' part+-- TODO: any-of part can benefit from it by removing unsatisfiable or satisfied alternative+-- TODO: remove use-guarded redundancy+-- a? ( x y z )+-- test? ( a? ( y z t ) )+-- can be reduced to+-- a? ( x y z )+-- test? ( a? ( t ) )+propagate_context' :: [Dependency] -> Dependency -> Dependency+propagate_context' ctx d =+ case d of+ (DependIfUse use dep) -> DependIfUse use (go ctx dep)+ (DependAllOf deps) -> DependAllOf $ [ go ctx' dep+ | dep <- deps+ , let atom_deps = [ a+ | a@(Atom _pn _dp _dattr) <- deps+ , a /= dep ]+ , let ctx' = ctx ++ atom_deps+ ]+ (DependAnyOf deps) -> DependAnyOf $ map (go ctx) deps+ -- 'd' is already satisfied by 'ctx' constraint+ (Atom _pn _dr _dattr) -> case any (\ctx_e -> ctx_e `dep_is_case_of` d) ctx of+ True -> empty_dependency+ False -> d+ where go c = propagate_context' c++-- Eliminate bottom-up redundancy:+-- || ( ( foo/bar bar/baz )+-- ( foo/bar bar/quux ) )+-- gets translated to+-- foo/bar+-- || ( ( foo/bar bar/baz )+-- ( foo/bar bar/quux ) )+-- It looks like became more gross,+-- but 'propagate_context' phase+-- cleanups it to the following state:+-- foo/bar+-- || ( bar/baz+-- bar/quux )++lift_context :: Dependency -> Dependency+lift_context d =+ case d of+ (DependIfUse _use _dep) -> d+ (DependAllOf deps) -> DependAllOf $ deps ++ (new_ctx L.\\ deps)+ -- the lift itself+ (DependAnyOf _deps) -> case L.null new_ctx of+ True -> d -- nothing is shared downwards+ False -> propagate_context $ DependAllOf $ new_ctx ++ [d]+ (Atom _pn _dr _dattr) -> d+ where new_ctx = lift_context' d++-- very simple model: pick all sibling-atom deps and add them to context+-- for upward proparation and intersect with 'all_of' parts+lift_context' :: Dependency -> [Dependency]+lift_context' d =+ case d of+ (DependIfUse _use _dep) -> []+ (DependAllOf deps) -> [dep | dep@(Atom _pn _dr _dattr) <- deps]+ (DependAnyOf deps) -> case map lift_context' deps of+ [] -> []+ ctxes -> foldl1 L.intersect ctxes+ (Atom _pn _dr _dattr) -> [d]++-- reorders depends to make them more attractive+-- for other normalization algorithms+-- TODO: add all logic from 'sortDeps' here+sort_deps :: Dependency -> Dependency+sort_deps d =+ case d of+ (DependIfUse lhs (DependIfUse rhs dep))+ | rhs < lhs -> DependIfUse rhs $ sort_deps $ DependIfUse lhs dep+ (DependIfUse use dep) -> DependIfUse use $ sort_deps dep+ (DependAnyOf deps) -> DependAnyOf $ map sort_deps deps+ (DependAllOf deps) -> DependAllOf $ map sort_deps deps+ (Atom _pn _dr _dattr) -> d++-- remove various types of redundancy+normalize_depend :: Dependency -> Dependency+normalize_depend d = next_step next_d+ where next_d = normalization_step d+ next_step | d == next_d = id+ | otherwise = normalize_depend
+ Portage/Dependency/Print.hs view
@@ -0,0 +1,87 @@+module Portage.Dependency.Print+ (+ dep2str+ , dep2str_denorm -- for debugging+ ) where++import Portage.Version+import Portage.Use++import Portage.PackageId++import Distribution.Text ( Text(..) )+import qualified Text.PrettyPrint as Disp+import Text.PrettyPrint ( (<>), vcat, nest, render )++import Portage.Dependency.Normalize+import Portage.Dependency.Types++dispSlot :: SlotDepend -> Disp.Doc+dispSlot AnySlot = Disp.empty+dispSlot AnyBuildTimeSlot = Disp.text ":="+dispSlot (GivenSlot slot) = Disp.text (':' : slot)++dispLBound :: PackageName -> LBound -> Disp.Doc+dispLBound pn (StrictLB v) = Disp.char '>' <> disp pn <-> disp v+dispLBound pn (NonstrictLB v) = Disp.text ">=" <> disp pn <-> disp v+dispLBound _pn ZeroB = error "unhandled 'dispLBound ZeroB'"++dispUBound :: PackageName -> UBound -> Disp.Doc+dispUBound pn (StrictUB v) = Disp.char '<' <> disp pn <-> disp v+dispUBound pn (NonstrictUB v) = Disp.text "<=" <> disp pn <-> disp v+dispUBound _pn InfinityB = error "unhandled 'dispUBound Infinity'"++dispDAttr :: DAttr -> Disp.Doc+dispDAttr (DAttr s u) = dispSlot s <> dispUses u++dispDUse :: DUse -> Disp.Doc+dispDUse (DUse (is_enabled, name)) = prefix is_enabled <> Disp.text name <> Disp.char '?'+ where prefix True = Disp.empty+ prefix False = Disp.char '!'++dep2str :: Int -> Dependency -> String+dep2str start_indent = render . nest start_indent . showDepend . normalize_depend++dep2str_denorm :: Dependency -> String+dep2str_denorm = render . showDepend++(<->) :: Disp.Doc -> Disp.Doc -> Disp.Doc+a <-> b = a <> Disp.char '-' <> b++sp :: Disp.Doc+sp = Disp.char ' '++sparens :: Disp.Doc -> Disp.Doc+sparens doc = Disp.parens (sp <> valign doc <> sp)++valign :: Disp.Doc -> Disp.Doc+valign d = nest 0 d++showDepend :: Dependency -> Disp.Doc+showDepend (Atom pn range dattr)+ = case range of+ -- any version+ DRange ZeroB InfinityB -> disp pn <> dispDAttr dattr+ DRange ZeroB ub -> dispUBound pn ub <> dispDAttr dattr+ DRange lb InfinityB -> dispLBound pn lb <> dispDAttr dattr+ -- TODO: handle >=foo-0 special case+ -- TODO: handle =foo-x.y.* special case+ DRange lb ub -> showDepend (Atom pn (DRange lb InfinityB) dattr)+ <> Disp.char ' '+ <> showDepend (Atom pn (DRange ZeroB ub) dattr)+ DExact v -> Disp.char '~' <> disp pn <-> disp v { versionRevision = 0 } <> dispDAttr dattr++showDepend (DependIfUse u dep) = dispDUse u <> sp <> sparens (showDepend dep)+showDepend (DependAnyOf deps) = Disp.text "||" <> sp <> sparens (vcat $ map showDependInAnyOf deps)+showDepend (DependAllOf deps) = valign $ vcat $ map showDepend deps++-- needs special grouping+showDependInAnyOf :: Dependency -> Disp.Doc+showDependInAnyOf d@(DependAllOf _deps) = sparens (showDepend d)+-- both lower and upper bounds are present thus needs 2 atoms+-- TODO: '=foo-x.y.*' will take only one atom, not two+showDependInAnyOf d@(Atom _pn (DRange lb ub) _dattr)+ | lb /= ZeroB && ub /= InfinityB+ = sparens (showDepend d)+-- rest are fine+showDependInAnyOf d = showDepend d
+ Portage/Dependency/Print.hs-boot view
@@ -0,0 +1,10 @@+module Portage.Dependency.Print+ (+ dep2str+ , dep2str_denorm -- for debugging+ ) where++import Portage.Dependency.Types++dep2str :: Int -> Dependency -> String+dep2str_denorm :: Dependency -> String
+ Portage/Dependency/Types.hs view
@@ -0,0 +1,96 @@+module Portage.Dependency.Types+ (+ SlotDepend(..)+ , LBound(..)+ , UBound(..)+ , DRange(..)+ , DAttr(..)+ , DUse(..)+ , Dependency(..)+ , dep_is_case_of+ ) where++import Portage.PackageId+import Portage.Use++data SlotDepend = AnySlot -- nothing special+ | AnyBuildTimeSlot -- ':='+ | GivenSlot String -- ':slotno'+ deriving (Eq, Show)++data LBound = StrictLB Version+ | NonstrictLB Version+ | ZeroB+ deriving (Eq, Show)++instance Ord LBound where+ compare ZeroB ZeroB = EQ+ compare ZeroB _ = LT+ compare _ ZeroB = GT+ compare (StrictLB lv) (StrictLB rv) = compare lv rv+ compare (NonstrictLB lv) (NonstrictLB rv) = compare lv rv+ compare l r = error $ unlines ["i am too lazy to implement LBound: compare"+ , show l+ , show r]++data UBound = StrictUB Version -- <+ | NonstrictUB Version -- <=+ | InfinityB+ deriving (Eq, Show)++instance Ord UBound where+ compare InfinityB InfinityB = EQ+ compare InfinityB _ = GT+ compare _ InfinityB = LT+ compare (NonstrictUB lv) (NonstrictUB rv) = compare lv rv+ compare (StrictUB lv) (StrictUB rv) = compare lv rv+ compare l r = error $ unlines ["i am too lazy to implement UBound: compare"+ , show l+ , show r]++data DRange = DRange LBound UBound+ | DExact Version+ deriving (Eq, Show)++-- True if 'left' "interval" is a nonstrict subset of 'right' "interval"+range_is_case_of :: DRange -> DRange -> Bool+range_is_case_of (DRange llow lup) (DRange rlow rup)+ | llow >= rlow && lup <= rup = True+range_is_case_of _ _ = False++data DAttr = DAttr SlotDepend [UseFlag]+ deriving (Eq, Show)++-- Simplified version of 'UseFlag'+-- used as a guarding depend:+-- foo? ( ... )+-- !foo? ( ... )+data DUse = DUse (Bool, Use)+ deriving (Eq, Show)++-- sort order:+-- a? < b?+-- a? < !a?+-- but 'test?' is special+instance Ord DUse where+ compare (DUse (lb, lname)) (DUse (rb, rname)) =+ case (lname, rname, compare lname rname) of+ (_, _, EQ) -> compare rb lb+ ("test", _, _) -> LT+ (_, "test", _) -> GT+ (_, _, v) -> v++data Dependency = Atom PackageName DRange DAttr+ | DependIfUse DUse Dependency+ | DependAnyOf [Dependency]+ | DependAllOf [Dependency]+ deriving (Eq, Show)++dep_is_case_of :: Dependency -> Dependency -> Bool+dep_is_case_of l r+ -- very broad (not only on atoms) special case+ | l == r = True+-- only on atoms+dep_is_case_of (Atom lpn lr lda) (Atom rpn rr rda)+ | lpn == rpn && lda == rda = lr `range_is_case_of` rr+dep_is_case_of _ _ = False
Portage/EBuild.hs view
@@ -151,8 +151,27 @@ (foldl (\acc v -> acc . ss "\t" . ss v . nl) id s) . post +-- takes string and substitutes tabs to spaces+-- ebuild's convention is 4 spaces for one tab,+-- BUT! nested USE flags get moved too much to+-- right. Thus 8 :]+tab_size :: Int+tab_size = 8++tabify_line :: String -> String+tabify_line l = replicate need_tabs '\t' ++ nonsp+ where (sp, nonsp) = break (/= ' ') l+ (full_tabs, t) = length sp `divMod` tab_size+ need_tabs = full_tabs + if t > 0 then 1 else 0++tabify :: String -> String+tabify = unlines . map tabify_line . lines+ dep_str :: String -> [String] -> [Dependency] -> DString-dep_str var extra deps = ss var. sc '='. quote' (sepBy "\n\t\t" $ extra ++ map display deps). nl+dep_str var extra deps = ss var. sc '='. quote' (ss $ drop_leadings $ unlines extra ++ deps_s). nl+ where indent = 1 * tab_size+ deps_s = tabify (dep2str indent (DependAllOf deps))+ drop_leadings = dropWhile (== '\t') quote :: String -> DString quote str = sc '"'. ss (esc str). sc '"'
Portage/Version.hs view
@@ -34,11 +34,17 @@ deriving (Eq, Ord, Show, Read) -- foo-9999* is treated as live ebuild+-- Cabal-1.17.9999* as well is_live :: Version -> Bool is_live v =- case versionNumber v of- [n] | n >= 9999 && (all (== '9') . show) n -> True- _ -> False+ case vs of+ -- nonempty+ (_:_) | many_nines (last vs) -> True+ _ -> False+ where vs = versionNumber v+ many_nines n = is_big n && all_nines n+ is_big n = n >= 9999+ all_nines n = (all (== '9') . show) n data Suffix = Alpha Int | Beta Int | Pre Int | RC Int | P Int deriving (Eq, Ord, Show, Read)
Status.hs view
@@ -18,7 +18,7 @@ import qualified Data.List as List -import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString.Char8 as BS import Data.Char import Data.Function (on)@@ -230,13 +230,14 @@ -- Disregards comments. equals :: FilePath -> FilePath -> IO Bool equals fp1 fp2 = do- f1 <- L.readFile fp1- f2 <- L.readFile fp2+ -- don't leave halfopenfiles+ f1 <- BS.readFile fp1+ f2 <- BS.readFile fp2 return (equal' f1 f2) -equal' :: L.ByteString -> L.ByteString -> Bool+equal' :: BS.ByteString -> BS.ByteString -> Bool equal' = equating essence where- essence = filter (not . isEmpty) . filter (not . isComment) . L.lines- isComment = L.isPrefixOf (L.pack "#") . L.dropWhile isSpace- isEmpty = L.null . L.dropWhile isSpace+ essence = filter (not . isEmpty) . filter (not . isComment) . BS.lines+ isComment = BS.isPrefixOf (BS.pack "#") . BS.dropWhile isSpace+ isEmpty = BS.null . BS.dropWhile isSpace
− cabal/.git
@@ -1,1 +0,0 @@-gitdir: /home/slyfox/portage/hackport/.git/modules/cabal
hackport.cabal view
@@ -1,5 +1,5 @@ Name: hackport-Version: 0.3.3+Version: 0.3.4 License: GPL License-file: LICENSE Author: Henning Günther, Duncan Coutts, Lennart Kolmodin@@ -18,6 +18,7 @@ Flag split-base Executable hackport+ ghc-options: -Wall Main-Is: Main.hs Default-Language: Haskell98 Hs-Source-Dirs: ., cabal, cabal/Cabal, cabal/cabal-install@@ -34,7 +35,7 @@ HTTP >= 4000.0.3, zlib, tar,- xml>1.3.5,+ xml >= 1.3.7, array, extensible-exceptions, time,@@ -63,7 +64,6 @@ else Build-Depends: base < 3 - ghc-options: -Wall other-modules: AnsiColor BlingBling@@ -90,6 +90,7 @@ Executable hackport-guess-ghc-version+ ghc-options: -Wall Main-Is: Main-GuessGHC.hs Default-Language: Haskell98 Buildable: False@@ -122,15 +123,15 @@ else Build-Depends: base < 3 - ghc-options: -Wall other-modules: Portage.GHCCore Test-Suite test-resolve-category+ ghc-options: -Wall Type: exitcode-stdio-1.0 Default-Language: Haskell98 Main-Is: tests/resolveCat.hs- Hs-Source-Dirs: ., cabal, cabal/Cabal, cabal/cabal-install+ Hs-Source-Dirs: ., cabal, cabal/Cabal, cabal/cabal-install, tests Build-Depends: base >= 3 && < 5, deepseq >= 1.3 && < 1.4, bytestring,@@ -146,13 +147,33 @@ unix, xml -Test-Suite test-merge-deps- -- Build is broken for now- Buildable: False+Test-Suite test-print-deps+ ghc-options: -Wall Type: exitcode-stdio-1.0 Default-Language: Haskell98- Main-Is: tests/MergeDeps.hs- Hs-Source-Dirs: ., cabal, cabal/Cabal, cabal/cabal-install+ Main-Is: tests/print_deps.hs+ Hs-Source-Dirs: ., cabal, cabal/Cabal, cabal/cabal-install, tests+ 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-normalize-deps+ ghc-options: -Wall+ Type: exitcode-stdio-1.0+ Default-Language: Haskell98+ Main-Is: tests/normalize_deps.hs+ Hs-Source-Dirs: ., cabal, cabal/Cabal, cabal/cabal-install, tests Build-Depends: base >= 3 && < 5, deepseq >= 1.3 && < 1.4, bytestring,
− tests/MergeDeps.hs
@@ -1,35 +0,0 @@-{-# 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
@@ -1,38 +0,0 @@-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
+ tests/RunTests.hs view
@@ -0,0 +1,15 @@+module RunTests+ (run_tests) where++import Control.Monad (when)++import System.Exit (exitFailure)+import Test.HUnit++something_broke :: Counts -> Bool+something_broke stats = errors stats + failures stats > 0++run_tests :: Test -> IO ()+run_tests tests =+ do stats <- runTestTT tests+ when (something_broke stats) exitFailure
+ tests/normalize_deps.hs view
@@ -0,0 +1,134 @@+import Control.Monad (forM_)+import Data.List++import Test.HUnit++import qualified Portage.Dependency as P+import qualified Portage.PackageId as P+import qualified Portage.Use as P+import qualified RunTests as RT++tests :: Test+tests = TestList [ TestLabel "normalize_in_use_and_top" test_normalize_in_use_and_top+ ]++pnm :: P.PackageName+pnm = P.mkPackageName "dev-haskell" "mtl"+pnp :: P.PackageName+pnp = P.mkPackageName "dev-haskell" "parsec"+pnq :: P.PackageName+pnq = P.mkPackageName "dev-haskell" "quickcheck"++def_attr :: P.DAttr+def_attr = P.DAttr P.AnySlot []++p_v :: [Int] -> P.Version+p_v v = P.Version { P.versionNumber = v+ , P.versionChar = Nothing+ , P.versionSuffix = []+ , P.versionRevision = 0+ }++d_all :: [P.Dependency] -> P.Dependency+d_all = P.DependAllOf+d_any :: [P.Dependency] -> P.Dependency+d_any = P.DependAnyOf++d_ge :: P.PackageName -> [Int] -> P.Dependency+d_ge pn v = P.Atom pn+ (P.DRange (P.NonstrictLB $ p_v v) P.InfinityB)+ def_attr++d_p :: String -> P.Dependency+d_p pn = P.Atom (P.mkPackageName "c" pn)+ (P.DRange P.ZeroB P.InfinityB)+ def_attr++d_use :: P.Use -> P.Dependency -> P.Dependency+d_use u d = P.DependIfUse (P.DUse (True, u)) d++d_nuse :: P.Use -> P.Dependency -> P.Dependency+d_nuse u d = P.DependIfUse (P.DUse (False, u)) d++test_normalize_in_use_and_top :: Test+test_normalize_in_use_and_top = TestCase $ do+ let deps = [ ( d_all [ d_ge pnm [1,0]+ , d_use "foo" (d_all [ d_ge pnm [1,0] -- duplicate+ , d_ge pnp [2,1]+ ])+ ]+ , [ ">=dev-haskell/mtl-1.0"+ , "foo? ( >=dev-haskell/parsec-2.1 )"+ ]+ )+ , ( d_all [ d_ge pnm [1,0]+ , d_use "foo" (d_any [ d_ge pnm [1,0] -- already satisfied+ , d_ge pnp [2,1]+ ])+ ]+ , [ ">=dev-haskell/mtl-1.0" ]+ )+ , ( d_any [ d_all [ d_ge pnm [1,0] -- common subdep+ , d_ge pnq [1,2]+ ]+ , d_all [ d_ge pnm [1,0]+ , d_ge pnp [3,1]+ ]+ ]+ , [ ">=dev-haskell/mtl-1.0"+ , "|| ( >=dev-haskell/quickcheck-1.2"+ , " >=dev-haskell/parsec-3.1 )"+ ]+ )+ , ( d_all [ d_use "foo" $ d_use "bar" $ d_ge pnm [1,0]+ , d_use "bar" $ d_use "foo" $ d_ge pnm [1,0]+ ]+ , [ "bar? ( foo? ( >=dev-haskell/mtl-1.0 ) )" ]+ )+ , ( d_all [ d_use "foo" $ d_ge pnm [1,0]+ , d_use "foo" $ d_ge pnp [3,1]+ ]+ , [ "foo? ( >=dev-haskell/mtl-1.0"+ , " >=dev-haskell/parsec-3.1 )"+ ]+ )+ , ( d_all [ d_use "a" $ d_use "b" $ d_ge pnm [1,0]+ , d_nuse "a" $ d_use "b" $ d_ge pnm [1,0]+ ]+ , [ "b? ( >=dev-haskell/mtl-1.0 )"+ ]+ )+ -- 'test?' is special+ , ( d_use "a" $ d_use "test" $ d_ge pnm [1,0]+ , [ "test? ( a? ( >=dev-haskell/mtl-1.0 ) )"+ ]+ )+ , -- pop context for complementary depends, like+ -- a? ( x y a ) !a? ( x y na )+ -- leads to+ -- x y a? ( a ) !a? ( na )+ ( d_all [ d_use "a" $ d_all $ map d_p [ "x", "y", "a" ]+ , d_nuse "a" $ d_all $ map d_p [ "x", "y", "na" ]+ ]+ , [ "c/x"+ , "c/y"+ , "a? ( c/a )"+ , "!a? ( c/na )"+ ]+ )+ , -- push stricter context into less trict+ ( d_all [ d_ge pnm [2,0]+ , d_use "a" $ d_ge pnm [1,0]+ ]+ ,+ [ ">=dev-haskell/mtl-2.0" ]+ )+ ]+ forM_ deps $ \(d, expected) ->+ let actual = P.dep2str 0 d+ in assertEqual ("expecting empty result for " ++ show d)+ (intercalate "\n" expected)+ actual++main :: IO ()+main = RT.run_tests tests
+ tests/print_deps.hs view
@@ -0,0 +1,138 @@+import Control.Monad (forM_)+import Data.List++import Test.HUnit++import qualified Portage.Dependency as P+import qualified Portage.PackageId as P+import qualified RunTests as RT++tests :: Test+tests = TestList [ TestLabel "print_empty" test_print_empty+ , TestLabel "print_mixed" test_print_mixed+ , TestLabel "print_denorm" test_print_denorm+ ]++test_print_empty :: Test+test_print_empty = TestCase $ do+ let expect_empty = ""+ d_all = P.DependAllOf+ d_any = P.DependAnyOf+ d_use u dep = P.DependIfUse (P.DUse (True, u)) dep+ deps = [ d_all []+ , d_any []+ , d_use "f" (d_all [])+ , P.DependAllOf [d_any []]+ , P.DependAnyOf [d_all []]+ -- Deep Useless Use Tree :]+ , d_use "f" $+ d_use "g" $+ d_all [d_any []+ , d_use "h" $+ d_all [ d_all []+ , d_any []+ ]+ , d_use "i" $+ d_all [ d_all []+ , d_any []+ ]+ ]+ ]+ forM_ deps $ \d ->+ let actual_result = P.dep2str 0 d+ in assertEqual ("expecting empty result for " ++ show d)+ expect_empty+ actual_result++test_print_mixed :: Test+test_print_mixed = TestCase $ do+ let pn = P.mkPackageName "dev-haskell" "mtl"+ def_attr = P.DAttr P.AnySlot []+ p_v v = P.Version { P.versionNumber = v+ , P.versionChar = Nothing+ , P.versionSuffix = []+ , P.versionRevision = 0+ }+ d_all = P.DependAllOf+ d_any = P.DependAnyOf+ d_ge v = P.Atom pn+ (P.DRange (P.NonstrictLB $ p_v v) P.InfinityB)+ def_attr+ d_lt v = P.Atom pn+ (P.DRange P.ZeroB (P.StrictUB $ p_v v))+ def_attr+ deps = [ -- from agda: "mtl ==2.0.* || >=2.1.1 && <2.2"+ ( d_all [ d_any [ d_all [ d_ge [2, 0]+ , d_lt [2, 1]+ ]+ , d_all [ d_ge [2, 1, 1]+ , d_lt [2, 2]+ ]+ ]+ ]+ , [ "|| ( ( >=dev-haskell/mtl-2.0 <dev-haskell/mtl-2.1 )"+ , " ( >=dev-haskell/mtl-2.1.1 <dev-haskell/mtl-2.2 ) )"+ ]+ )+ -- remove duplicate entries+ , ( let d = d_all [d_ge [2, 0], d_lt [2, 2]]+ in d_all [d, d]+ , [ ">=dev-haskell/mtl-2.0 <dev-haskell/mtl-2.2" ]+ )+ ]+ forM_ deps $ \(d, expected) ->+ let actual = P.dep2str 0 d+ in assertEqual ("expecting empty result for " ++ show d)+ (intercalate "\n" expected)+ actual++test_print_denorm :: Test+test_print_denorm = TestCase $ do+ let pn = P.mkPackageName "dev-haskell" "mtl"+ def_attr = P.DAttr P.AnySlot []+ p_v v = P.Version { P.versionNumber = v+ , P.versionChar = Nothing+ , P.versionSuffix = []+ , P.versionRevision = 0+ }+ d_all = P.DependAllOf+ d_any = P.DependAnyOf+ d_ge v = P.Atom pn+ (P.DRange (P.NonstrictLB $ p_v v) P.InfinityB)+ def_attr+ d_lt v = P.Atom pn+ (P.DRange P.ZeroB (P.StrictUB $ p_v v))+ def_attr+ deps = [ -- from agda: "mtl ==2.0.* || >=2.1.1 && <2.2"+ ( d_all [ d_any [ d_all [ d_ge [2, 0]+ , d_lt [2, 1]+ ]+ , d_all [ d_ge [2, 1, 1]+ , d_lt [2, 2]+ ]+ ]+ ]+ , [ "|| ( ( >=dev-haskell/mtl-2.0"+ , " <dev-haskell/mtl-2.1 )"+ , " ( >=dev-haskell/mtl-2.1.1"+ , " <dev-haskell/mtl-2.2 ) )"+ ]+ )+ -- remove duplicate entries+ , ( let d = d_all [d_ge [2, 0], d_lt [2, 2]]+ in d_all [d, d]+ , [ ">=dev-haskell/mtl-2.0"+ , "<dev-haskell/mtl-2.2"+ , ">=dev-haskell/mtl-2.0"+ , "<dev-haskell/mtl-2.2"+ ]+ )+ ]+ forM_ deps $ \(d, expected) ->+ let actual = P.dep2str_denorm d+ in assertEqual ("expecting empty result for " ++ show d)+ (intercalate "\n" expected)+ actual++main :: IO ()+main = RT.run_tests tests
tests/resolveCat.hs view
@@ -1,5 +1,3 @@-import Control.Monad (when)- import qualified Distribution.Package as Cabal import qualified Portage.Overlay as Portage@@ -7,9 +5,11 @@ import qualified Portage.PackageId as Portage import qualified Portage.Host as Portage -import System.Exit (exitFailure) import Test.HUnit +import qualified RunTests as RT++tests :: Test 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")@@ -25,9 +25,5 @@ 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+main :: IO ()+main = RT.run_tests tests