summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergeiTrofimovich <>2012-02-28 21:18:32 (GMT)
committerhdiff <hdiff@luite.com>2012-02-28 21:18:32 (GMT)
commit514e553b45046ef8afe6eb0b8a21cee44370fc7d (patch)
tree0dddd0bcce20cbab215ea769dd492c291bdd5b51
parent861ae5a115119dadff99971785d5d18cf9f5d835 (diff)
version 0.2.170.2.17
-rw-r--r--Cabal2Ebuild.hs34
-rw-r--r--Hackage.hs32
-rw-r--r--Main.hs48
-rw-r--r--Merge.hs9
-rw-r--r--Merge/Dependencies.hs96
-rw-r--r--Portage/Dependency.hs123
-rw-r--r--Portage/Host.hs10
-rw-r--r--Portage/Resolve.hs7
-rw-r--r--Portage/Use.hs50
-rw-r--r--Status.hs86
-rw-r--r--hackport.cabal5
-rw-r--r--tests/resolveCat.hs4
-rw-r--r--unused/Fetch.hs78
13 files changed, 340 insertions, 242 deletions
diff --git a/Cabal2Ebuild.hs b/Cabal2Ebuild.hs
index 53f3c11..3cd3c25 100644
--- a/Cabal2Ebuild.hs
+++ b/Cabal2Ebuild.hs
@@ -37,9 +37,12 @@ import Distribution.Text (display)
import Data.Char (toLower,isUpper)
import Portage.Dependency
+import Portage.Use
import qualified Portage.PackageId as Portage
import qualified Portage.EBuild as Portage
+import qualified Portage.Resolve as Portage
import qualified Portage.EBuild as E
+import qualified Portage.Overlay as O
import Portage.Version
cabal2ebuild :: Cabal.PackageDescription -> Portage.EBuild
@@ -66,27 +69,27 @@ cabal2ebuild pkg = Portage.ebuildTemplate {
then E.homepage E.ebuildTemplate
else Cabal.homepage pkg
-convertDependencies :: Portage.Category -> [Cabal.Dependency] -> [Dependency]
-convertDependencies category = concatMap (convertDependency category)
+convertDependencies :: O.Overlay -> Portage.Category -> [Cabal.Dependency] -> [Dependency]
+convertDependencies overlay category = concatMap (convertDependency overlay category)
-convertDependency :: Portage.Category -> Cabal.Dependency -> [Dependency]
-convertDependency _category (Cabal.Dependency pname@(Cabal.PackageName _name) _)
+convertDependency :: O.Overlay -> Portage.Category -> Cabal.Dependency -> [Dependency]
+convertDependency overlay _category (Cabal.Dependency pname@(Cabal.PackageName _name) _)
| pname `elem` coreLibs = [] -- no explicit dep on core libs
-convertDependency category (Cabal.Dependency pname versionRange)
+convertDependency overlay category (Cabal.Dependency pname versionRange)
= convert versionRange
where
- -- XXX: not always true, we should look properly for deps in the overlay
- -- to find the correct category
- pn = Portage.PackageName category (Portage.normalizeCabalPackageName pname)
+ pn = case Portage.resolveFullPortageName overlay pname of
+ Just r -> r
+ Nothing -> Portage.PackageName category (Portage.normalizeCabalPackageName pname)
convert :: Cabal.VersionRange -> [Dependency]
convert = Cabal.foldVersionRange'
- ( [AnyVersionOf pn] -- ^ @\"-any\"@ version
- )(\v -> [ThisVersionOf (fromCabalVersion v) pn] -- ^ @\"== v\"@
- )(\v -> [LaterVersionOf (fromCabalVersion v) pn] -- ^ @\"> v\"@
- )(\v -> [EarlierVersionOf (fromCabalVersion v) pn] -- ^ @\"< v\"@
- )(\v -> [OrLaterVersionOf (fromCabalVersion v) pn] -- ^ @\">= v\"@
- )(\v -> [OrEarlierVersionOf (fromCabalVersion v) pn] -- ^ @\"<= v\"@
- )(\v _ -> [ThisMajorOf (fromCabalVersion v) pn] -- ^ @\"== v.*\"@ wildcard. (incl lower, excl upper)
+ ( [AnyVersionOf pn []] -- ^ @\"-any\"@ version
+ )(\v -> [ThisVersionOf (fromCabalVersion v) pn []] -- ^ @\"== v\"@
+ )(\v -> [LaterVersionOf (fromCabalVersion v) pn []] -- ^ @\"> v\"@
+ )(\v -> [EarlierVersionOf (fromCabalVersion v) pn []] -- ^ @\"< v\"@
+ )(\v -> [OrLaterVersionOf (fromCabalVersion v) pn []] -- ^ @\">= v\"@
+ )(\v -> [OrEarlierVersionOf (fromCabalVersion v) pn []] -- ^ @\"<= v\"@
+ )(\v _ -> [ThisMajorOf (fromCabalVersion v) pn []] -- ^ @\"== v.*\"@ wildcard. (incl lower, excl upper)
)(\g1 g2 -> [DependEither (flatten g1 ++ flatten g2) ] -- ^ @\"_ || _\"@ union
)(\r1 r2 -> r1 ++ r2 -- ^ @\"_ && _\"@ intersection
)(\dp -> [AllOf dp ] -- ^ @\"(_)\"@ parentheses
@@ -96,7 +99,6 @@ convertDependency category (Cabal.Dependency pname versionRange)
flatten [DependEither ds] = concatMap flatten ds
flatten other = [other]
-
coreLibs :: [Cabal.PackageName]
coreLibs = map Cabal.PackageName
["array"
diff --git a/Hackage.hs b/Hackage.hs
new file mode 100644
index 0000000..57a5db2
--- /dev/null
+++ b/Hackage.hs
@@ -0,0 +1,32 @@
+{-|
+ Author : Sergei Trofimovich <slyfox@gentoo.org>
+ Stability : experimental
+ Portability : haskell98
+
+ Utilities to work with hackage-alike repositories
+-}
+module Hackage
+ ( defaultRepo
+ , defaultRepoURI
+ ) where
+
+import Distribution.Client.Types (Repo(..), RemoteRepo(..))
+import Network.URI (URI(..), URIAuth(..))
+import System.FilePath
+
+defaultRepo :: FilePath -> Repo
+defaultRepo overlayPath =
+ Repo {
+ repoKind = Left hackage,
+ repoLocalDir = overlayPath </> ".hackport"
+ }
+ where
+ hackage = RemoteRepo server_name uri
+ server_name = "hackage.haskell.org"
+ uri = URI "http:" (Just (URIAuth "" server_name "")) "/packages/archive" "" ""
+
+defaultRepoURI :: FilePath -> URI
+defaultRepoURI overlayPath =
+ case repoKind (defaultRepo overlayPath) of
+ Left (RemoteRepo { remoteRepoURI = uri }) -> uri
+ Right _ -> error $ "defaultRepoURI: unable to get URI for " ++ overlayPath
diff --git a/Main.hs b/Main.hs
index 53477e9..e6160a6 100644
--- a/Main.hs
+++ b/Main.hs
@@ -28,11 +28,13 @@ import Distribution.Client.Update
import qualified Distribution.Client.PackageIndex as Index
import qualified Distribution.Client.IndexUtils as Index
+import Hackage (defaultRepo, defaultRepoURI)
+
import Portage.Overlay as Overlay ( loadLazy, inOverlay )
import Portage.Host as Host ( getInfo, portage_dir )
import Portage.PackageId ( normalizeCabalPackageId )
-import Network.URI ( URI(..), URIAuth(..), parseURI )
+import Network.URI ( URI(..), parseURI )
import System.Environment ( getArgs, getProgName )
import System.Directory ( doesDirectoryExist )
import System.Exit ( exitFailure )
@@ -295,24 +297,13 @@ updateAction flags extraArgs globalFlags = do
data StatusFlags = StatusFlags {
statusVerbosity :: Flag Verbosity,
- statusToPortage :: Flag Bool
- }
-
-instance Monoid StatusFlags where
- mempty = StatusFlags {
- statusVerbosity = mempty,
- statusToPortage = mempty
- }
- mappend a b = StatusFlags {
- statusVerbosity = combine statusVerbosity,
- statusToPortage = combine statusToPortage
+ statusDirection :: Flag StatusDirection
}
- where combine field = field a `mappend` field b
defaultStatusFlags :: StatusFlags
defaultStatusFlags = StatusFlags {
statusVerbosity = Flag normal,
- statusToPortage = Flag False
+ statusDirection = Flag PortagePlusOverlay
}
statusCommand :: CommandUI StatusFlags
@@ -327,18 +318,22 @@ statusCommand = CommandUI {
[ optionVerbosity statusVerbosity (\v flags -> flags { statusVerbosity = v })
, option [] ["to-portage"]
"Print only packages likely to be interesting to move to the portage tree."
- statusToPortage (\v flags -> flags { statusToPortage = v })
- trueArg
+ statusDirection (\v flags -> flags { statusDirection = v })
+ (noArg (Flag OverlayToPortage))
+ , option [] ["from-hackage"]
+ "Print only packages likely to be interesting to move from hackage tree."
+ statusDirection (\v flags -> flags { statusDirection = v })
+ (noArg (Flag HackageToOverlay))
]
}
statusAction :: StatusFlags -> [String] -> GlobalFlags -> IO ()
statusAction flags args globalFlags = do
let verbosity = fromFlag (statusVerbosity flags)
- toPortdir = fromFlag (statusToPortage flags)
+ direction = fromFlag (statusDirection flags)
portagePath <- getPortageDir verbosity globalFlags
overlayPath <- getOverlayPath verbosity (fromFlag $ globalPathToOverlay globalFlags)
- runStatus verbosity portagePath overlayPath toPortdir args
+ runStatus verbosity portagePath overlayPath direction args
-----------------------------------------------------------------------
-- Merge
@@ -441,23 +436,6 @@ distroMapAction flags extraArgs globalFlags = do
-- Utils
-----------------------------------------------------------------------
-defaultRepo :: FilePath -> Repo
-defaultRepo overlayPath =
- Repo {
- repoKind = Left hackage,
- repoLocalDir = overlayPath </> ".hackport"
- }
- where
- hackage = RemoteRepo server_name uri
- server_name = "hackage.haskell.org"
- uri = URI "http:" (Just (URIAuth "" server_name "")) "/packages/archive" "" ""
-
-defaultRepoURI :: FilePath -> URI
-defaultRepoURI overlayPath =
- case repoKind (defaultRepo overlayPath) of
- Left (RemoteRepo { remoteRepoURI = uri }) -> uri
- Right _ -> error $ "defaultRepoURI: unable to get URI for " ++ overlayPath
-
getServerURI :: String -> IO URI
getServerURI str =
case parseURI str of
diff --git a/Merge.hs b/Merge.hs
index 413c4ab..e86a1fe 100644
--- a/Merge.hs
+++ b/Merge.hs
@@ -7,7 +7,7 @@ module Merge
import Control.Monad.Error
import Control.Exception
import Data.Maybe
-import Data.List
+import Data.List as L
import Distribution.Package
import Distribution.PackageDescription ( PackageDescription(..)
, FlagName(..)
@@ -123,7 +123,9 @@ merge verbosity repo _serverURI args overlayPath = do
case map snd (Index.searchByName index user_pname_str) of
[] -> throwEx (PackageNotFound user_pname_str)
[pkg] -> return pkg
- pkgs -> throwEx (ArgumentError ("Ambiguous name: " ++ unwords (map show pkgs)))
+ pkgs -> let names = map (pkgName . packageInfoId . L.head) pkgs
+ whole_list = map (L.intercalate "\n" . map (show . packageInfoId)) pkgs
+ in throwEx $ ArgumentError $ L.intercalate "\n---\n" $ ["Ambiguous names: " ++ show names] ++ whole_list
-- select a single package taking into account the user specified version
selectedPkg <-
@@ -149,6 +151,7 @@ merge verbosity repo _serverURI args overlayPath = do
mergeGenericPackageDescription :: Verbosity -> FilePath -> Portage.Category -> GenericPackageDescription -> Bool -> IO ()
mergeGenericPackageDescription verbosity overlayPath cat pkgGenericDesc fetch = do
+ overlay <- Overlay.loadLazy overlayPath
let Right (pkgDesc0, flags) =
finalizePackageDescription
[ -- XXX: common things we should enable/disable?
@@ -169,7 +172,7 @@ mergeGenericPackageDescription verbosity overlayPath cat pkgGenericDesc fetch =
, pn `notElem` excludePkgs
]
in pkgDesc0 { buildDepends = deps }
- edeps = Merge.resolveDependencies pkgDesc (Just compilerId)
+ edeps = Merge.resolveDependencies overlay pkgDesc (Just compilerId)
debug verbosity ("Selected flags: " ++ show flags)
info verbosity ("Guessing GHC version: " ++ maybe "could not guess" (display.fst) mminimumGHC)
diff --git a/Merge/Dependencies.hs b/Merge/Dependencies.hs
index 4ccc360..669ef35 100644
--- a/Merge/Dependencies.hs
+++ b/Merge/Dependencies.hs
@@ -63,9 +63,11 @@ import qualified Distribution.Package as Cabal
import qualified Distribution.Version as Cabal
import Distribution.Compiler
-import qualified Portage.Version as Portage
-import qualified Portage.PackageId as Portage
import qualified Portage.Dependency as Portage
+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
@@ -90,8 +92,8 @@ emptyEDep = EDep
dep_e = []
}
-resolveDependencies :: PackageDescription -> Maybe CompilerId -> EDep
-resolveDependencies pkg mcompiler =
+resolveDependencies :: Portage.Overlay -> PackageDescription -> Maybe CompilerId -> EDep
+resolveDependencies overlay pkg mcompiler =
edeps
{
dep = Portage.simplify_deps ( dep edeps),
@@ -104,12 +106,14 @@ resolveDependencies pkg mcompiler =
hasBuildableExes p = any (buildable . buildInfo) . executables $ p
treatAsLibrary = (not . hasBuildableExes) pkg || hasLibs pkg
- haskell_deps = haskellDependencies pkg
- cabal_dep = cabalDependency pkg compiler
+ haskell_deps
+ | treatAsLibrary = add_profile $ haskellDependencies overlay pkg
+ | otherwise = haskellDependencies overlay pkg
+ cabal_dep = cabalDependency overlay pkg compiler
ghc_dep = compilerIdToDependency compiler
extra_libs = findCLibs pkg
build_tools = buildToolsDependencies pkg
- pkg_config = pkgConfigDependencies pkg
+ pkg_config = pkgConfigDependencies overlay pkg
edeps
| treatAsLibrary = emptyEDep
{
@@ -130,16 +134,17 @@ resolveDependencies pkg mcompiler =
dep_e = [ "${RDEPEND}" ],
rdep = extra_libs ++ pkg_config
}
+ add_profile = map (flip Portage.addDepUseFlag (Portage.mkQUse "profile"))
---------------------------------------------------------------
-- Haskell packages
---------------------------------------------------------------
-haskellDependencies :: PackageDescription -> [Portage.Dependency]
-haskellDependencies pkg =
- Portage.simplify_deps
- $ C2E.convertDependencies (Portage.Category "dev-haskell") (buildDepends pkg)
+haskellDependencies :: Portage.Overlay -> PackageDescription -> [Portage.Dependency]
+haskellDependencies overlay pkg =
+ Portage.simplify_deps
+ $ C2E.convertDependencies overlay (Portage.Category "dev-haskell") (buildDepends pkg)
---------------------------------------------------------------
-- Cabal Dependency
@@ -147,9 +152,10 @@ haskellDependencies pkg =
-- | Select the most restrictive dependency on Cabal, either the .cabal
-- file's descCabalVersion, or the Cabal GHC shipped with.
-cabalDependency :: PackageDescription -> CompilerId -> Portage.Dependency
-cabalDependency pkg (CompilerId GHC ghcVersion@(Cabal.Version versionNumbers _)) =
- head $ C2E.convertDependency (Portage.Category "dev-haskell")
+cabalDependency :: Portage.Overlay -> PackageDescription -> CompilerId -> Portage.Dependency
+cabalDependency overlay pkg (CompilerId GHC ghcVersion@(Cabal.Version versionNumbers _)) =
+ head $ C2E.convertDependency overlay
+ (Portage.Category "dev-haskell")
(Cabal.Dependency (Cabal.PackageName "Cabal")
finalCabalDep)
where
@@ -171,7 +177,7 @@ cabalDependency pkg (CompilerId GHC ghcVersion@(Cabal.Version versionNumbers _))
compilerIdToDependency :: CompilerId -> Portage.Dependency
compilerIdToDependency (CompilerId GHC versionNumbers) =
- Portage.OrLaterVersionOf (Portage.fromCabalVersion versionNumbers) (Portage.mkPackageName "dev-lang" "ghc")
+ Portage.OrLaterVersionOf (Portage.fromCabalVersion versionNumbers) (Portage.mkPackageName "dev-lang" "ghc") []
---------------------------------------------------------------
-- C Libraries
@@ -180,7 +186,7 @@ compilerIdToDependency (CompilerId GHC versionNumbers) =
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.AnyVersionOf (Portage.mkPackageName "unknown-c-lib" p) [])
| p <- notFound
] ++
found
@@ -195,14 +201,15 @@ findCLibs (PackageDescription { library = lib, executables = exes }) =
staticTranslateExtraLib :: String -> Maybe Portage.Dependency
staticTranslateExtraLib lib = lookup lib m
where
- m = [ ("z", Portage.AnyVersionOf (Portage.mkPackageName "sys-libs" "zlib"))
- , ("bz2", Portage.AnyVersionOf (Portage.mkPackageName "sys-libs" "bzlib"))
- , ("mysqlclient", Portage.LaterVersionOf (Portage.Version [4,0] Nothing [] 0) (Portage.mkPackageName "virtual" "mysql"))
- , ("pq", Portage.LaterVersionOf (Portage.Version [7] Nothing [] 0) (Portage.mkPackageName "virtual" "postgresql-base"))
- , ("ev", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "libev"))
- , ("expat", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "expat"))
- , ("curl", Portage.AnyVersionOf (Portage.mkPackageName "net-misc" "curl"))
- , ("xml2", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "libxml2"))
+ m = [ ("z", Portage.AnyVersionOf (Portage.mkPackageName "sys-libs" "zlib") [])
+ , ("bz2", Portage.AnyVersionOf (Portage.mkPackageName "sys-libs" "bzlib") [])
+ , ("mysqlclient", Portage.LaterVersionOf (Portage.Version [4,0] Nothing [] 0) (Portage.mkPackageName "virtual" "mysql") [])
+ , ("pq", Portage.LaterVersionOf (Portage.Version [7] Nothing [] 0) (Portage.mkPackageName "virtual" "postgresql-base") [])
+ , ("ev", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "libev") [])
+ , ("expat", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "expat") [])
+ , ("curl", Portage.AnyVersionOf (Portage.mkPackageName "net-misc" "curl") [])
+ , ("xml2", Portage.AnyVersionOf (Portage.mkPackageName "dev-libs" "libxml2") [])
+ , ("mecab", Portage.AnyVersionOf (Portage.mkPackageName "app-text" "mecab") [])
]
---------------------------------------------------------------
@@ -214,48 +221,55 @@ buildToolsDependencies (PackageDescription { library = lib, executables = exes }
[ 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.AnyVersionOf (Portage.mkPackageName "unknown-build-tool" pn) [])
| Cabal.Dependency (Cabal.PackageName pn) _range <- cabalDeps
, pkg <- return (lookup pn buildToolsTable)
]
where
- cabalDeps = depL ++ depE
+ cabalDeps = filter notProvided $ depL ++ depE
depL = maybe [] (buildTools.libBuildInfo) lib
depE = concatMap buildTools (filter buildable (map buildInfo exes))
+ notProvided (Cabal.Dependency (Cabal.PackageName pn) _range) = pn `notElem` buildToolsProvided
buildToolsTable :: [(String, Portage.Dependency)]
buildToolsTable =
- [ ("happy", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "happy"))
- , ("alex", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "alex"))
- , ("c2hs", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "c2hs"))
- , ("gtk2hsTypeGen", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools"))
- , ("gtk2hsHookGenerator", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools"))
- , ("gtk2hsC2hs", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools"))
+ [ ("happy", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "happy") [])
+ , ("alex", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "alex") [])
+ , ("c2hs", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "c2hs") [])
+ , ("gtk2hsTypeGen", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools") [])
+ , ("gtk2hsHookGenerator", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools") [])
+ , ("gtk2hsC2hs", Portage.AnyVersionOf (Portage.mkPackageName "dev-haskell" "gtk2hs-buildtools") [])
]
+-- tools that are provided by ghc or some other existing program
+-- so we do not need dependencies on them
+buildToolsProvided :: [String]
+buildToolsProvided = ["hsc2hs"]
+
+
---------------------------------------------------------------
-- pkg-config
---------------------------------------------------------------
-pkgConfigDependencies :: PackageDescription -> [Portage.Dependency]
-pkgConfigDependencies (PackageDescription { library = lib, executables = exes }) = nub $ resolvePkgConfigs cabalDeps
+pkgConfigDependencies :: Portage.Overlay -> PackageDescription -> [Portage.Dependency]
+pkgConfigDependencies overlay (PackageDescription { library = lib, executables = exes }) = nub $ resolvePkgConfigs overlay cabalDeps
where
cabalDeps = depL ++ depE
depL = maybe [] (pkgconfigDepends.libBuildInfo) lib
depE = concatMap pkgconfigDepends (filter buildable (map buildInfo exes))
-resolvePkgConfigs :: [Cabal.Dependency] -> [Portage.Dependency]
-resolvePkgConfigs cdeps =
- [ case resolvePkgConfig pkg of
+resolvePkgConfigs :: Portage.Overlay -> [Cabal.Dependency] -> [Portage.Dependency]
+resolvePkgConfigs overlay cdeps =
+ [ 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.AnyVersionOf (Portage.mkPackageName "unknown-pkg-config" pn) [])
| pkg@(Cabal.Dependency (Cabal.PackageName pn) _range) <- cdeps ]
-resolvePkgConfig :: Cabal.Dependency -> Maybe Portage.Dependency
-resolvePkgConfig (Cabal.Dependency (Cabal.PackageName pn) _cabalVersion) = do
+resolvePkgConfig :: Portage.Overlay -> Cabal.Dependency -> Maybe Portage.Dependency
+resolvePkgConfig overlay (Cabal.Dependency (Cabal.PackageName pn) _cabalVersion) = do
(cat,portname) <- lookup pn table
- return . head $ (C2E.convertDependency (Portage.Category cat) (Cabal.Dependency (Cabal.PackageName portname) _cabalVersion))
+ return . head $ (C2E.convertDependency overlay (Portage.Category cat) (Cabal.Dependency (Cabal.PackageName portname) _cabalVersion))
table :: [(String, (String, String))]
table =
diff --git a/Portage/Dependency.hs b/Portage/Dependency.hs
index 73fd0cc..7e36135 100644
--- a/Portage/Dependency.hs
+++ b/Portage/Dependency.hs
@@ -1,9 +1,11 @@
module Portage.Dependency (
Dependency(..),
- simplify_deps
+ simplify_deps,
+ addDepUseFlag
) where
import Portage.Version
+import Portage.Use
import Distribution.Text ( display, Text(..) )
import Portage.PackageId
@@ -15,17 +17,15 @@ import Data.Maybe ( fromJust, catMaybes )
import Data.List ( nub, groupBy, partition, sortBy )
import Data.Ord (comparing)
-type UseFlag = String
-
-data Dependency = AnyVersionOf PackageName
- | ThisVersionOf Version PackageName -- ~package-version
- | LaterVersionOf Version PackageName -- >package-version
- | EarlierVersionOf Version PackageName -- <package-version
- | OrLaterVersionOf Version PackageName -- >=package-version
- | OrEarlierVersionOf Version PackageName -- <=package-version
- | DependEither [[Dependency]] -- || ( depend_group1 ..depend_groupN )
+data Dependency = AnyVersionOf PackageName [UseFlag]
+ | ThisVersionOf Version PackageName [UseFlag] -- ~package-version
+ | LaterVersionOf Version PackageName [UseFlag] -- >package-version
+ | EarlierVersionOf Version PackageName [UseFlag] -- <package-version
+ | OrLaterVersionOf Version PackageName [UseFlag] -- >=package-version
+ | OrEarlierVersionOf Version PackageName [UseFlag] -- <=package-version
+ | DependEither [[Dependency]] -- || ( depend_group1 ..depend_groupN )
| DependIfUse UseFlag Dependency -- use? ( depend )
- | ThisMajorOf Version PackageName -- =package-version*
+ | ThisMajorOf Version PackageName [UseFlag] -- =package-version*
| AllOf [Dependency] -- ( package-version* )
deriving (Eq,Show)
@@ -36,26 +36,27 @@ instance Text Dependency where
a <-> b = a <> Disp.char '-' <> b
showDepend :: Dependency -> Disp.Doc
-showDepend (AnyVersionOf p) = disp p
-showDepend (ThisVersionOf v p) = Disp.char '~' <> disp p <-> disp v { versionRevision = 0 }
-showDepend (LaterVersionOf v p) = Disp.char '>' <> disp p <-> disp v
-showDepend (EarlierVersionOf v p) = Disp.char '<' <> disp p <-> disp v
-showDepend (OrLaterVersionOf v p) = Disp.text ">=" <> disp p <-> disp v
-showDepend (OrEarlierVersionOf v p) = Disp.text "<=" <> disp p <-> disp v
+showDepend (AnyVersionOf p u) = disp p <> dispUses u
+showDepend (ThisVersionOf v p u) = Disp.char '~' <> disp p <-> disp v { versionRevision = 0 }<>dispUses u
+showDepend (LaterVersionOf v p u) = Disp.char '>' <> disp p <-> disp v <> dispUses u
+showDepend (EarlierVersionOf v p u) = Disp.char '<' <> disp p <-> disp v <> dispUses u
+showDepend (OrLaterVersionOf v p u) = Disp.text ">=" <> disp p <-> disp v <> dispUses u
+showDepend (OrEarlierVersionOf v p u) = Disp.text "<=" <> disp p <-> disp v <> dispUses u
showDepend (DependEither dep_groups0)
= Disp.text "|| " <> spaceParens dep_groups
where dep_groups = map (spaceParens . map disp) dep_groups0
spaceParens ds = Disp.parens (Disp.space <> Disp.hsep ds <> Disp.space)
showDepend (DependIfUse useflag dep@(DependEither _))
- = Disp.text useflag <> Disp.text "? " <> disp dep
+ = disp useflag <> Disp.text "? " <> disp dep
showDepend (DependIfUse useflag dep)
- = Disp.text useflag <> Disp.text "? " <> Disp.parens (disp dep)
-showDepend (ThisMajorOf v p) = Disp.char '=' <> disp p <-> disp v <> Disp.char '*'
+ = disp useflag <> Disp.text "? " <> Disp.parens (disp dep)
+showDepend (ThisMajorOf v p u) = Disp.char '=' <> disp p <-> disp v <> Disp.char '*' <> dispUses u
showDepend (AllOf dp ) = Disp.text "( " <> hsep (map showDepend dp) <> Disp.text " )"
{- Here goes code for dependencies simplification -}
simplify_group_table :: PackageName ->
+ [UseFlag] ->
Maybe Version ->
Maybe Version ->
Maybe Version ->
@@ -64,26 +65,26 @@ simplify_group_table :: PackageName ->
-- simplify_group_table p ol l e oe exact
-- 1) trivial cases:
-simplify_group_table p Nothing Nothing Nothing Nothing Nothing = error $ display p ++ ": unsolvable constraints"
-simplify_group_table p (Just v) Nothing Nothing Nothing Nothing = [OrLaterVersionOf v p]
-simplify_group_table p Nothing (Just v) Nothing Nothing Nothing = [LaterVersionOf v p]
-simplify_group_table p Nothing Nothing (Just v) Nothing Nothing = [EarlierVersionOf v p]
-simplify_group_table p Nothing Nothing Nothing (Just v) Nothing = [OrEarlierVersionOf v p]
-simplify_group_table p Nothing Nothing Nothing Nothing (Just v) = [ThisVersionOf v p]
+simplify_group_table p u Nothing Nothing Nothing Nothing Nothing = error $ display p ++ ": unsolvable constraints"
+simplify_group_table p u (Just v) Nothing Nothing Nothing Nothing = [OrLaterVersionOf v p u]
+simplify_group_table p u Nothing (Just v) Nothing Nothing Nothing = [LaterVersionOf v p u]
+simplify_group_table p u Nothing Nothing (Just v) Nothing Nothing = [EarlierVersionOf v p u]
+simplify_group_table p u Nothing Nothing Nothing (Just v) Nothing = [OrEarlierVersionOf v p u]
+simplify_group_table p u Nothing Nothing Nothing Nothing (Just v) = [ThisVersionOf v p u]
-- 2) simplification passes
-simplify_group_table p (Just (Version v1 _ _ _)) Nothing (Just (Version v2 _ _ _)) Nothing Nothing
+simplify_group_table p 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]
- | otherwise = [OrLaterVersionOf (Version v1 Nothing [] 0) p, EarlierVersionOf (Version v2 Nothing [] 0) p]
+ | (init v1 == init v2) && (last v2 == last v1 + 1) = [ThisMajorOf (Version v1 Nothing [] 0) p u]
+ | otherwise = [OrLaterVersionOf (Version v1 Nothing [] 0) p u, EarlierVersionOf (Version v2 Nothing [] 0) p u]
-- TODO: simplify constraints of type: >=a-v1; > a-v2 and such
--- o3) therwise sink:
-simplify_group_table p (Just v) l@(_) e@(_) oe@(_) exact@(_) = OrLaterVersionOf v p : simplify_group_table p Nothing l e oe exact
-simplify_group_table p ol@(Nothing) (Just v) e@(_) oe@(_) exact@(_) = LaterVersionOf v p : simplify_group_table p ol Nothing e oe exact
-simplify_group_table p ol@(Nothing) l@(Nothing) (Just v) oe@(_) exact@(_) = EarlierVersionOf v p : simplify_group_table p ol l Nothing oe exact
-simplify_group_table p ol@(Nothing) l@(Nothing) e@(Nothing) (Just v) exact@(_) = OrEarlierVersionOf v p : simplify_group_table p ol l e Nothing exact
+-- 3) otherwise sink:
+simplify_group_table p u (Just v) l@(_) e@(_) oe@(_) exact@(_) = OrLaterVersionOf v p u: simplify_group_table p u Nothing l e oe exact
+simplify_group_table p u ol@(Nothing) (Just v) e@(_) oe@(_) exact@(_) = LaterVersionOf v p u: simplify_group_table p u ol Nothing e oe exact
+simplify_group_table p u ol@(Nothing) l@(Nothing) (Just v) oe@(_) exact@(_) = EarlierVersionOf v p u: simplify_group_table p u ol l Nothing oe exact
+simplify_group_table p u ol@(Nothing) l@(Nothing) e@(Nothing) (Just v) exact@(_) = OrEarlierVersionOf v p u: simplify_group_table p u ol l e Nothing exact
-- already defined earlier
-- simplify_group_table p ol@(Nothing) l@(Nothing) e@(Nothing) oe@(Nothing) (Just v) = OrEarlierVersionOf v p : simplify_group_table p ol l e oe Nothing
@@ -91,9 +92,10 @@ simplify_group_table p ol@(Nothing) l@(Nothing) e@(Nothing) (Just v) exa
-- 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)] = [dep]
-simplify_group [dep@(ThisMajorOf _v _p)] = [dep]
+simplify_group [dep@(AnyVersionOf _package _u)] = [dep]
+simplify_group [dep@(ThisMajorOf _v _p _u)] = [dep]
simplify_group deps = simplify_group_table package
+ uses
min_or_later_v -- >=
min_later_v -- >
max_earlier_v -- <
@@ -101,6 +103,7 @@ simplify_group deps = simplify_group_table package
exact_this_v -- ==
where
package = fromJust.getPackage $ 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
@@ -110,19 +113,19 @@ simplify_group deps = simplify_group_table package
[v] -> Just v
xs -> error $ "too many exact versions:" ++ show xs
--
- earlier_v (EarlierVersionOf v _p) = Just v
+ earlier_v (EarlierVersionOf v _p _u) = Just v
earlier_v _ = Nothing
- or_earlier_v (OrEarlierVersionOf v _p) = Just v
+ or_earlier_v (OrEarlierVersionOf v _p _u) = Just v
or_earlier_v _ = Nothing
- later_v (LaterVersionOf v _p) = Just v
+ later_v (LaterVersionOf v _p _u) = Just v
later_v _ = Nothing
- or_later_v (OrLaterVersionOf v _p) = Just v
+ or_later_v (OrLaterVersionOf v _p _u) = Just v
or_later_v _ = Nothing
- this_v (ThisVersionOf v _p) = Just v
+ this_v (ThisVersionOf v _p _u) = Just v
this_v _ = Nothing
--
safe_minimum xs = case catMaybes xs of
@@ -145,15 +148,39 @@ simplify_deps deps = (concatMap (simplify_group.nub) $
cmpMaybe _ _ = False
--
getPackage :: Dependency -> Maybe PackageName
-getPackage (AnyVersionOf package) = Just package
-getPackage (ThisVersionOf _version package) = Just package
-getPackage (LaterVersionOf _version package) = Just package
-getPackage (EarlierVersionOf _version package) = Just package
-getPackage (OrLaterVersionOf _version package) = Just package
-getPackage (OrEarlierVersionOf _version package) = Just package
+getPackage (AnyVersionOf package _uses) = Just package
+getPackage (ThisVersionOf _version package _uses) = Just package
+getPackage (LaterVersionOf _version package _uses) = Just package
+getPackage (EarlierVersionOf _version package _uses) = Just package
+getPackage (OrLaterVersionOf _version package _uses) = Just package
+getPackage (OrEarlierVersionOf _version package _uses) = Just package
getPackage (DependEither _dependency ) = Nothing
getPackage (DependIfUse _useFlag _Dependency) = Nothing
-getPackage (ThisMajorOf _version package) = Just package
+getPackage (ThisMajorOf _version package _uses) = Just package
+
+getUses :: Dependency -> Maybe [UseFlag]
+getUses (AnyVersionOf _p u) = Just u
+getUses (ThisVersionOf _v _p u) = Just u
+getUses (LaterVersionOf _v _p u) = Just u
+getUses (EarlierVersionOf _v _p u) = Just u
+getUses (OrLaterVersionOf _v _p u) = Just u
+getUses (OrEarlierVersionOf _v _p u) = Just u
+getUses (DependEither _d) = Nothing
+getUses (DependIfUse _u _d) = Nothing
+getUses (ThisMajorOf _v _p u) = Just u
+
--
getPackagePart :: Dependency -> PackageName
getPackagePart dep = fromJust (getPackage dep)
+
+--
+addDepUseFlag :: Dependency -> UseFlag -> Dependency
+addDepUseFlag (AnyVersionOf p u) n = AnyVersionOf p (n:u)
+addDepUseFlag (ThisVersionOf v p u) n = ThisVersionOf v p (n:u)
+addDepUseFlag (LaterVersionOf v p u) n = LaterVersionOf v p (n:u)
+addDepUseFlag (EarlierVersionOf v p u) n = EarlierVersionOf v p (n:u)
+addDepUseFlag (OrLaterVersionOf v p u) n = OrLaterVersionOf v p (n:u)
+addDepUseFlag (OrEarlierVersionOf v p u) n = OrEarlierVersionOf v p (n:u)
+addDepUseFlag (ThisMajorOf v p u) n = ThisMajorOf v p (n:u)
+addDepUseFlag (DependEither d) n = DependEither $ map (\d' -> map (flip addDepUseFlag n) d') d
+addDepUseFlag (DependIfUse u d) n = DependIfUse u (addDepUseFlag d n)
diff --git a/Portage/Host.hs b/Portage/Host.hs
index 5733a7b..d71390c 100644
--- a/Portage/Host.hs
+++ b/Portage/Host.hs
@@ -38,7 +38,7 @@ getInfo = fromJust `fmap`
----------
getPaludisInfo :: IO (Maybe LocalInfo)
-getPaludisInfo = fmap parsePaludisInfo <$> run_cmd "paludis --info"
+getPaludisInfo = fmap parsePaludisInfo <$> run_cmd "cave info"
parsePaludisInfo :: String -> LocalInfo
parsePaludisInfo text =
@@ -52,16 +52,14 @@ parsePaludisInfo text =
["Repository", nm] -> return (init nm)
_ -> fail "not a repository chunk"
let dict = [ (head ln, unwords (tail ln)) | ln <- map words lns ]
- location <- lookup "location:" dict
- distfiles <- lookup "distdir:" dict
+ location <- lookup "location" dict
+ distfiles <- lookup "distdir" dict
return (name, (location, distfiles))
- knownRepos = ["installed-virtuals", "virtuals", "gentoo", "installed"]
-
mkLocalInfo :: [(String, (String, String))] -> Maybe LocalInfo
mkLocalInfo repos = do
(gentooLocation, gentooDistfiles) <- lookup "gentoo" repos
- let overlays = [ loc | (name, (loc, _dist)) <- repos, name `notElem` knownRepos ]
+ let overlays = [ loc | (name, (loc, _dist)) <- repos ]
return (LocalInfo
{ distfiles_dir = gentooDistfiles
, portage_dir = gentooLocation
diff --git a/Portage/Resolve.hs b/Portage/Resolve.hs
index 090629b..1f66b72 100644
--- a/Portage/Resolve.hs
+++ b/Portage/Resolve.hs
@@ -1,6 +1,10 @@
{-# LANGUAGE PatternGuards #-}
-module Portage.Resolve where
+module Portage.Resolve
+ ( resolveCategory
+ , resolveCategories
+ , resolveFullPortageName
+ ) where
import qualified Portage.Overlay as Overlay
import qualified Portage.PackageId as Portage
@@ -69,4 +73,3 @@ resolveFullPortageName overlay pn =
, mkC "net-libs"
, mkC "sci-libs"
]
-
diff --git a/Portage/Use.hs b/Portage/Use.hs
new file mode 100644
index 0000000..b12ce03
--- /dev/null
+++ b/Portage/Use.hs
@@ -0,0 +1,50 @@
+module Portage.Use (
+ -- * main structures
+ UseFlag(..),
+ Use,
+ dispUses,
+ -- * helpers
+ mkUse,
+ mkNotUse,
+ mkQUse
+ ) where
+
+import qualified Text.PrettyPrint as Disp
+import Text.PrettyPrint ((<>))
+import Distribution.Text ( Text(..) )
+
+-- | Use variable modificator
+data UseFlag = UseFlag Use -- ^ no modificator
+ | E UseFlag -- ^ = modificator (Equiv mark)
+ | Q UseFlag -- ^ ? modificator (Question mark)
+ | X UseFlag -- ^ ! modificator (eXclamation mark)
+ | N UseFlag -- ^ - modificator
+ deriving (Eq,Show,Ord,Read)
+
+-- |
+mkUse :: Use -> UseFlag
+mkUse = UseFlag
+
+mkNotUse :: Use -> UseFlag
+mkNotUse = UseFlag
+
+mkQUse :: Use -> UseFlag
+mkQUse = Q . UseFlag
+
+
+instance Text UseFlag where
+ disp = showModificator
+
+showModificator :: UseFlag -> Disp.Doc
+showModificator (UseFlag u) = Disp.text u
+showModificator (X u) = Disp.char '!' <> disp u
+showModificator (Q u) = disp u <> Disp.char '?'
+showModificator (E u) = disp u <> Disp.char '='
+showModificator (N u) = Disp.char '-' <> disp u
+
+dispUses :: [UseFlag] -> Disp.Doc
+dispUses [] = Disp.empty
+dispUses us = Disp.brackets $ Disp.hcat $ (Disp.punctuate (Disp.text ", ")) $ map disp us
+
+type Use = String
+
diff --git a/Status.hs b/Status.hs
index 673c707..a6d1be0 100644
--- a/Status.hs
+++ b/Status.hs
@@ -1,5 +1,6 @@
module Status
( FileStatus(..)
+ , StatusDirection(..)
, fromStatus
, status
, runStatus
@@ -7,8 +8,11 @@ module Status
import AnsiColor
+import qualified Portage.Version as V (versionNumber)
+
import Portage.Overlay
import Portage.PackageId
+import Portage.Resolve
import Control.Monad.State
@@ -17,6 +21,7 @@ import qualified Data.List as List
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Char
+import Data.Function (on)
import qualified Data.Map as Map
import Data.Map as Map (Map)
@@ -24,16 +29,29 @@ import qualified Data.Traversable as T
import Control.Applicative
-- cabal
+import Distribution.Client.Types ( Repo, SourcePackageDb(..), SourcePackage(..) )
import Distribution.Verbosity
-import Distribution.Simple.Utils (equating, comparing)
+import Distribution.Package (pkgName)
+import Distribution.Simple.Utils (comparing, die, equating)
import Distribution.Text ( display, simpleParse )
-import Distribution.Simple.Utils ( die )
+
+import qualified Distribution.Client.PackageIndex as CabalInstall
+import qualified Distribution.Client.IndexUtils as CabalInstall
+
+import Hackage (defaultRepo)
+
+data StatusDirection
+ = PortagePlusOverlay
+ | OverlayToPortage
+ | HackageToOverlay
+ deriving Eq
data FileStatus a
= Same a
| Differs a a
| OverlayOnly a
| PortageOnly a
+ | HackageOnly a
deriving (Show,Eq)
instance Ord a => Ord (FileStatus a) where
@@ -46,6 +64,7 @@ instance Functor FileStatus where
Differs a b -> Differs (f a) (f b)
OverlayOnly a -> OverlayOnly (f a)
PortageOnly a -> PortageOnly (f a)
+ HackageOnly a -> HackageOnly (f a)
fromStatus :: FileStatus a -> a
fromStatus fs =
@@ -54,10 +73,27 @@ fromStatus fs =
Differs a _ -> a -- second status is lost
OverlayOnly a -> a
PortageOnly a -> a
+ HackageOnly a -> a
+
+
+
+loadHackage :: Verbosity -> Distribution.Client.Types.Repo -> Overlay -> IO [[PackageId]]
+loadHackage verbosity repo overlay = do
+ SourcePackageDb { packageIndex = pindex } <- CabalInstall.getSourcePackages verbosity [repo]
+ let get_cat cabal_pkg = case resolveCategories overlay (pkgName cabal_pkg) of
+ [cat] -> cat
+ _ -> {- ambig -} Category "dev-haskell"
+ pkg_infos = map ( reverse . take 3 . reverse -- hackage usually has a ton of older versions
+ . map ((\p -> fromCabalPackageId (get_cat p) p)
+ . packageInfoId))
+ (CabalInstall.allPackagesByName pindex)
+ return pkg_infos
status :: Verbosity -> FilePath -> FilePath -> IO (Map PackageName [FileStatus ExistingEbuild])
-status _verbosity portdir overlaydir = do
+status verbosity portdir overlaydir = do
+ let repo = defaultRepo overlaydir
overlay <- loadLazy overlaydir
+ hackage <- loadHackage verbosity repo overlay
portage <- filterByHerd ("haskell" `elem`) <$> loadLazy portdir
let (over, both, port) = portageDiff (overlayMap overlay) (overlayMap portage)
@@ -71,10 +107,21 @@ status _verbosity portdir overlaydir = do
then Same e1
else Differs e1 e2
- let meld = Map.unionsWith (\a b -> List.sort (a++b))
+ let p_to_ee :: PackageId -> ExistingEbuild
+ p_to_ee p = ExistingEbuild p cabal_p ebuild_path
+ where Just cabal_p = toCabalPackageId p -- lame doubleconv
+ ebuild_path = packageIdToFilePath p
+ mk_fake_ee :: [PackageId] -> (PackageName, [ExistingEbuild])
+ mk_fake_ee ~pkgs@(p:_) = (packageId p, map p_to_ee pkgs)
+
+ map_diff = Map.differenceWith (\le re -> Just $ foldr (List.deleteBy (equating ebuildId)) le re)
+ hack = ((Map.fromList $ map mk_fake_ee hackage) `map_diff` overlayMap overlay) `map_diff` overlayMap portage
+
+ meld = Map.unionsWith (\a b -> List.sort (a++b))
[ Map.map (map PortageOnly) port
, both'
, Map.map (map OverlayOnly) over
+ , Map.map (map HackageOnly) hack
]
return meld
@@ -85,10 +132,12 @@ lookupEbuildWith overlay pkgid = do
ebuilds <- Map.lookup (packageId pkgid) overlay
List.find (\e -> ebuildId e == pkgid) ebuilds
-runStatus :: Verbosity -> FilePath -> FilePath -> Bool -> [String] -> IO ()
-runStatus verbosity portdir overlaydir toPortageFlag pkgs = do
- let pkgFilter | toPortageFlag = toPortageFilter
- | otherwise = id
+runStatus :: Verbosity -> FilePath -> FilePath -> StatusDirection -> [String] -> IO ()
+runStatus verbosity portdir overlaydir direction pkgs = do
+ let pkgFilter = case direction of
+ OverlayToPortage -> toPortageFilter
+ PortagePlusOverlay -> id
+ HackageToOverlay -> fromHackageFilter
pkgs' <- forM pkgs $ \p ->
case simpleParse p of
Nothing -> die ("Could not parse package name: " ++ p ++ ". Format cat/pkg")
@@ -108,6 +157,7 @@ toPortageFilter = Map.mapMaybe $ \ sts ->
let inPortage = flip filter sts $ \st ->
case st of
OverlayOnly _ -> False
+ HackageOnly _ -> False
_ -> True
latestPortageVersion = List.maximum $ map (pkgVersion . ebuildId . fromStatus) inPortage
interestingPackages = flip filter sts $ \st ->
@@ -119,12 +169,29 @@ toPortageFilter = Map.mapMaybe $ \ sts ->
then Just sts
else Nothing
+-- |Only return packages that exist in overlay or portage but look outdated
+fromHackageFilter :: Map PackageName [FileStatus ExistingEbuild] -> Map PackageName [FileStatus ExistingEbuild]
+fromHackageFilter = Map.mapMaybe $ \ sts ->
+ let inEbuilds = flip filter sts $ \st ->
+ case st of
+ HackageOnly _ -> False
+ _ -> True
+ -- treat versionNumber=[9999*] as oldest version not avoid masking hackage releases
+ mangle_live_versions v = case V.versionNumber v of
+ [n] | n >= 9999 && (all (== '9') . show) n -> v {versionNumber=[-1]}
+ _ -> v
+ latestVersion = List.maximumBy (compare `on` mangle_live_versions . pkgVersion . ebuildId . fromStatus) sts
+ in case latestVersion of
+ HackageOnly _ | not (null inEbuilds) -> Just sts
+ _ -> Nothing
+
statusPrinter :: Map PackageName [FileStatus ExistingEbuild] -> IO ()
statusPrinter packages = do
putStrLn $ toColor (Same "Green") ++ ": package in portage and overlay are the same"
putStrLn $ toColor (Differs "Yellow" "") ++ ": package in portage and overlay differs"
putStrLn $ toColor (OverlayOnly "Red") ++ ": package only exist in the overlay"
putStrLn $ toColor (PortageOnly "Magenta") ++ ": package only exist in the portage tree"
+ putStrLn $ toColor (HackageOnly "Cyan") ++ ": package only exist on hackage"
forM_ (Map.toAscList packages) $ \(pkg, ebuilds) -> do
let (PackageName c p) = pkg
putStr $ display c ++ '/' : bold (display p)
@@ -142,7 +209,7 @@ toColor st = inColor c False Default (fromStatus st)
(Differs _ _) -> Yellow
(OverlayOnly _) -> Red
(PortageOnly _) -> Magenta
-
+ (HackageOnly _) -> Cyan
portageDiff :: EMap -> EMap -> (EMap, EMap, EMap)
portageDiff p1 p2 = (in1, ins, in2)
@@ -171,4 +238,3 @@ equal' = equating essence
essence = filter (not . isEmpty) . filter (not . isComment) . L.lines
isComment = L.isPrefixOf (L.pack "#") . L.dropWhile isSpace
isEmpty = L.null . L.dropWhile isSpace
-
diff --git a/hackport.cabal b/hackport.cabal
index b111abc..a6a23ae 100644
--- a/hackport.cabal
+++ b/hackport.cabal
@@ -1,5 +1,5 @@
Name: hackport
-Version: 0.2.16
+Version: 0.2.17
License: GPL
License-file: LICENSE
Author: Henning G√ľnther, Duncan Coutts, Lennart Kolmodin
@@ -68,9 +68,10 @@ Executable hackport
CacheFile
Diff
Error
- Paths_hackport
+ Hackage
Main
Overlays
+ Paths_hackport
Portage.Version
Portage.Dependency
Portage.GHCCore
diff --git a/tests/resolveCat.hs b/tests/resolveCat.hs
index 051d09a..9a69977 100644
--- a/tests/resolveCat.hs
+++ b/tests/resolveCat.hs
@@ -3,6 +3,7 @@ import Test.HUnit
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 qualified Distribution.Package as Cabal
@@ -12,7 +13,8 @@ tests = TestList [ TestLabel "resolve cabal" (test_resolveCategory "dev-haskell"
test_resolveCategory :: String -> String -> Test
test_resolveCategory cat pkg = TestCase $ do
- portage <- Portage.loadLazy "/usr/portage"
+ 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) cabal)
diff --git a/unused/Fetch.hs b/unused/Fetch.hs
deleted file mode 100644
index 9595a52..0000000
--- a/unused/Fetch.hs
+++ /dev/null
@@ -1,78 +0,0 @@
--- module unused
-module Fetch(downloadTarball,downloadFileVerify) where
-
-import Prelude hiding (catch)
-
-import Network.HTTP (ConnError(..),Request(..),simpleHTTP
- ,Response(..),RequestMethod(..))
-import Network.URI (URI,uriPath,parseURI)
-import Text.Regex (Regex,mkRegex,matchRegex)
-import System.GPG
-import Control.Monad.Error
-import System.Directory
-import System.FilePath
-import Data.Typeable
-
-import Error
-import Action
-
-filenameRegex :: Regex
-filenameRegex = mkRegex "^.*?/([^/]*?)"
-
-uriToFileName :: URI -> Maybe FilePath
-uriToFileName uri = maybe Nothing (\x->Just (head x)) (matchRegex filenameRegex (uriPath uri))
-
-downloadURI :: FilePath -- ^ a directory to store the file
- -> URI -- ^ the url
- -> IO FilePath -- ^ the path of the downloaded file
-downloadURI path uri = do
- fileName <- maybe (throwEx $ InvalidTarballURL (show uri) "URL doesn't contain a filename") return (uriToFileName uri)
- httpResult <- simpleHTTP request
- Response {rspCode=code,rspBody=body,rspReason=reason} <- either (\x->throwError $ DownloadFailed (show uri) "Connection failed") return httpResult
- if code==(2,0,0) then (do
- let writePath=path </> fileName
- writeFile writePath body
- return writePath) else throwEx $ DownloadFailed (show uri) ("Code "++show code++":"++reason)
- where
- request = Request
- {rqURI=uri
- ,rqMethod=GET
- ,rqHeaders=[]
- ,rqBody=""}
-
-
-downloadFileVerify ::
- FilePath -> -- ^ the directory to store the files
- String -> -- ^ the url of the tarball
- String -> -- ^ the url of the signature
- IO (FilePath,FilePath) -- ^ the tarballs and signatures path
-downloadFileVerify path url sigurl = do
- tarballPath <- downloadTarball path url
- sigPath <- downloadSig path sigurl `catchEx` \e-> do
- removeFile tarballPath
- throwEx x
- verified <- verifyFile stdOptions tarballPath sigPath
- if verified then return (tarballPath,sigPath) else (do
- removeFile tarballPath
- removeFile sigPath
- throwEx $ VerificationFailed url sigurl)
-
-downloadTarball ::
- FilePath ->
- String ->
- IO FilePath
-downloadTarball dir url = download dir url InvalidTarballURL
-
-downloadSig ::
- FilePath ->
- String ->
- IO FilePath
-downloadSig dir url = download dir url InvalidSignatureURL
-
-download :: FilePath -- ^ the folder to store the file in
- -> String -- ^ the url
- -> (String -> String -> HackPortError) -- ^ a function to construct an error
- -> IO FilePath -- ^ the resulting file's path
-download dir url errFunc = do
- parsedURL <- maybe (throwEx $ errFunc url "Parsing failed") return (parseURI url)
- downloadURI dir parsedURL