summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLennartKolmodin <>2011-01-05 15:33:04 (GMT)
committerLuite Stegeman <luite@luite.com>2011-01-05 15:33:04 (GMT)
commit3686aa848e9f424694f70afb28ed2b28a307c03c (patch)
treebf5c6fdbde1558ca27fffd954fd5342e7b636ce4
parent57c31c38963d7f979d080509cf8f505eebb238db (diff)
version 0.2.100.2.10
-rw-r--r--Cabal2Ebuild.hs13
-rw-r--r--Error.hs3
-rw-r--r--Main-GuessGHC.hs27
-rw-r--r--Main.hs26
-rw-r--r--MaybeRead.hs14
-rw-r--r--Merge.hs61
-rw-r--r--Merge/Dependencies.hs58
-rw-r--r--P2.hs104
-rw-r--r--Portage/Dependency.hs4
-rw-r--r--Portage/EBuild.hs37
-rw-r--r--Portage/GHCCore.hs305
-rw-r--r--Portage/Host.hs97
-rw-r--r--Portage/Metadata.hs31
-rw-r--r--Portage/Overlay.hs70
-rw-r--r--Portage/PackageId.hs15
-rw-r--r--Status.hs69
-rw-r--r--cabal-install-0.8.2/Distribution/Client/Dependency/Bogus.hs129
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/BuildReports/Anonymous.hs (renamed from cabal-install-0.8.2/Distribution/Client/BuildReports/Anonymous.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/BuildReports/Storage.hs (renamed from cabal-install-0.8.2/Distribution/Client/BuildReports/Storage.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/BuildReports/Types.hs (renamed from cabal-install-0.8.2/Distribution/Client/BuildReports/Types.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/BuildReports/Upload.hs (renamed from cabal-install-0.8.2/Distribution/Client/BuildReports/Upload.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Check.hs (renamed from cabal-install-0.8.2/Distribution/Client/Check.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Config.hs (renamed from cabal-install-0.8.2/Distribution/Client/Config.hs)90
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Configure.hs (renamed from cabal-install-0.8.2/Distribution/Client/Configure.hs)10
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency.hs (renamed from cabal-install-0.8.2/Distribution/Client/Dependency.hs)161
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency/TopDown.hs (renamed from cabal-install-0.8.2/Distribution/Client/Dependency/TopDown.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency/TopDown/Constraints.hs (renamed from cabal-install-0.8.2/Distribution/Client/Dependency/TopDown/Constraints.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency/TopDown/Types.hs (renamed from cabal-install-0.8.2/Distribution/Client/Dependency/TopDown/Types.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency/Types.hs (renamed from cabal-install-0.8.2/Distribution/Client/Dependency/Types.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Fetch.hs (renamed from cabal-install-0.8.2/Distribution/Client/Fetch.hs)149
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/GZipUtils.hs44
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Haddock.hs (renamed from cabal-install-0.8.2/Distribution/Client/Haddock.hs)12
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/HttpUtils.hs (renamed from cabal-install-0.8.2/Distribution/Client/HttpUtils.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/IndexUtils.hs (renamed from cabal-install-0.8.2/Distribution/Client/IndexUtils.hs)16
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Init.hs (renamed from cabal-install-0.8.2/Distribution/Client/Init.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Init/Heuristics.hs (renamed from cabal-install-0.8.2/Distribution/Client/Init/Heuristics.hs)8
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Init/Licenses.hs (renamed from cabal-install-0.8.2/Distribution/Client/Init/Licenses.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Init/Types.hs (renamed from cabal-install-0.8.2/Distribution/Client/Init/Types.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Install.hs (renamed from cabal-install-0.8.2/Distribution/Client/Install.hs)740
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/InstallPlan.hs (renamed from cabal-install-0.8.2/Distribution/Client/InstallPlan.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/InstallSymlink.hs (renamed from cabal-install-0.8.2/Distribution/Client/InstallSymlink.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/List.hs (renamed from cabal-install-0.8.2/Distribution/Client/List.hs)4
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/PackageIndex.hs (renamed from cabal-install-0.8.2/Distribution/Client/PackageIndex.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/PackageUtils.hs (renamed from cabal-install-0.8.2/Distribution/Client/PackageUtils.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Setup.hs (renamed from cabal-install-0.8.2/Distribution/Client/Setup.hs)106
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/SetupWrapper.hs (renamed from cabal-install-0.8.2/Distribution/Client/SetupWrapper.hs)11
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/SrcDist.hs (renamed from cabal-install-0.8.2/Distribution/Client/SrcDist.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Tar.hs (renamed from cabal-install-0.8.2/Distribution/Client/Tar.hs)5
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Types.hs (renamed from cabal-install-0.8.2/Distribution/Client/Types.hs)75
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Unpack.hs (renamed from cabal-install-0.8.2/Distribution/Client/Unpack.hs)104
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Update.hs (renamed from cabal-install-0.8.2/Distribution/Client/Update.hs)4
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Upload.hs (renamed from cabal-install-0.8.2/Distribution/Client/Upload.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Utils.hs (renamed from cabal-install-0.8.2/Distribution/Client/Utils.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/Win32SelfUpgrade.hs (renamed from cabal-install-0.8.2/Distribution/Client/Win32SelfUpgrade.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Client/World.hs132
-rw-r--r--cabal-install-0.9.5_rc20101226/Distribution/Compat/Exception.hs (renamed from cabal-install-0.8.2/Distribution/Compat/Exception.hs)0
-rw-r--r--cabal-install-0.9.5_rc20101226/LICENSE (renamed from cabal-install-0.8.2/LICENSE)0
-rw-r--r--cabal-install-0.9.5_rc20101226/Main.hs388
-rw-r--r--cabal-install-0.9.5_rc20101226/Paths_cabal_install.hs (renamed from cabal-install-0.8.2/Paths_cabal_install.hs)2
-rw-r--r--cabal-install-0.9.5_rc20101226/README153
-rw-r--r--cabal-install-0.9.5_rc20101226/Setup.hs2
-rw-r--r--cabal-install-0.9.5_rc20101226/bash-completion/cabal24
-rw-r--r--cabal-install-0.9.5_rc20101226/bootstrap.sh241
-rw-r--r--cabal-install-0.9.5_rc20101226/cabal-install.cabal (renamed from cabal-install-0.8.2/cabal-install.cabal)23
-rw-r--r--cabal-install-0.9.5_rc20101226/changelog100
-rw-r--r--cabal-install-0.9.5_rc20101226/tests/test-cabal-install9
-rw-r--r--cabal-install-0.9.5_rc20101226/tests/test-cabal-install-user8
-rw-r--r--hackport.cabal63
68 files changed, 2741 insertions, 1006 deletions
diff --git a/Cabal2Ebuild.hs b/Cabal2Ebuild.hs
index 0d1ca5e..b699d4c 100644
--- a/Cabal2Ebuild.hs
+++ b/Cabal2Ebuild.hs
@@ -24,8 +24,7 @@
module Cabal2Ebuild
(cabal2ebuild
,convertDependencies
- ,convertDependency
- ,default_ghc_dependency) where
+ ,convertDependency) where
import qualified Distribution.PackageDescription as Cabal
(PackageDescription(..))
@@ -43,9 +42,6 @@ import qualified Portage.EBuild as Portage
import qualified Portage.EBuild as E
import Portage.Version
-default_ghc_dependency :: Dependency
-default_ghc_dependency = OrLaterVersionOf (Version [6,8,1] Nothing [] 0) (Portage.mkPackageName "dev-lang" "ghc")
-
cabal2ebuild :: Cabal.PackageDescription -> Portage.EBuild
cabal2ebuild pkg = Portage.ebuildTemplate {
E.name = map toLower cabalPkgName,
@@ -53,7 +49,6 @@ cabal2ebuild pkg = Portage.ebuildTemplate {
E.description = if null (Cabal.synopsis pkg) then Cabal.description pkg
else Cabal.synopsis pkg,
E.homepage = thisHomepage,
- E.src_uri = thisSRC_URI,
E.license = Cabal.license pkg,
E.my_pn = if any isUpper cabalPkgName then Just cabalPkgName else Nothing,
E.features = E.features E.ebuildTemplate
@@ -67,9 +62,6 @@ cabal2ebuild pkg = Portage.ebuildTemplate {
thisHomepage = if (null $ Cabal.homepage pkg)
then E.homepage E.ebuildTemplate
else Cabal.homepage pkg
- thisSRC_URI = if (null $ Cabal.pkgUrl pkg)
- then E.src_uri E.ebuildTemplate
- else Cabal.pkgUrl pkg
convertDependencies :: Portage.Category -> [Cabal.Dependency] -> [Dependency]
convertDependencies category = concatMap (convertDependency category)
@@ -93,7 +85,8 @@ convertDependency category (Cabal.Dependency pname versionRange)
)(\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
+ )(\r1 r2 -> r1 ++ r2 -- ^ @\"_ && _\"@ intersection
+ )(\dp -> [AllOf dp ] -- ^ @\"(_)\"@ parentheses
)
where
flatten :: [Dependency] -> [[Dependency]]
diff --git a/Error.hs b/Error.hs
index ae618e8..7a6fa66 100644
--- a/Error.hs
+++ b/Error.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS -fglasgow-exts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
module Error (HackPortError(..), throwEx, catchEx, hackPortShowError) where
import Data.Typeable
diff --git a/Main-GuessGHC.hs b/Main-GuessGHC.hs
new file mode 100644
index 0000000..3eaf317
--- /dev/null
+++ b/Main-GuessGHC.hs
@@ -0,0 +1,27 @@
+module Main where
+
+import System.Environment
+
+import Distribution.PackageDescription
+import Distribution.PackageDescription.Parse
+
+import Distribution.Text
+import Distribution.Verbosity
+
+import Portage.GHCCore
+
+main :: IO ()
+main = do
+ args <- getArgs
+ gpds <- mapM (readPackageDescription silent) args
+ mapM_ guess gpds
+
+guess :: GenericPackageDescription -> IO ()
+guess gpd = do
+ let pkg = package . packageDescription $ gpd
+ let mghc = minimumGHCVersionToBuildPackage gpd
+ putStr (display pkg)
+ putStr "\t\t"
+ putStrLn $ case mghc of
+ Nothing -> "Unknown"
+ Just (compiler, _pkgs) -> display compiler
diff --git a/Main.hs b/Main.hs
index 9af1b58..377e244 100644
--- a/Main.hs
+++ b/Main.hs
@@ -14,15 +14,13 @@ import Distribution.Simple.Setup
, flagToList
, optionVerbosity
)
-import Distribution.PackageDescription.Configuration
- ( flattenPackageDescription )
import Distribution.ReadE ( succeedReadE )
import Distribution.Simple.Command -- commandsRun
import Distribution.Simple.Utils ( die, cabalVersion, warn )
import qualified Distribution.PackageDescription.Parse as Cabal
import qualified Distribution.Package as Cabal
import Distribution.Verbosity (Verbosity, normal)
-import Distribution.Text (display)
+import Distribution.Text (display, simpleParse)
import Distribution.Client.Types
import Distribution.Client.Update
@@ -40,9 +38,6 @@ import System.Directory ( doesDirectoryExist )
import System.Exit ( exitFailure )
import System.FilePath ( (</>) )
-import qualified Cabal2Ebuild as C2E
-import qualified Portage.EBuild as E
-
import Diff
import Error
import Status
@@ -145,15 +140,18 @@ defaultMakeEbuildFlags = MakeEbuildFlags {
}
makeEbuildAction :: MakeEbuildFlags -> [String] -> GlobalFlags -> IO ()
-makeEbuildAction flags args _globalFlags = do
- when (null args) $
- die "make-ebuild needs at least one argument"
- let _verbosity = fromFlag (makeEbuildVerbosity flags)
- forM_ args $ \cabalFileName -> do
+makeEbuildAction flags args globalFlags = do
+ (catstr,cabals) <- case args of
+ (category:cabal1:cabaln) -> return (category, cabal1:cabaln)
+ _ -> throwEx (ArgumentError "make-ebuild needs at least two arguments. <category> <cabal-1> <cabal-n>")
+ cat <- case simpleParse catstr of
+ Just c -> return c
+ Nothing -> throwEx (ArgumentError ("could not parse category: " ++ catstr))
+ let verbosity = fromFlag (makeEbuildVerbosity flags)
+ overlayPath <- getOverlayPath verbosity (fromFlag $ globalPathToOverlay globalFlags)
+ forM_ cabals $ \cabalFileName -> do
pkg <- Cabal.readPackageDescription normal cabalFileName
- let ebuild = C2E.cabal2ebuild (flattenPackageDescription pkg)
- let ebuildFileName = E.name ebuild ++ "-" ++ E.version ebuild ++ ".ebuild"
- writeFile ebuildFileName (display ebuild)
+ mergeGenericPackageDescription verbosity overlayPath cat pkg False
makeEbuildCommand :: CommandUI MakeEbuildFlags
makeEbuildCommand = CommandUI {
diff --git a/MaybeRead.hs b/MaybeRead.hs
deleted file mode 100644
index cf739fd..0000000
--- a/MaybeRead.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module MaybeRead where
-
-import Data.List(find)
-import Text.Read
-import Text.ParserCombinators.ReadP
-
-readMaybe :: Read a => String -> Maybe a
-readMaybe = readsMaybe reads
-
-readsMaybe :: ReadS a -> String -> Maybe a
-readsMaybe func str = maybe Nothing (\x->Just (fst x)) (find (null.snd) (func str))
-
-readPMaybe :: ReadP a -> String -> Maybe a
-readPMaybe = readsMaybe.readP_to_S
diff --git a/Merge.hs b/Merge.hs
index ccb3419..e064bfe 100644
--- a/Merge.hs
+++ b/Merge.hs
@@ -1,15 +1,18 @@
{-# OPTIONS -XPatternGuards #-}
module Merge
- ( merge ) where
+ ( merge
+ , mergeGenericPackageDescription
+ ) where
import Control.Monad.Error
import Control.Exception
import Data.Maybe
import Data.List
import Distribution.Package
-import Distribution.Compiler (CompilerId(..), CompilerFlavor(GHC))
+-- import Distribution.Compiler (CompilerId(..), CompilerFlavor(GHC))
import Distribution.PackageDescription ( PackageDescription(..)
, FlagName(..)
+ , GenericPackageDescription
)
import Distribution.PackageDescription.Configuration
( finalizePackageDescription )
@@ -46,6 +49,8 @@ import qualified Portage.Host as Host
import qualified Portage.Overlay as Overlay
import qualified Portage.Resolve as Portage
+import qualified Portage.GHCCore as GHCCore
+
import qualified Merge.Dependencies as Merge
import Debug.Trace ( trace )
@@ -141,12 +146,13 @@ merge verbosity repo serverURI args overlayPath = do
info verbosity $ match_text ++ (display . packageInfoId $ avail)
let cabal_pkgId = packageInfoId selectedPkg
- norm_pkgId = Portage.normalizeCabalPackageId cabal_pkgId
- norm_pkgName = packageName norm_pkgId
+ norm_pkgName = packageName (Portage.normalizeCabalPackageId cabal_pkgId)
cat <- maybe (Portage.resolveCategory verbosity overlay norm_pkgName) return m_category
+ mergeGenericPackageDescription verbosity overlayPath cat (packageDescription selectedPkg) True
- let pkgGenericDesc = packageDescription selectedPkg
- Right (pkgDesc0, flags) =
+mergeGenericPackageDescription :: Verbosity -> FilePath -> Portage.Category -> GenericPackageDescription -> Bool -> IO ()
+mergeGenericPackageDescription verbosity overlayPath cat pkgGenericDesc fetch = do
+ let Right (pkgDesc0, flags) =
finalizePackageDescription
[ -- XXX: common things we should enable/disable?
-- (FlagName "small_base", True) -- try to use small base
@@ -155,29 +161,37 @@ merge verbosity repo serverURI args overlayPath = do
(\dep -> trace ("accepting dep(?): " ++ display dep) True)
-- (Nothing :: Maybe (Index.PackageIndex PackageIdentifier))
buildPlatform
- (CompilerId GHC (Cabal.Version [6,10,4] []))
+ (fst GHCCore.defaultGHC)
[] pkgGenericDesc
+
+ mminimumGHC = GHCCore.minimumGHCVersionToBuildPackage pkgGenericDesc
+ (compilerId, excludePkgs) = maybe GHCCore.defaultGHC id mminimumGHC
+
pkgDesc = let deps = [ Dependency pn (Cabal.simplifyVersionRange vr)
| Dependency pn vr <- buildDepends pkgDesc0
+ , pn `notElem` excludePkgs
]
in pkgDesc0 { buildDepends = deps }
- edeps = Merge.resolveDependencies pkgDesc
+ edeps = Merge.resolveDependencies pkgDesc (Just compilerId)
debug verbosity ("Selected flags: " ++ show flags)
+ info verbosity ("Guessing GHC version: " ++ maybe "could not guess" (display.fst) mminimumGHC)
- let ebuild = fixSrc serverURI (packageId pkgDesc)
- . (\e -> e { E.depend = Merge.dep edeps } )
+ let ebuild = (\e -> e { E.depend = Merge.dep edeps } )
. (\e -> e { E.depend_extra = Merge.dep_e edeps } )
. (\e -> e { E.rdepend = Merge.rdep edeps } )
. (\e -> e { E.rdepend_extra = Merge.rdep_e edeps } )
$ C2E.cabal2ebuild pkgDesc
mergeEbuild verbosity overlayPath (Portage.unCategory cat) ebuild
- fetchAndDigest
- verbosity
- (overlayPath </> display cat </> display norm_pkgName)
- (display cabal_pkgId <.> "tar.gz")
- (mkUri cabal_pkgId)
+ when fetch $ do
+ let cabal_pkgId = packageId pkgDesc
+ norm_pkgName = packageName (Portage.normalizeCabalPackageId cabal_pkgId)
+ fetchAndDigest
+ verbosity
+ (overlayPath </> display cat </> display norm_pkgName)
+ (display cabal_pkgId <.> "tar.gz")
+ (mkUri cabal_pkgId)
mkUri :: Cabal.PackageIdentifier -> URI
mkUri pid =
@@ -224,20 +238,3 @@ mergeEbuild verbosity target cat ebuild = do
createDirectoryIfMissing True edir
info verbosity $ "Writing " ++ elocal
writeFile epath (display ebuild)
-
-fixSrc :: URI -> PackageIdentifier -> E.EBuild -> E.EBuild
-fixSrc serverURI p ebuild =
- ebuild {
- E.src_uri = show $ serverURI {
- uriPath =
- uriPath serverURI
- </> display (pkgName p)
- </> display (pkgVersion p)
- </> display (pkgName p) ++ "-" ++ display (pkgVersion p)
- <.> "tar.gz"
- },
- E.homepage = case E.homepage ebuild of
- "" -> "http://hackage.haskell.org/package/"
- ++ display (pkgName p)
- x -> x
- }
diff --git a/Merge/Dependencies.hs b/Merge/Dependencies.hs
index c33d21b..75d6454 100644
--- a/Merge/Dependencies.hs
+++ b/Merge/Dependencies.hs
@@ -53,16 +53,23 @@ import Distribution.PackageDescription ( PackageDescription(..)
, extraLibs
, buildTools
, pkgconfigDepends
- , hasLibs )
+ , hasLibs
+ , specVersion
+ )
import Data.Maybe ( isNothing )
import Data.List ( nub )
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 Cabal2Ebuild as C2E
+import qualified Portage.GHCCore as GHCCore
+
import Debug.Trace ( trace )
-- | Dependencies of an ebuild
@@ -83,8 +90,8 @@ emptyEDep = EDep
dep_e = []
}
-resolveDependencies :: PackageDescription -> EDep
-resolveDependencies pkg =
+resolveDependencies :: PackageDescription -> Maybe CompilerId -> EDep
+resolveDependencies pkg mcompiler =
edeps
{
dep = Portage.simplify_deps ( dep edeps),
@@ -93,11 +100,13 @@ resolveDependencies pkg =
-- version as in dep
}
where
+ compiler = maybe (fst GHCCore.defaultGHC) id mcompiler
+
hasBuildableExes p = any (buildable . buildInfo) . executables $ p
treatAsLibrary = (not . hasBuildableExes) pkg || hasLibs pkg
haskell_deps = haskellDependencies pkg
- cabal_dep = cabalDependency pkg
- ghc_dep = ghcDependency pkg
+ cabal_dep = cabalDependency pkg compiler
+ ghc_dep = compilerIdToDependency compiler
extra_libs = findCLibs pkg
build_tools = buildToolsDependencies pkg
pkg_config = pkgConfigDependencies pkg
@@ -122,6 +131,7 @@ resolveDependencies pkg =
rdep = extra_libs ++ pkg_config
}
+
---------------------------------------------------------------
-- Haskell packages
---------------------------------------------------------------
@@ -135,19 +145,34 @@ haskellDependencies pkg =
-- Cabal Dependency
---------------------------------------------------------------
-cabalDependency :: PackageDescription -> Portage.Dependency
-cabalDependency 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")
(Cabal.Dependency (Cabal.PackageName "Cabal")
- (descCabalVersion pkg))
+ 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
+ finalCabalDep = Cabal.simplifyVersionRange
+ (Cabal.intersectVersionRanges
+ userCabalVersion
+ shippedCabalDep)
---------------------------------------------------------------
-- GHC Dependency
---------------------------------------------------------------
-ghcDependency :: PackageDescription -> Portage.Dependency
-ghcDependency _pkg = C2E.default_ghc_dependency
-
+compilerIdToDependency :: CompilerId -> Portage.Dependency
+compilerIdToDependency (CompilerId GHC versionNumbers) =
+ Portage.OrLaterVersionOf (Portage.fromCabalVersion versionNumbers) (Portage.mkPackageName "dev-lang" "ghc")
+
---------------------------------------------------------------
-- C Libraries
---------------------------------------------------------------
@@ -166,7 +191,6 @@ findCLibs (PackageDescription { library = lib, executables = exes }) =
notFound = [ p | p <- allE, isNothing (staticTranslateExtraLib p) ]
found = [ p | Just p <- map staticTranslateExtraLib allE ]
-
staticTranslateExtraLib :: String -> Maybe Portage.Dependency
staticTranslateExtraLib lib = lookup lib m
@@ -177,6 +201,7 @@ staticTranslateExtraLib lib = lookup lib m
, ("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"))
]
---------------------------------------------------------------
@@ -234,14 +259,20 @@ resolvePkgConfig (Cabal.Dependency (Cabal.PackageName pn) _cabalVersion) = do
table :: [(String, (String, String))]
table =
[("gconf-2.0", ("gnome-base", "gconf"))
+
,("gthread-2.0", ("dev-libs", "glib")) -- should be slot 2
+ ,("gio-2.0", ("dev-libs", "glib"))
+ ,("glib-2.0", ("dev-libs", "glib"))
+ ,("gobject-2.0", ("dev-libs", "glib"))
+
,("gtk+-2.0", ("x11-libs", "gtk+")) -- should be slot 2
+
,("cairo", ("x11-libs", "cairo"))
,("cairo-ps", ("x11-libs", "cairo"))
,("cairo-pdf", ("x11-libs", "cairo"))
,("cairo-svg", ("x11-libs", "cairo")) -- need [svg] for dev-haskell/cairo
+ ,("pangocairo", ("x11-libs", "cairo"))
,("pango", ("x11-libs", "pango"))
- ,("gio-2.0", ("dev-libs", "glib"))
,("libglade-2.0", ("gnome-base", "libglade"))
,("gnome-vfs-2.0", ("gnome-base", "gnome-vfs"))
,("gnome-vfs-module-2.0", ("gnome-base", "gnome-vfs"))
@@ -257,4 +288,5 @@ table =
,("librsvg-2.0", ("gnome-base","librsvg"))
,("vte", ("x11-libs","vte"))
,("gtkglext-1.0", ("x11-libs","gtkglext"))
+ ,("curl", ("net-misc", "curl"))
]
diff --git a/P2.hs b/P2.hs
deleted file mode 100644
index 3c32437..0000000
--- a/P2.hs
+++ /dev/null
@@ -1,104 +0,0 @@
-module P2 where
-
--- Module that respect categories.
--- Possibly to replace Portage.hs when the rest of the project has been
--- ported to this style.
-
-import BlingBling
-
-import Control.Arrow
-import Control.Monad
-
-import qualified Distribution.PackageDescription as Cabal
-
-import Data.Map (Map)
-import qualified Data.Map as Map
-import qualified Data.List as List
-
-import System.Directory
-import System.FilePath
-
-import Text.Regex
-
-import qualified Portage.Version as Portage
-
-import Distribution.Text
-
-type Portage = PortageMap [Ebuild]
-type PortageMap a = Map Package a
-
-data Ebuild = Ebuild {
- ePackage :: Package,
- eVersion :: Portage.Version,
- eFilePath :: FilePath,
- ePkgDesc :: Maybe Cabal.GenericPackageDescription }
- deriving (Show)
-
-data Package = P { pCategory :: String, pPackage :: String }
- deriving (Eq, Ord)
-
-instance Show Package where
- show (P c p) = c ++ '/':p
-
-instance Eq Ebuild where
- e1 == e2 = (ePackage e1, eVersion e1) == (ePackage e2, eVersion e2)
-
-instance Ord Ebuild where
- compare e1 e2 = compare (ePackage e1, eVersion e1)
- (ePackage e2, eVersion e2)
-
-lookupEbuildWith :: Portage -> Package -> (Ebuild -> Bool) -> Maybe Ebuild
-lookupEbuildWith portage package comp = do
- es <- Map.lookup package portage
- List.find comp es
-
-getPackageList :: FilePath -> IO [Package]
-getPackageList portdir = do
- categories <- getDirectories portdir
- packages <- fmap concat $ forMbling categories $ \c -> do
- pkg <- getDirectories (portdir </> c)
- return (map (P c) pkg)
- return packages
-
-readPortagePackages :: FilePath -> [Package] -> IO Portage
-readPortagePackages portdir packages0 = do
- packages <- filterM (doesDirectoryExist . (portdir </>) . show) packages0
- ebuild_map0 <- forM packages $ \package -> do
- ebuilds <- getPackageVersions package
- return (package, List.sort ebuilds)
- let ebuild_map = filter (not . null . snd) ebuild_map0
- return $ Map.fromList ebuild_map
-
- where
- getPackageVersions :: Package -> IO [Ebuild]
- getPackageVersions (P category package) = do
- files <- getDirectoryContents (portdir </> category </> package)
- let ebuilds = [ (v, portdir </> category </> package </> fn)
- | (Just v, fn) <- map ((filterVersion package) &&& id) files ]
- return (map (uncurry (\v f -> Ebuild (P category package) v f Nothing)) ebuilds)
-
- filterVersion :: String -> String -> Maybe Portage.Version
- filterVersion p fn = do
- [vstring] <- matchRegex (ebuildVersionRegex p) fn
- simpleParse vstring
-
- ebuildVersionRegex name = mkRegex ("^"++name++"-(.*)\\.ebuild$")
-
-readPortageTree :: FilePath -> IO Portage
-readPortageTree portdir = do
- packages <- getPackageList portdir
- readPortagePackages portdir packages
-
-getDirectories :: FilePath -> IO [String]
-getDirectories fp = do
- files <- fmap (filter (`notElem` [".", ".."])) $ getDirectoryContents fp
- filterM (doesDirectoryExist . (fp </>)) files
-
-printPortage :: Portage -> IO ()
-printPortage port =
- forM_ (Map.toAscList port) $ \(package, ebuilds) -> do
- let (P c p) = package
- putStr $ c ++ '/':p
- putStr " "
- forM_ ebuilds (\e -> putStr (show $ eVersion e) >> putChar ' ')
- putStrLn ""
diff --git a/Portage/Dependency.hs b/Portage/Dependency.hs
index 0182f7e..73fd0cc 100644
--- a/Portage/Dependency.hs
+++ b/Portage/Dependency.hs
@@ -9,7 +9,7 @@ import Distribution.Text ( display, Text(..) )
import Portage.PackageId
import qualified Text.PrettyPrint as Disp
-import Text.PrettyPrint ( (<>) )
+import Text.PrettyPrint ( (<>), hsep )
import Data.Maybe ( fromJust, catMaybes )
import Data.List ( nub, groupBy, partition, sortBy )
@@ -26,6 +26,7 @@ data Dependency = AnyVersionOf PackageName
| DependEither [[Dependency]] -- || ( depend_group1 ..depend_groupN )
| DependIfUse UseFlag Dependency -- use? ( depend )
| ThisMajorOf Version PackageName -- =package-version*
+ | AllOf [Dependency] -- ( package-version* )
deriving (Eq,Show)
instance Text Dependency where
@@ -50,6 +51,7 @@ showDepend (DependIfUse useflag dep@(DependEither _))
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 '*'
+showDepend (AllOf dp ) = Disp.text "( " <> hsep (map showDepend dp) <> Disp.text " )"
{- Here goes code for dependencies simplification -}
diff --git a/Portage/EBuild.hs b/Portage/EBuild.hs
index 0f15864..42aeda7 100644
--- a/Portage/EBuild.hs
+++ b/Portage/EBuild.hs
@@ -1,6 +1,7 @@
module Portage.EBuild
( EBuild(..)
, ebuildTemplate
+ , src_uri
) where
import Distribution.Text ( Text(..), display )
@@ -19,7 +20,6 @@ data EBuild = EBuild {
hackportVersion :: String,
description :: String,
homepage :: String,
- src_uri :: String,
license :: Cabal.License,
slot :: String,
keywords :: [String],
@@ -29,7 +29,7 @@ data EBuild = EBuild {
rdepend :: [Dependency],
rdepend_extra :: [String],
features :: [String],
- my_pn :: Maybe String --If the package's name contains upper-case
+ my_pn :: Maybe String -- ^ Just 'myOldName' if the package name contains upper characters
}
getHackportVersion :: Version -> String
@@ -43,7 +43,6 @@ ebuildTemplate = EBuild {
hackportVersion = getHackportVersion Paths_hackport.version,
description = "",
homepage = "http://hackage.haskell.org/package/${PN}",
- src_uri = "http://hackage.haskell.org/packages/archive/${PN}/${PV}/${P}.tar.gz",
license = Cabal.UnknownLicense "xxx UNKNOWN xxx",
slot = "0",
keywords = ["~amd64","~x86"],
@@ -59,6 +58,18 @@ ebuildTemplate = EBuild {
instance Text EBuild where
disp = Disp.text . showEBuild
+-- | Given an EBuild, give the URI to the tarball of the source code.
+-- Assumes that the server is always hackage.haskell.org.
+src_uri :: EBuild -> String
+src_uri e =
+ case my_pn e of
+ -- use standard address given that the package name has no upper
+ -- characters
+ Nothing -> "http://hackage.haskell.org/packages/archive/${PN}/${PV}/${P}.tar.gz"
+ -- use MY_X variables (defined in showEBuild) as we've renamed the
+ -- package
+ Just _ -> "http://hackage.haskell.org/packages/archive/${MY_PN}/${PV}/${MY_P}.tar.gz"
+
showEBuild :: EBuild -> String
showEBuild ebuild =
ss "# Copyright 1999-2010 Gentoo Foundation". nl.
@@ -76,7 +87,7 @@ showEBuild ebuild =
ss "MY_P=". quote "${MY_PN}-${PV}". nl. nl).
ss "DESCRIPTION=". quote (description ebuild). nl.
ss "HOMEPAGE=". quote (expandVars (homepage ebuild)). nl.
- ss "SRC_URI=". quote (replaceVars (src_uri ebuild)). nl.
+ ss "SRC_URI=". quote (src_uri ebuild). nl.
nl.
ss "LICENSE=". quote (convertLicense . license $ ebuild).
(if null (licenseComment . license $ ebuild) then id
@@ -91,8 +102,7 @@ showEBuild ebuild =
Nothing -> id
Just _ -> nl. ss "S=". quote ("${WORKDIR}/${MY_P}"). nl)
$ []
- where replaceVars = replaceCommonVars (name ebuild) (my_pn ebuild) (version ebuild)
- expandVars = replaceMultiVars [(name ebuild, "${PN}")]
+ where expandVars = replaceMultiVars [(name ebuild, "${PN}")]
ss :: String -> String -> String
ss = showString
@@ -148,21 +158,6 @@ replaceMultiVars whole@((pname,cont):rest) str = case subStr cont str of
Nothing -> replaceMultiVars rest str
Just (pre,post) -> (replaceMultiVars rest pre)++pname++(replaceMultiVars whole post)
-replaceCommonVars ::
- String -> -- ^ PN
- Maybe String -> -- ^ MYPN
- String -> -- ^ PV
- String -> -- ^ the string to be replaced
- String
-replaceCommonVars pn mypn pv str
- = replaceMultiVars
- ([("${P}",pn++"-"++pv)]
- ++ maybe [] (\x->[("${MY_P}",x++"-"++pv)]) mypn
- ++[("${PN}",pn)]
- ++ maybe [] (\x->[("${MY_PN}",x)]) mypn
- ++[("${PV}",pv)]) str
-
-
-- map the cabal license type to the gentoo license string format
convertLicense :: Cabal.License -> String
convertLicense (Cabal.GPL mv) = "GPL-" ++ (maybe "2" display mv) -- almost certainly version 2
diff --git a/Portage/GHCCore.hs b/Portage/GHCCore.hs
new file mode 100644
index 0000000..564f8ea
--- /dev/null
+++ b/Portage/GHCCore.hs
@@ -0,0 +1,305 @@
+
+-- Guess GHC version from packages depended upon.
+module Portage.GHCCore
+ ( minimumGHCVersionToBuildPackage
+ , cabalFromGHC
+ , defaultGHC
+ ) where
+
+import Distribution.Package
+import Distribution.Version
+import Distribution.Simple.PackageIndex
+import Distribution.InstalledPackageInfo
+
+import Distribution.PackageDescription
+import Distribution.PackageDescription.Configuration
+import Distribution.Compiler (CompilerId(..), CompilerFlavor(GHC))
+import Distribution.System
+
+import Distribution.Text
+
+import Data.Maybe
+import Data.List ( nub )
+
+import Text.PrettyPrint.HughesPJ
+
+defaultGHC :: (CompilerId, [PackageName])
+defaultGHC = let (g,pix) = ghc6123 in (g, packageNamesFromPackageIndex pix)
+
+ghcs :: [(CompilerId, PackageIndex)]
+ghcs = [ghc682, ghc6101, ghc6104, ghc6121, ghc6122, ghc6123, ghc701]
+
+cabalFromGHC :: [Int] -> Maybe Version
+cabalFromGHC ver = lookup ver table
+ where
+ table = [([6,6,0], Version [1,1,6] [])
+ ,([6,6,1], Version [1,1,6,2] [])
+ ,([6,8,1], Version [1,2,2,0] [])
+ ,([6,8,2], Version [1,2,3,0] [])
+ ,([6,8,3], Version [1,2,4,0] [])
+ ,([6,10,1], Version [1,6,0,1] [])
+ ,([6,10,2], Version [1,6,0,3] [])
+ ,([6,10,3], Version [1,6,0,3] [])
+ ,([6,10,4], Version [1,6,0,3] [])
+ ,([6,12,1], Version [1,8,0,2] [])
+ ,([6,12,2], Version [1,8,0,4] [])
+ ,([6,12,3], Version [1,8,0,6] [])
+ ,([7,0,1], Version [1,10,0,0] [])
+ ]
+
+platform :: Platform
+platform = Platform X86_64 Linux
+
+packageIsCore :: PackageIndex -> PackageName -> Bool
+packageIsCore index pn = not . null $ lookupPackageName index pn
+
+packageIsCoreInAnyGHC :: PackageName -> Bool
+packageIsCoreInAnyGHC pn = any (flip packageIsCore pn) (map snd ghcs)
+
+-- | Check if a dependency is satisfiable given a 'PackageIndex'
+-- representing the core packages in a GHC version.
+-- Packages that are not core will always be accepted, packages that are
+-- core in any ghc must be satisfied by the 'PackageIndex'.
+dependencySatisfiable :: PackageIndex -> Dependency -> Bool
+dependencySatisfiable pi dep@(Dependency pn rang)
+ | pn == PackageName "Win32" = False -- only exists on windows, not in linux
+ | not . null $ lookupDependency pi dep = True -- the package index satisfies the dep
+ | packageIsCoreInAnyGHC pn = False -- some other ghcs support the dependency
+ | otherwise = True -- the dep is not related with core packages, accept the dep
+
+packageBuildableWithGHCVersion
+ :: GenericPackageDescription
+ -> (CompilerId, PackageIndex)
+ -> Either [Dependency] (PackageDescription, FlagAssignment)
+packageBuildableWithGHCVersion pkg (compiler, pkgIndex) =
+ finalizePackageDescription [] (dependencySatisfiable pkgIndex) platform compiler [] pkg
+
+-- | Given a 'GenericPackageDescription' it returns the miminum GHC version
+-- to build a package, and a list of core packages to that GHC version.
+minimumGHCVersionToBuildPackage :: GenericPackageDescription -> Maybe (CompilerId, [PackageName])
+minimumGHCVersionToBuildPackage gpd =
+ listToMaybe [ (cid, packageNamesFromPackageIndex pix)
+ | g@(cid, pix) <- ghcs
+ , Right _ <- return (packageBuildableWithGHCVersion gpd g)]
+
+mkIndex :: [PackageIdentifier] -> PackageIndex
+mkIndex pids = fromList
+ [ emptyInstalledPackageInfo
+ { installedPackageId = InstalledPackageId $ display name ++ "-" ++ display version
+ , sourcePackageId = pi
+ , exposed = True
+ }
+ | pi@(PackageIdentifier name version) <- pids ]
+
+packageNamesFromPackageIndex :: PackageIndex -> [PackageName]
+packageNamesFromPackageIndex pix = nub $
+ [ (pkgName . sourcePackageId) p | (p:_) <- allPackagesByName pix ]
+
+ghc :: [Int] -> CompilerId
+ghc nrs = CompilerId GHC (Version nrs [])
+
+-- | Core packages in GHC 7.0.1 as a 'PackageIndex'.
+ghc701 :: (CompilerId, PackageIndex)
+ghc701 = (ghc [7,0,1], mkIndex ghc701_pkgs)
+
+ghc6123 :: (CompilerId, PackageIndex)
+ghc6123 = (ghc [6,12,3], mkIndex ghc6123_pkgs)
+
+ghc6122 :: (CompilerId, PackageIndex)
+ghc6122 = (ghc [6,12,2], mkIndex ghc6122_pkgs)
+
+ghc6121 :: (CompilerId, PackageIndex)
+ghc6121 = (ghc [6,12,1], mkIndex ghc6121_pkgs)
+
+ghc6104 :: (CompilerId, PackageIndex)
+ghc6104 = (ghc [6,10,4], mkIndex ghc6104_pkgs)
+
+ghc6101 :: (CompilerId, PackageIndex)
+ghc6101 = (ghc [6,10,1], mkIndex ghc6101_pkgs)
+
+ghc682 :: (CompilerId, PackageIndex)
+ghc682 = (ghc [6,8,2], mkIndex ghc682_pkgs)
+
+-- | Non-upgradeable core packages
+-- Source: http://haskell.org/haskellwiki/Libraries_released_with_GHC
+ghc701_pkgs :: [PackageIdentifier]
+ghc701_pkgs =
+ [ p "array" [0,3,0,2]
+ , p "base" [4,3,0,0]
+ , p "bytestring" [0,9,1,8]
+-- , p "Cabal" [1,10,0,0] package is upgradeable
+ , p "containers" [0,4,0,0]
+ , p "directory" [1,1,0,0]
+ , p "extensible-exceptions" [0,1,1,2]
+ , p "filepath" [1,2,0,0]
+ , p "haskell2010" [1,0,0,0]
+ , p "haskell98" [1,1,0,0]
+ , p "hpc" [0,5,0,6]
+ , p "integer-gmp" [0,2,0,2]
+ , p "integer-simple" [0,1,0,0]
+ , p "old-locale" [1,0,0,2]
+ , p "old-time" [1,0,0,6]
+ , p "pretty" [1,0,1,2]
+ , p "process" [1,0,1,4]
+ , p "random" [1,0,0,3]
+ , p "syb" [0,2,2] -- not distributed with ghc-7, but ghc-7 PDEPENDs on it
+ , p "template-haskell" [2,5,0,0]
+-- , p "time" [1,2,0,3] package is upgradeable
+ , p "unix" [2,4,1,0]
+-- , p "utf8-string" [0,3,4] package is upgradeable
+ ]
+
+ghc6123_pkgs :: [PackageIdentifier]
+ghc6123_pkgs =
+ [ p "array" [0,3,0,1]
+ , p "base" [3,0,3,2]
+ , p "base" [4,2,0,2]
+ , p "bytestring" [0,9,1,7]
+-- , p "Cabal" [1,8,0,6] package is upgradeable
+ , p "containers" [0,3,0,0]
+ , p "directory" [1,0,1,1]
+ , p "extensible-exceptions" [0,1,1,1]
+ , p "filepath" [1,1,0,4]
+ , p "haskell98" [1,0,1,1]
+ , p "hpc" [0,5,0,5]
+ , p "integer-gmp" [0,2,0,1]
+ , p "integer-simple" [0,1,0,0]
+ , p "old-locale" [1,0,0,2]
+ , p "old-time" [1,0,0,5]
+ , p "pretty" [1,0,1,1]
+ , p "process" [1,0,1,3]
+ , p "random" [1,0,0,2]
+ , p "syb" [0,1,0,2]
+ , p "template-haskell" [2,4,0,1]
+-- , p "time" [1,1,4] package is upgradeable
+ , p "unix" [2,4,0,2]
+-- , p "utf8-string" [0,3,4] package is upgradeable
+ ]
+
+ghc6122_pkgs :: [PackageIdentifier]
+ghc6122_pkgs =
+ [ p "array" [0,3,0,0]
+ , p "base" [3,0,3,2]
+ , p "base" [4,2,0,1]
+ , p "bytestring" [0,9,1,6]
+-- , p "Cabal" [1,8,0,4] package is upgradeable
+ , p "containers" [0,3,0,0]
+ , p "directory" [1,0,1,1]
+ , p "extensible-exceptions" [0,1,1,1]
+ , p "filepath" [1,1,0,4]
+ , p "haskell98" [1,0,1,1]
+ , p "hpc" [0,5,0,5]
+ , p "integer-gmp" [0,2,0,1]
+ , p "integer-simple" [0,1,0,0]
+ , p "old-locale" [1,0,0,2]
+ , p "old-time" [1,0,0,4]
+ , p "pretty" [1,0,1,1]
+ , p "process" [1,0,1,2]
+ , p "random" [1,0,0,2]
+ , p "syb" [0,1,0,2]
+ , p "template-haskell" [2,4,0,1]
+-- , p "time" [1,1,4] package is upgradeable
+ , p "unix" [2,4,0,1]
+-- , p "utf8-string" [0,3,4] package is upgradeable
+ ]
+
+ghc6121_pkgs :: [PackageIdentifier]
+ghc6121_pkgs =
+ [ p "array" [0,3,0,0]
+ , p "base" [3,0,3,2]
+ , p "base" [4,2,0,0]
+ , p "bytestring" [0,9,1,5]
+-- , p "Cabal" [1,8,0,2] package is upgradeable
+ , p "containers" [0,3,0,0]
+ , p "directory" [1,0,1,0]
+ , p "extensible-exceptions" [0,1,1,1]
+ , p "filepath" [1,1,0,3]
+ , p "haskell98" [1,0,1,1]
+ , p "hpc" [0,5,0,4]
+ , p "integer-gmp" [0,2,0,0]
+ , p "integer-simple" [0,1,0,0]
+ , p "old-locale" [1,0,0,2]
+ , p "old-time" [1,0,0,3]
+ , p "pretty" [1,0,1,1]
+ , p "process" [1,0,1,2]
+ , p "random" [1,0,0,2]
+ , p "syb" [0,1,0,2]
+ , p "template-haskell" [2,4,0,0]
+-- , p "time" [1,1,4] package is upgradeable
+ , p "unix" [2,4,0,0]
+-- , p "utf8-string" [0,3,4] package is upgradeable
+ ]
+
+ghc6104_pkgs :: [PackageIdentifier]
+ghc6104_pkgs =
+ [ p "array" [0,2,0,0]
+ , p "base" [3,0,3,1]
+ , p "base" [4,1,0,0]
+ , p "bytestring" [0,9,1,4]
+-- , p "Cabal" [1,6,0,3] package is upgradeable
+ , p "containers" [0,2,0,1 ]
+ , p "directory" [1,0,0,3]
+ , p "extensible-exceptions" [0,1,1,0]
+ , p "filepath" [1,1,0,2]
+ , p "haskell98" [1,0,1,0]
+ , p "hpc" [0,5,0,3]
+ , p "old-locale" [1,0,0,1]
+ , p "old-time" [1,0,0,2]
+ , p "packedstring" [0,1,0,1]
+ , p "pretty" [1,0,1,0]
+ , p "process" [1,0,1,1]
+ , p "random" [1,0,0,1]
+ , p "syb" [0,1,0,1]
+ , p "template-haskell" [2,3,0,1]
+-- , p "time" [1,1,4] package is upgradeable
+ , p "unix" [2,3,2,0]
+ ]
+
+ghc6101_pkgs :: [PackageIdentifier]
+ghc6101_pkgs =
+ [ p "array" [0,2,0,0]
+ , p "base" [3,0,3,0]
+ , p "base" [4,0,0,0]
+ , p "bytestring" [0,9,1,4]
+-- , p "Cabal" [1,6,0,1] package is upgradeable
+ , p "containers" [0,2,0,0]
+ , p "directory" [1,0,0,2]
+ , p "extensible-exceptions" [0,1,0,0]
+ , p "filepath" [1,1,0,1]
+ , p "haskell98" [1,0,1,0]
+ , p "hpc" [0,5,0,2]
+ , p "old-locale" [1,0,0,1]
+ , p "old-time" [1,0,0,1]
+ , p "packedstring" [0,1,0,1]
+ , p "pretty" [1,0,1,0]
+ , p "process" [1,0,1,0]
+ , p "random" [1,0,0,1]
+ , p "syb" [0,1,0,0]
+ , p "template-haskell" [2,3,0,0]
+ , p "unix" [2,3,1,0]
+ ]
+
+ghc682_pkgs :: [PackageIdentifier]
+ghc682_pkgs =
+ [ p "array" [0,1,0,0]
+ , p "base" [3,0,1,0]
+ , p "bytestring" [0,9,0,1]
+-- , p "Cabal" [1,2,3,0] package is upgradeable
+ , p "containers" [0,1,0,1]
+ , p "dictionary" [1,0,0,0]
+ , p "filepath" [1,1,0,0]
+ , p "haskell98" [1,0,1,0]
+ , p "hpc" [0,5,0,0]
+ , p "old-locale" [1,0,0,0]
+ , p "old-time" [1,0,0,0]
+ , p "packedstring" [0,1,0,0]
+ , p "pretty" [1,0,0,0]
+ , p "process" [1,0,0,0]
+ , p "random" [1,0,0,0]
+-- , p "readline" [1,0,1,0]
+ , p "template-haskell" [2,2,0,0]
+ , p "unix" [2,3,0,0]
+ ]
+
+p :: String -> [Int] -> PackageIdentifier
+p pn vs = PackageIdentifier (PackageName pn) (Version vs [])
diff --git a/Portage/Host.hs b/Portage/Host.hs
index 9664374..1c20a5c 100644
--- a/Portage/Host.hs
+++ b/Portage/Host.hs
@@ -5,14 +5,14 @@ module Portage.Host
import Util (run_cmd)
import Data.Char (isSpace)
-import Data.Maybe (fromJust, isJust)
-
+import Data.Maybe (fromJust, isJust, catMaybes)
+import Control.Applicative ( (<$>) )
data LocalInfo =
LocalInfo { distfiles_dir :: String
, overlay_list :: [FilePath]
, portage_dir :: FilePath
- }
+ } deriving Show
defaultInfo :: LocalInfo
defaultInfo = LocalInfo { distfiles_dir = "/usr/portage/distfiles"
@@ -23,8 +23,8 @@ defaultInfo = LocalInfo { distfiles_dir = "/usr/portage/distfiles"
-- query paludis and then emerge
getInfo :: IO LocalInfo
getInfo = fromJust `fmap`
- performMaybes [ (fmap . fmap) parse_paludis_output (run_cmd "paludis --info")
- , (fmap . fmap) parse_emerge_output (run_cmd "emerge --info")
+ performMaybes [ getPaludisInfo
+ , fmap parse_emerge_output <$> (run_cmd "emerge --info")
, return (Just defaultInfo)
]
where performMaybes [] = return Nothing
@@ -34,58 +34,51 @@ getInfo = fromJust `fmap`
then return r
else performMaybes acts
-data LocalPaludisOverlay =
- LocalPaludisOverlay { repo_name :: String
- , format :: String
- , location :: FilePath
- , distdir :: FilePath
- }
+----------
+-- Paludis
+----------
-bad_paludis_overlay :: LocalPaludisOverlay
-bad_paludis_overlay =
- LocalPaludisOverlay { repo_name = undefined
- , format = undefined
- , location = undefined
- , distdir = undefined
- }
+getPaludisInfo :: IO (Maybe LocalInfo)
+getPaludisInfo = fmap parsePaludisInfo <$> run_cmd "paludis --info"
-parse_paludis_output :: String -> LocalInfo
-parse_paludis_output raw_data =
- foldl updateInfo defaultInfo $ parse_paludis_overlays raw_data
- where updateInfo info po =
- case (format po) of
- "ebuild" | (repo_name po) /= "gentoo" -- hack, skip main repo
- -> info{ distfiles_dir = distdir po -- we override last distdir here (FIXME?)
- , overlay_list = (location po) : overlay_list info
- }
- "ebuild" -- hack, main repo -- (repo_name po) == "gentoo"
- -> info{ portage_dir = location po }
+parsePaludisInfo :: String -> LocalInfo
+parsePaludisInfo text =
+ let chunks = splitBy (=="") . lines $ text
+ repositories = catMaybes (map parseRepository chunks)
+ in fromJust (mkLocalInfo repositories)
+ where
+ parseRepository :: [String] -> Maybe (String, (String, String))
+ parseRepository (firstLine:lns) = do
+ name <- case words firstLine of
+ ["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
+ return (name, (location, distfiles))
- _ -> info
+ 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 ]
+ return (LocalInfo
+ { distfiles_dir = gentooDistfiles
+ , portage_dir = gentooLocation
+ , overlay_list = overlays
+ })
-parse_paludis_overlays :: String -> [LocalPaludisOverlay]
-parse_paludis_overlays raw_data =
- parse_paludis_overlays' (reverse $ lines raw_data) bad_paludis_overlay
+splitBy :: (a -> Bool) -> [a] -> [[a]]
+splitBy c [] = []
+splitBy c lst =
+ let (x,xs) = break c lst
+ (_,xs') = span c xs
+ in x : splitBy c xs'
--- parse in reverse order :]
-parse_paludis_overlays' :: [String] -> LocalPaludisOverlay -> [LocalPaludisOverlay]
-parse_paludis_overlays' [] _ = []
-parse_paludis_overlays' (l:ls) info =
- case (words l) of
- -- look for "Repository <repo-name>:"
- ["Repository", r_name] -> info{repo_name = init r_name} :
- go bad_paludis_overlay
- -- else - parse attributes
- _ -> case (break (== ':') (refine l)) of
- ("location", ':':value)
- -> go info{location = refine value}
- ("distdir", ':':value)
- -> go info{distdir = refine value}
- ("format", ':':value)
- -> go info{format = refine value}
- _ -> go info
- where go = parse_paludis_overlays' ls
- refine = dropWhile isSpace
+---------
+-- Emerge
+---------
parse_emerge_output :: String -> LocalInfo
parse_emerge_output raw_data =
diff --git a/Portage/Metadata.hs b/Portage/Metadata.hs
new file mode 100644
index 0000000..e36b1e5
--- /dev/null
+++ b/Portage/Metadata.hs
@@ -0,0 +1,31 @@
+module Portage.Metadata
+ ( Metadata(..)
+ , metadataFromFile
+ ) where
+
+import qualified Data.ByteString as B
+
+import Control.Applicative
+
+import Text.XML.Light
+
+import Control.Monad
+
+data Metadata = Metadata
+ { metadataHerds :: [String]
+ -- , metadataMaintainers :: [String],
+ -- , metadataUseFlags :: [(String,String)]
+ } deriving (Show)
+
+metadataFromFile :: FilePath -> IO (Maybe Metadata)
+metadataFromFile fp = do
+ doc <- parseXMLDoc <$> B.readFile fp
+ return (doc >>= parseMetadata)
+
+parseMetadata :: Element -> Maybe Metadata
+parseMetadata xml = do
+ let herds = map strContent (findChildren (unqual "herd") xml)
+ return Metadata
+ {
+ metadataHerds = herds
+ }
diff --git a/Portage/Overlay.hs b/Portage/Overlay.hs
index 3c1ca2b..4184355 100644
--- a/Portage/Overlay.hs
+++ b/Portage/Overlay.hs
@@ -1,19 +1,22 @@
module Portage.Overlay
( ExistingEbuild(..)
, Overlay(..)
- , load, loadLazy
- , readOverlayByPackage, getDirectoryTree, DirectoryTree
+ , loadLazy
+ , readOverlay, readOverlayByPackage
+ , getDirectoryTree, DirectoryTree
, reduceOverlay
+ , filterByHerd
, inOverlay
)
where
import qualified Portage.PackageId as Portage
+import qualified Portage.Metadata as Portage
import qualified Distribution.Package as Cabal
-import Distribution.Text (simpleParse, display)
+import Distribution.Text (simpleParse)
import Distribution.Simple.Utils ( comparing, equating )
import Data.List as List
@@ -23,14 +26,8 @@ import System.Directory (getDirectoryContents, doesDirectoryExist)
import System.IO.Unsafe (unsafeInterleaveIO)
import System.FilePath ((</>), splitExtension)
---main = do
--- pkgs <- blingProgress . Progress.fromList . readOverlay
--- =<< getDirectoryTree "."
--- putStrLn $ unlines [ display pkg
--- | pkg <- pkgs
--- , isNothing (Portage.toCabalPackageId pkg) ]
+import Data.Traversable ( traverse )
---TODO: move this to another module:
data ExistingEbuild = ExistingEbuild {
ebuildId :: Portage.PackageId,
ebuildCabalId :: Cabal.PackageIdentifier,
@@ -41,7 +38,8 @@ instance Cabal.Package ExistingEbuild where packageId = ebuildCabalId
data Overlay = Overlay {
overlayPath :: FilePath,
- overlayMap :: Map Portage.PackageName [ExistingEbuild]
+ overlayMap :: Map Portage.PackageName [ExistingEbuild],
+ overlayMetadata :: Map Portage.PackageName Portage.Metadata
} deriving Show
inOverlay :: Overlay -> Cabal.PackageId -> Bool
@@ -58,42 +56,56 @@ inOverlay overlay pkgId = not (Map.null packages)
in cabal_pn == overlay_pn && (not (null ebs))) om
om = overlayMap overlay
-load :: FilePath -> IO Overlay
-load dir = fmap (mkOverlay . readOverlay) (getDirectoryTree dir)
- where
- mkOverlay _packages = Overlay {
- overlayPath = dir
--- TODO: ignore all ebuilds that have no Cabal version number
--- , overlayIndex = PackageIndex.fromList packages
- , overlayMap = undefined
- }
-
loadLazy :: FilePath -> IO Overlay
-loadLazy dir = fmap (mkOverlay . readOverlayByPackage) (getDirectoryTree dir)
+loadLazy path = do
+ dir <- getDirectoryTree path
+ metadata <- unsafeInterleaveIO $ mkMetadataMap path dir
+ return $ mkOverlay metadata $ readOverlayByPackage dir
where
allowed v = case v of
(Portage.Version _ Nothing [] _) -> True
_ -> False
- a <-> b = a ++ '-':b
- a <.> b = a ++ '.':b
- mkOverlay :: [(Portage.PackageName, [Portage.Version])] -> Overlay
- mkOverlay packages = Overlay {
- overlayPath = dir,
+ mkOverlay :: Map Portage.PackageName Portage.Metadata
+ -> [(Portage.PackageName, [Portage.Version])]
+ -> Overlay
+ mkOverlay meta packages = Overlay {
+ overlayPath = path,
+ overlayMetadata = meta,
overlayMap =
Map.fromList
[ (pkgName, [ ExistingEbuild portageId cabalId filepath
| version <- allowedVersions
, let portageId = Portage.PackageId pkgName version
, Just cabalId <- [ Portage.toCabalPackageId portageId ]
- , let filepath =
- dir </> display pkgName <-> display version <.> "ebuild"
+ , let filepath = path </> Portage.packageIdToFilePath portageId
])
| (pkgName, allVersions) <- packages
, let allowedVersions = filter allowed allVersions
]
}
+mkMetadataMap :: FilePath -> DirectoryTree -> IO (Map Portage.PackageName Portage.Metadata)
+mkMetadataMap root dir =
+ fmap (Map.mapMaybe id) $
+ traverse Portage.metadataFromFile $
+ Map.fromList
+ [ (Portage.mkPackageName category package, root </> category </> package </> "metadata.xml")
+ | Directory category packages <- dir
+ , Directory package files <- packages
+ , File "metadata.xml" <- files
+ ]
+
+filterByHerd :: ([String] -> Bool) -> Overlay -> Overlay
+filterByHerd p overlay = overlay
+ { overlayMetadata = metadataMap'
+ , overlayMap = pkgMap'
+ }
+ where
+ metadataMap' = Map.filter (p . Portage.metadataHerds) (overlayMetadata overlay)
+ pkgMap' = Map.intersection (overlayMap overlay) metadataMap'
+
+
-- make sure there is only one ebuild for each version number (by selecting
-- the highest ebuild version revision)
reduceOverlay :: Overlay -> Overlay
diff --git a/Portage/PackageId.hs b/Portage/PackageId.hs
index 2f4757a..ec81733 100644
--- a/Portage/PackageId.hs
+++ b/Portage/PackageId.hs
@@ -10,7 +10,8 @@ module Portage.PackageId (
toCabalPackageId,
parseFriendlyPackage,
normalizeCabalPackageName,
- normalizeCabalPackageId
+ normalizeCabalPackageId,
+ packageIdToFilePath
) where
import qualified Distribution.Package as Cabal
@@ -23,8 +24,9 @@ import qualified Portage.Version as Portage
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint ((<>))
import qualified Data.Char as Char (isAlphaNum, isSpace, toLower)
--- import qualified Data.Char as Char (isDigit)
--- import Data.List (intersperse)
+
+import Distribution.Text(display)
+import System.FilePath ( (</>) )
newtype Category = Category { unCategory :: String }
deriving (Eq, Ord, Show, Read)
@@ -49,6 +51,13 @@ instance Text PN where
-- ambiguity in identifiers like foo-1 (the 1 is the version number).
-}
+packageIdToFilePath :: PackageId -> FilePath
+packageIdToFilePath (PackageId (PackageName cat pn) version) =
+ display cat </> display pn </> display pn <-> display version <.> "ebuild"
+ where
+ a <-> b = a ++ '-':b
+ a <.> b = a ++ '.':b
+
mkPackageName :: String -> String -> PackageName
mkPackageName cat package = PackageName (Category cat) (Cabal.PackageName package)
diff --git a/Status.hs b/Status.hs
index a9328ba..673c707 100644
--- a/Status.hs
+++ b/Status.hs
@@ -6,7 +6,9 @@ module Status
) where
import AnsiColor
-import P2
+
+import Portage.Overlay
+import Portage.PackageId
import Control.Monad.State
@@ -19,11 +21,13 @@ import qualified Data.Map as Map
import Data.Map as Map (Map)
import qualified Data.Traversable as T
+import Control.Applicative
-- cabal
import Distribution.Verbosity
import Distribution.Simple.Utils (equating, comparing)
-import Distribution.Text(display)
+import Distribution.Text ( display, simpleParse )
+import Distribution.Simple.Utils ( die )
data FileStatus a
= Same a
@@ -51,20 +55,20 @@ fromStatus fs =
OverlayOnly a -> a
PortageOnly a -> a
-status :: Verbosity -> FilePath -> FilePath -> IO (Map Package [FileStatus Ebuild])
-status _verbosity portdir overlayPath = do
- overlay <- readPortageTree overlayPath
- portage <- readPortagePackages portdir (Map.keys overlay)
- let (over, both, port) = portageDiff overlay portage
+status :: Verbosity -> FilePath -> FilePath -> IO (Map PackageName [FileStatus ExistingEbuild])
+status _verbosity portdir overlaydir = do
+ overlay <- loadLazy overlaydir
+ portage <- filterByHerd ("haskell" `elem`) <$> loadLazy portdir
+ let (over, both, port) = portageDiff (overlayMap overlay) (overlayMap portage)
both' <- T.forM both $ mapM $ \e -> liftIO $ do
-- can't fail, we know the ebuild exists in both portagedirs
-- also, one of them is already bound to 'e'
- let (Just e1) = lookupEbuildWith portage (ePackage e) (equating eVersion e)
- (Just e2) = lookupEbuildWith overlay (ePackage e) (equating eVersion e)
- eq <- equals (eFilePath e1) (eFilePath e2)
+ let (Just e1) = lookupEbuildWith (overlayMap portage) (ebuildId e)
+ (Just e2) = lookupEbuildWith (overlayMap overlay) (ebuildId e)
+ eq <- equals (ebuildPath e1) (ebuildPath e2)
return $ if eq
- then Same e
+ then Same e1
else Differs e1 e2
let meld = Map.unionsWith (\a b -> List.sort (a++b))
@@ -74,50 +78,59 @@ status _verbosity portdir overlayPath = do
]
return meld
+type EMap = Map PackageName [ExistingEbuild]
+
+lookupEbuildWith :: EMap -> PackageId -> Maybe ExistingEbuild
+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 overlayPath toPortageFlag pkgs = do
+runStatus verbosity portdir overlaydir toPortageFlag pkgs = do
let pkgFilter | toPortageFlag = toPortageFilter
| otherwise = id
- tree0 <- status verbosity portdir overlayPath
+ pkgs' <- forM pkgs $ \p ->
+ case simpleParse p of
+ Nothing -> die ("Could not parse package name: " ++ p ++ ". Format cat/pkg")
+ Just pn -> return pn
+ tree0 <- status verbosity portdir overlaydir
let tree = pkgFilter tree0
- if (null pkgs)
+ if (null pkgs')
then statusPrinter tree
- else forM_ pkgs $ \pkg -> do
- let filteredTree = Map.filterWithKey (\k _ -> pPackage k == pkg) tree
- statusPrinter filteredTree
+ else forM_ pkgs' $ \pkg -> statusPrinter (Map.filterWithKey (\k _ -> k == pkg) tree)
-- |Only return packages that seems interesting to sync to portage;
--
-- * Ebuild differs, or
-- * Newer version in overlay than in portage
-toPortageFilter :: Map Package [FileStatus Ebuild] -> Map Package [FileStatus Ebuild]
+toPortageFilter :: Map PackageName [FileStatus ExistingEbuild] -> Map PackageName [FileStatus ExistingEbuild]
toPortageFilter = Map.mapMaybe $ \ sts ->
let inPortage = flip filter sts $ \st ->
case st of
OverlayOnly _ -> False
_ -> True
- latestPortageVersion = List.maximum $ map (eVersion . fromStatus) inPortage
+ latestPortageVersion = List.maximum $ map (pkgVersion . ebuildId . fromStatus) inPortage
interestingPackages = flip filter sts $ \st ->
case st of
Differs _ _ -> True
- _ | eVersion (fromStatus st) > latestPortageVersion -> True
+ _ | pkgVersion (ebuildId (fromStatus st)) > latestPortageVersion -> True
| otherwise -> False
in if not (null inPortage) && not (null interestingPackages)
then Just sts
else Nothing
-statusPrinter :: Map Package [FileStatus Ebuild] -> IO ()
+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"
forM_ (Map.toAscList packages) $ \(pkg, ebuilds) -> do
- let (P c p) = pkg
- putStr $ c ++ '/' : bold p
+ let (PackageName c p) = pkg
+ putStr $ display c ++ '/' : bold (display p)
putStr " "
forM_ ebuilds $ \e -> do
- putStr $ toColor (fmap (display . eVersion) e)
+ putStr $ toColor (fmap (display . pkgVersion . ebuildId) e)
putChar ' '
putStrLn ""
@@ -130,15 +143,15 @@ toColor st = inColor c False Default (fromStatus st)
(OverlayOnly _) -> Red
(PortageOnly _) -> Magenta
-portageDiff :: Portage -> Portage -> (Portage, Portage, Portage)
+
+portageDiff :: EMap -> EMap -> (EMap, EMap, EMap)
portageDiff p1 p2 = (in1, ins, in2)
- where ins = Map.filter (not . null) $
- Map.intersectionWith (List.intersectBy $ equating eVersion) p1 p2
+ where ins = Map.filter (not . null) $ Map.intersectionWith (List.intersectBy $ equating ebuildId) p1 p2
in1 = difference p1 p2
in2 = difference p2 p1
difference x y = Map.filter (not . null) $
Map.differenceWith (\xs ys ->
- let lst = foldr (List.deleteBy (equating eVersion)) xs ys in
+ let lst = foldr (List.deleteBy (equating ebuildId)) xs ys in
if null lst
then Nothing
else Just lst
diff --git a/cabal-install-0.8.2/Distribution/Client/Dependency/Bogus.hs b/cabal-install-0.8.2/Distribution/Client/Dependency/Bogus.hs
deleted file mode 100644
index 695956c..0000000
--- a/cabal-install-0.8.2/Distribution/Client/Dependency/Bogus.hs
+++ /dev/null
@@ -1,129 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Distribution.Client.Dependency.Bogus
--- Copyright : (c) David Himmelstrup 2005, Bjorn Bringert 2007
--- Duncan Coutts 2008
--- License : BSD-like
---
--- Maintainer : cabal-devel@haskell.org
--- Stability : provisional
--- Portability : portable
---
--- A dependency resolver for when we do not know what packages are installed.
------------------------------------------------------------------------------
-module Distribution.Client.Dependency.Bogus (
- bogusResolver
- ) where
-
-import Distribution.Client.Types
- ( AvailablePackage(..), ConfiguredPackage(..) )
-import Distribution.Client.Dependency.Types
- ( DependencyResolver, Progress(..)
- , PackageConstraint(..), PackagePreferences(..) )
-import qualified Distribution.Client.InstallPlan as InstallPlan
-
-import Distribution.Package
- ( PackageName, PackageIdentifier(..), Dependency(..)
- , Package(..), packageVersion )
-import Distribution.PackageDescription
- ( GenericPackageDescription(..), CondTree(..), FlagAssignment )
-import Distribution.PackageDescription.Configuration
- ( finalizePackageDescription )
-import qualified Distribution.Client.PackageIndex as PackageIndex
-import Distribution.Client.PackageIndex (PackageIndex)
-import Distribution.Version
- ( VersionRange, anyVersion, intersectVersionRanges, withinRange )
-import Distribution.Simple.Utils
- ( comparing )
-import Distribution.Text
- ( display )
-
-import Data.List
- ( maximumBy )
-import Data.Maybe
- ( fromMaybe )
-import qualified Data.Map as Map
-
--- | This resolver thinks that every package is already installed.
---
--- We need this for hugs and nhc98 which do not track installed packages.
--- We just pretend that everything is installed and hope for the best.
---
-bogusResolver :: DependencyResolver
-bogusResolver platform comp _ available
- preferences constraints targets =
- resolveFromAvailable []
- (combineConstraints preferences constraints targets)
- where
- resolveFromAvailable chosen [] = Done chosen
- resolveFromAvailable chosen ((name, verConstraint, flags, verPref): deps) =
- case latestAvailableSatisfying available name verConstraint verPref of
- Nothing -> Fail ("Unresolved dependency: " ++ display dep)
- Just apkg@(AvailablePackage _ pkg _) ->
- case finalizePackageDescription flags none platform comp [] pkg of
- Right (_, flags') -> Step msg (resolveFromAvailable chosen' deps)
- where
- msg = "selecting " ++ display (packageId pkg)
- cpkg = fudgeChosenPackage apkg flags'
- chosen' = InstallPlan.Configured cpkg : chosen
- _ -> error "bogusResolver: impossible happened"
- where
- none :: Dependency -> Bool
- none = const True
- where
- dep = Dependency name verConstraint
-
-fudgeChosenPackage :: AvailablePackage -> FlagAssignment -> ConfiguredPackage
-fudgeChosenPackage (AvailablePackage pkgid pkg source) flags =
- ConfiguredPackage (AvailablePackage pkgid (stripDependencies pkg) source)
- flags ([] :: [PackageIdentifier]) -- empty list of deps
- where
- -- | Pretend that a package has no dependencies. Go through the
- -- 'GenericPackageDescription' and strip them all out.
- --
- stripDependencies :: GenericPackageDescription -> GenericPackageDescription
- stripDependencies gpkg = gpkg {
- condLibrary = fmap stripDeps (condLibrary gpkg),
- condExecutables = [ (name, stripDeps tree)
- | (name, tree) <- condExecutables gpkg ]
- }
- stripDeps :: CondTree v [Dependency] a -> CondTree v [Dependency] a
- stripDeps = mapTreeConstrs (const [])
-
- mapTreeConstrs :: (c -> c) -> CondTree v c a -> CondTree v c a
- mapTreeConstrs f (CondNode a c ifs) = CondNode a (f c) (map g ifs)
- where
- g (cnd, t, me) = (cnd, mapTreeConstrs f t, fmap (mapTreeConstrs f) me)
-
-combineConstraints :: (PackageName -> PackagePreferences)
- -> [PackageConstraint]
- -> [PackageName]
- -> [(PackageName, VersionRange, FlagAssignment, VersionRange)]
-combineConstraints preferences constraints targets =
- [ (name, ver, flags, pref)
- | name <- targets
- , let ver = fromMaybe anyVersion (Map.lookup name versionConstraints)
- flags = fromMaybe [] (Map.lookup name flagsConstraints)
- PackagePreferences pref _ = preferences name ]
- where
- versionConstraints = Map.fromListWith intersectVersionRanges
- [ (name, versionRange)
- | PackageVersionConstraint name versionRange <- constraints ]
-
- flagsConstraints = Map.fromListWith (++)
- [ (name, flags)
- | PackageFlagsConstraint name flags <- constraints ]
-
--- | Gets the best available package satisfying a dependency.
---
-latestAvailableSatisfying :: PackageIndex AvailablePackage
- -> PackageName -> VersionRange -> VersionRange
- -> Maybe AvailablePackage
-latestAvailableSatisfying index name versionConstraint versionPreference =
- case PackageIndex.lookupDependency index dep of
- [] -> Nothing
- pkgs -> Just (maximumBy best pkgs)
- where
- dep = Dependency name versionConstraint
- best = comparing (\p -> (isPreferred p, packageVersion p))
- isPreferred p = packageVersion p `withinRange` versionPreference
diff --git a/cabal-install-0.8.2/Distribution/Client/BuildReports/Anonymous.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/BuildReports/Anonymous.hs
index 53d1f45..53d1f45 100644
--- a/cabal-install-0.8.2/Distribution/Client/BuildReports/Anonymous.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/BuildReports/Anonymous.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/BuildReports/Storage.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/BuildReports/Storage.hs
index a8e9150..a8e9150 100644
--- a/cabal-install-0.8.2/Distribution/Client/BuildReports/Storage.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/BuildReports/Storage.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/BuildReports/Types.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/BuildReports/Types.hs
index ea28e71..ea28e71 100644
--- a/cabal-install-0.8.2/Distribution/Client/BuildReports/Types.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/BuildReports/Types.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/BuildReports/Upload.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/BuildReports/Upload.hs
index dc35552..dc35552 100644
--- a/cabal-install-0.8.2/Distribution/Client/BuildReports/Upload.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/BuildReports/Upload.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/Check.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Check.hs
index 8d5fe23..8d5fe23 100644
--- a/cabal-install-0.8.2/Distribution/Client/Check.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Check.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/Config.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Config.hs
index 8ddca49..2e20591 100644
--- a/cabal-install-0.8.2/Distribution/Client/Config.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Config.hs
@@ -38,24 +38,23 @@ import Distribution.Client.Setup
import Distribution.Simple.Setup
( ConfigFlags(..), configureOptions, defaultConfigFlags
- , Flag, toFlag, flagToMaybe, fromFlagOrDefault, flagToList )
+ , installDirsOptions
+ , Flag, toFlag, flagToMaybe, fromFlagOrDefault )
import Distribution.Simple.InstallDirs
( InstallDirs(..), defaultInstallDirs
- , PathTemplate, toPathTemplate, fromPathTemplate )
+ , PathTemplate, toPathTemplate )
import Distribution.ParseUtils
( FieldDescr(..), liftField
, ParseResult(..), locatedErrorMsg, showPWarning
, readFields, warning, lineNo
- , simpleField, listField, parseFilePathQ, showFilePath, parseTokenQ )
+ , simpleField, listField, parseFilePathQ, parseTokenQ )
import qualified Distribution.ParseUtils as ParseUtils
( Field(..) )
import qualified Distribution.Text as Text
( Text(..) )
-import Distribution.ReadE
- ( readP_to_E )
import Distribution.Simple.Command
( CommandUI(commandOptions), commandDefaultFlags, ShowOrParseArgs(..)
- , viewAsFieldDescr, OptionField, option, reqArg )
+ , viewAsFieldDescr )
import Distribution.Simple.Program
( defaultProgramConfiguration )
import Distribution.Simple.Utils
@@ -156,6 +155,8 @@ updateInstallDirs userInstallFlag
baseSavedConfig :: IO SavedConfig
baseSavedConfig = do
userPrefix <- defaultCabalDir
+ logsDir <- defaultLogsDir
+ worldFile <- defaultWorldFile
return mempty {
savedConfigureFlags = mempty {
configHcFlavor = toFlag defaultCompiler,
@@ -164,6 +165,10 @@ baseSavedConfig = do
},
savedUserInstallDirs = mempty {
prefix = toFlag (toPathTemplate userPrefix)
+ },
+ savedGlobalFlags = mempty {
+ globalLogsDir = toFlag logsDir,
+ globalWorldFile = toFlag worldFile
}
}
@@ -177,10 +182,12 @@ initialSavedConfig :: IO SavedConfig
initialSavedConfig = do
cacheDir <- defaultCacheDir
logsDir <- defaultLogsDir
+ worldFile <- defaultWorldFile
return mempty {
savedGlobalFlags = mempty {
globalCacheDir = toFlag cacheDir,
- globalRemoteRepos = [defaultRemoteRepo]
+ globalRemoteRepos = [defaultRemoteRepo],
+ globalWorldFile = toFlag worldFile
},
savedInstallFlags = mempty {
installSummaryFile = [toPathTemplate (logsDir </> "build.log")],
@@ -188,6 +195,8 @@ initialSavedConfig = do
}
}
+--TODO: misleading, there's no way to override this default
+-- either make it possible or rename to simply getCabalDir.
defaultCabalDir :: IO FilePath
defaultCabalDir = getAppUserDataDirectory "cabal"
@@ -206,6 +215,12 @@ defaultLogsDir = do
dir <- defaultCabalDir
return $ dir </> "logs"
+-- | Default position of the world file
+defaultWorldFile :: IO FilePath
+defaultWorldFile = do
+ dir <- defaultCabalDir
+ return $ dir </> "world"
+
defaultCompiler :: CompilerFlavor
defaultCompiler = fromMaybe GHC defaultCompilerFlavor
@@ -502,64 +517,3 @@ ppSection name arg fields def cur =
installDirsFields :: [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields = map viewAsFieldDescr installDirsOptions
---TODO: this is now exported in Cabal-1.5
-installDirsOptions :: [OptionField (InstallDirs (Flag PathTemplate))]
-installDirsOptions =
- [ option "" ["prefix"]
- "bake this prefix in preparation of installation"
- prefix (\v flags -> flags { prefix = v })
- installDirArg
-
- , option "" ["bindir"]
- "installation directory for executables"
- bindir (\v flags -> flags { bindir = v })
- installDirArg
-
- , option "" ["libdir"]
- "installation directory for libraries"
- libdir (\v flags -> flags { libdir = v })
- installDirArg
-
- , option "" ["libsubdir"]
- "subdirectory of libdir in which libs are installed"
- libsubdir (\v flags -> flags { libsubdir = v })
- installDirArg
-
- , option "" ["libexecdir"]
- "installation directory for program executables"
- libexecdir (\v flags -> flags { libexecdir = v })
- installDirArg
-
- , option "" ["datadir"]
- "installation directory for read-only data"
- datadir (\v flags -> flags { datadir = v })
- installDirArg
-
- , option "" ["datasubdir"]
- "subdirectory of datadir in which data files are installed"
- datasubdir (\v flags -> flags { datasubdir = v })
- installDirArg
-
- , option "" ["docdir"]
- "installation directory for documentation"
- docdir (\v flags -> flags { docdir = v })
- installDirArg
-
- , option "" ["htmldir"]
- "installation directory for HTML documentation"
- htmldir (\v flags -> flags { htmldir = v })
- installDirArg
-
- , option "" ["haddockdir"]
- "installation directory for haddock interfaces"
- haddockdir (\v flags -> flags { haddockdir = v })
- installDirArg
- ]
- where
- installDirArg _sf _lf d get set =
- reqArgFlag "DIR" _sf _lf d
- (fmap fromPathTemplate . get) (set . fmap toPathTemplate)
-
- reqArgFlag ad = reqArg ad (fmap toFlag (readP_to_E err parseFilePathQ))
- (map (show . showFilePath) . flagToList)
- where err _ = "paths with spaces must use Haskell String syntax"
diff --git a/cabal-install-0.8.2/Distribution/Client/Configure.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Configure.hs
index a1cfe2c..8e3d177 100644
--- a/cabal-install-0.8.2/Distribution/Client/Configure.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Configure.hs
@@ -91,7 +91,7 @@ configure verbosity packageDBs repos comp conf
configureCommand (const configFlags) extraArgs
Right installPlan -> case InstallPlan.ready installPlan of
- [pkg@(ConfiguredPackage (AvailablePackage _ _ LocalUnpackedPackage) _ _)] ->
+ [pkg@(ConfiguredPackage (AvailablePackage _ _ (LocalUnpackedPackage _)) _ _)] ->
configurePackage verbosity
(InstallPlan.planPlatform installPlan)
(InstallPlan.planCompiler installPlan)
@@ -113,7 +113,7 @@ configure verbosity packageDBs repos comp conf
then packageDBs
else packageDBs ++ [UserPackageDB],
usePackageIndex = if UserPackageDB `elem` packageDBs
- then index
+ then Just index
else Nothing,
useProgramConfig = conf,
useDistPref = fromFlagOrDefault
@@ -128,7 +128,7 @@ configure verbosity packageDBs repos comp conf
--
planLocalPackage :: Verbosity -> Compiler
-> ConfigFlags -> ConfigExFlags
- -> Maybe (PackageIndex InstalledPackage)
+ -> PackageIndex InstalledPackage
-> AvailablePackageDb
-> IO (Progress String String InstallPlan)
planLocalPackage verbosity comp configFlags configExFlags installed
@@ -139,11 +139,11 @@ planLocalPackage verbosity comp configFlags configExFlags installed
-- dependency on exactly that package. So the resolver ends up having
-- to pick the local package.
available' = PackageIndex.insert localPkg mempty
- installed' = PackageIndex.deletePackageId (packageId localPkg) `fmap` installed
+ installed' = PackageIndex.deletePackageId (packageId localPkg) installed
localPkg = AvailablePackage {
packageInfoId = packageId pkg,
Available.packageDescription = pkg,
- packageSource = LocalUnpackedPackage
+ packageSource = LocalUnpackedPackage Nothing
}
targets = [packageName pkg]
constraints = [PackageVersionConstraint (packageName pkg)
diff --git a/cabal-install-0.8.2/Distribution/Client/Dependency.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency.hs
index 8675efe..9a30450 100644
--- a/cabal-install-0.8.2/Distribution/Client/Dependency.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency.hs
@@ -17,6 +17,8 @@ module Distribution.Client.Dependency (
resolveDependencies,
resolveDependenciesWithProgress,
+ resolveAvailablePackages,
+
dependencyConstraints,
dependencyTargets,
@@ -27,7 +29,6 @@ module Distribution.Client.Dependency (
upgradableDependencies,
) where
-import Distribution.Client.Dependency.Bogus (bogusResolver)
import Distribution.Client.Dependency.TopDown (topDownResolver)
import qualified Distribution.Client.PackageIndex as PackageIndex
import Distribution.Client.PackageIndex (PackageIndex)
@@ -41,19 +42,21 @@ import Distribution.Client.Dependency.Types
, Progress(..), foldProgress )
import Distribution.Package
( PackageIdentifier(..), PackageName(..), packageVersion, packageName
- , Dependency(..), Package(..), PackageFixedDeps(..) )
+ , Dependency(Dependency), Package(..), PackageFixedDeps(..) )
import Distribution.Version
- ( VersionRange, anyVersion, orLaterVersion, isAnyVersion )
+ ( VersionRange, anyVersion, orLaterVersion
+ , isAnyVersion, withinRange, simplifyVersionRange )
import Distribution.Compiler
( CompilerId(..) )
import Distribution.System
( Platform )
import Distribution.Simple.Utils (comparing)
import Distribution.Client.Utils (mergeBy, MergeResult(..))
+import Distribution.Text
+ ( display )
import Data.List (maximumBy)
-import Data.Monoid (Monoid(mempty))
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, isJust)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Set (Set)
@@ -112,7 +115,7 @@ data PackagePreference
resolveDependencies :: Platform
-> CompilerId
- -> Maybe (PackageIndex InstalledPackage)
+ -> PackageIndex InstalledPackage
-> PackageIndex AvailablePackage
-> PackagesPreference
-> [PackageConstraint]
@@ -121,44 +124,25 @@ resolveDependencies :: Platform
resolveDependencies platform comp installed available
preferences constraints targets =
foldProgress (flip const) Left Right $
- resolveDependenciesWithProgress platform comp installed available
- preferences constraints targets
+ resolveDependenciesWithProgress
+ platform comp installed available
+ preferences constraints targets
resolveDependenciesWithProgress :: Platform
-> CompilerId
- -> Maybe (PackageIndex InstalledPackage)
+ -> PackageIndex InstalledPackage
-> PackageIndex AvailablePackage
-> PackagesPreference
-> [PackageConstraint]
-> [PackageName]
-> Progress String String InstallPlan
-resolveDependenciesWithProgress platform comp (Just installed) =
- dependencyResolver defaultResolver platform comp installed
-
-resolveDependenciesWithProgress platform comp Nothing =
- dependencyResolver bogusResolver platform comp mempty
-
-hideBrokenPackages :: PackageFixedDeps p => PackageIndex p -> PackageIndex p
-hideBrokenPackages index =
- check (null . PackageIndex.brokenPackages)
- . foldr (PackageIndex.deletePackageId . packageId) index
- . PackageIndex.reverseDependencyClosure index
- . map (packageId . fst)
- $ PackageIndex.brokenPackages index
- where
- check p x = assert (p x) x
-
-dependencyResolver
- :: DependencyResolver
- -> Platform -> CompilerId
- -> PackageIndex InstalledPackage
- -> PackageIndex AvailablePackage
- -> PackagesPreference
- -> [PackageConstraint]
- -> [PackageName]
- -> Progress String String InstallPlan
-dependencyResolver resolver platform comp installed available
- pref constraints targets =
+resolveDependenciesWithProgress platform comp installed available
+ pref constraints targets
+ -- TODO: the top down resolver chokes on the base constraints
+ -- below when there are no targets and thus no dep on base.
+ -- Need to refactor contraints separate from needing packages.
+ | null targets = return (toPlan [])
+ | otherwise =
let installed' = hideBrokenPackages installed
-- If the user is not explicitly asking to upgrade base then lets
-- prevent that from happening accidentally since it is usually not what
@@ -171,8 +155,8 @@ dependencyResolver resolver platform comp installed available
, not (null (PackageIndex.lookupPackageName installed pkgname)) ]
preferences = interpretPackagesPreference (Set.fromList targets) pref
in fmap toPlan
- $ resolver platform comp installed' available
- preferences (extraConstraints ++ constraints) targets
+ $ defaultResolver platform comp installed' available
+ preferences (extraConstraints ++ constraints) targets
where
toPlan pkgs =
@@ -183,6 +167,16 @@ dependencyResolver resolver platform comp installed available
: "The proposed (invalid) plan contained the following problems:"
: map InstallPlan.showPlanProblem problems
+hideBrokenPackages :: PackageFixedDeps p => PackageIndex p -> PackageIndex p
+hideBrokenPackages index =
+ check (null . PackageIndex.brokenPackages)
+ . foldr (PackageIndex.deletePackageId . packageId) index
+ . PackageIndex.reverseDependencyClosure index
+ . map (packageId . fst)
+ $ PackageIndex.brokenPackages index
+ where
+ check p x = assert (p x) x
+
-- | Give an interpretation to the global 'PackagesPreference' as
-- specific per-package 'PackageVersionPreference'.
--
@@ -213,6 +207,97 @@ interpretPackagesPreference selected (PackagesPreference defaultPref prefs) =
if pkgname `Set.member` selected then PreferLatest
else PreferInstalled
+-- ------------------------------------------------------------
+-- * Simple resolver that ignores dependencies
+-- ------------------------------------------------------------
+
+-- | A simplistic method of resolving a list of target package names to
+-- available packages.
+--
+-- Specifically, it does not consider package dependencies at all. Unlike
+-- 'resolveDependencies', no attempt is made to ensure that the selected
+-- packages have dependencies that are satisfiable or consistent with
+-- each other.
+--
+-- It is suitable for tasks such as selecting packages to download for user
+-- inspection. It is not suitable for selecting packages to install.
+--
+-- Note: if no installed package index is available, it is ok to pass 'mempty'.
+-- It simply means preferences for installed packages will be ignored.
+--
+resolveAvailablePackages
+ :: PackageIndex InstalledPackage
+ -> PackageIndex AvailablePackage
+ -> PackagesPreference
+ -> [PackageConstraint]
+ -> [PackageName]
+ -> Either [ResolveNoDepsError] [AvailablePackage]
+resolveAvailablePackages installed available preferences constraints targets =
+ collectEithers (map selectPackage targets)
+ where
+ selectPackage :: PackageName -> Either ResolveNoDepsError AvailablePackage
+ selectPackage pkgname
+ | null choices = Left $! ResolveUnsatisfiable pkgname requiredVersions
+ | otherwise = Right $! maximumBy bestByPrefs choices
+
+ where
+ -- Constraints
+ requiredVersions = packageConstraints pkgname
+ pkgDependency = Dependency pkgname requiredVersions
+ choices = PackageIndex.lookupDependency available pkgDependency
+
+ -- Preferences
+ PackagePreferences preferredVersions preferInstalled
+ = packagePreferences pkgname
+
+ bestByPrefs = comparing $ \pkg ->
+ (installPref pkg, versionPref pkg, packageVersion pkg)
+ installPref = case preferInstalled of
+ PreferLatest -> const False
+ PreferInstalled -> isJust . PackageIndex.lookupPackageId installed
+ . packageId
+ versionPref pkg = packageVersion pkg `withinRange` preferredVersions
+
+ packageConstraints :: PackageName -> VersionRange
+ packageConstraints pkgname =
+ Map.findWithDefault anyVersion pkgname packageVersionConstraintMap
+ packageVersionConstraintMap =
+ Map.fromList [ (name, range)
+ | PackageVersionConstraint name range <- constraints ]
+
+ packagePreferences :: PackageName -> PackagePreferences
+ packagePreferences = interpretPackagesPreference (Set.fromList targets) preferences
+
+
+collectEithers :: [Either a b] -> Either [a] [b]
+collectEithers = collect . partitionEithers
+ where
+ collect ([], xs) = Right xs
+ collect (errs,_) = Left errs
+ partitionEithers :: [Either a b] -> ([a],[b])
+ partitionEithers = foldr (either left right) ([],[])
+ where
+ left a (l, r) = (a:l, r)
+ right a (l, r) = (l, a:r)
+
+-- | Errors for 'resolveWithoutDependencies'.
+--
+data ResolveNoDepsError =
+
+ -- | A package name which cannot be resolved to a specific package.
+ -- Also gives the constraint on the version and whether there was
+ -- a constraint on the package being installed.
+ ResolveUnsatisfiable PackageName VersionRange
+
+instance Show ResolveNoDepsError where
+ show (ResolveUnsatisfiable name ver) =
+ "There is no available version of " ++ display name
+ ++ " that satisfies " ++ display (simplifyVersionRange ver)
+
+-- ------------------------------------------------------------
+-- * Finding upgradable packages
+-- ------------------------------------------------------------
+
-- | Given the list of installed packages and available packages, figure
-- out which packages can be upgraded.
--
diff --git a/cabal-install-0.8.2/Distribution/Client/Dependency/TopDown.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency/TopDown.hs
index fbab018..fbab018 100644
--- a/cabal-install-0.8.2/Distribution/Client/Dependency/TopDown.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency/TopDown.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/Dependency/TopDown/Constraints.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency/TopDown/Constraints.hs
index 07b6b1a..07b6b1a 100644
--- a/cabal-install-0.8.2/Distribution/Client/Dependency/TopDown/Constraints.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency/TopDown/Constraints.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/Dependency/TopDown/Types.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency/TopDown/Types.hs
index 39c9ed5..39c9ed5 100644
--- a/cabal-install-0.8.2/Distribution/Client/Dependency/TopDown/Types.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency/TopDown/Types.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/Dependency/Types.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency/Types.hs
index e5da64e..e5da64e 100644
--- a/cabal-install-0.8.2/Distribution/Client/Dependency/Types.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Dependency/Types.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/Fetch.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Fetch.hs
index 9239aee..6e8a91a 100644
--- a/cabal-install-0.8.2/Distribution/Client/Fetch.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Fetch.hs
@@ -24,9 +24,12 @@ module Distribution.Client.Fetch (
import Distribution.Client.Types
( UnresolvedDependency (..), AvailablePackage(..)
, AvailablePackageSource(..), AvailablePackageDb(..)
- , Repo(..), RemoteRepo(..), LocalRepo(..) )
-import Distribution.Client.Dependency
+ , Repo(..), RemoteRepo(..), LocalRepo(..)
+ , InstalledPackage )
+import Distribution.Client.PackageIndex (PackageIndex)
+import Distribution.Client.Dependency as Dependency
( resolveDependenciesWithProgress
+ , resolveAvailablePackages
, dependencyConstraints, dependencyTargets
, PackagesPreference(..), PackagesPreferenceDefault(..)
, PackagePreference(..) )
@@ -38,14 +41,19 @@ import Distribution.Client.IndexUtils as IndexUtils
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.HttpUtils
( downloadURI, isOldHackageURI )
+import Distribution.Client.Setup
+ ( FetchFlags(..) )
import Distribution.Package
- ( PackageIdentifier, packageName, packageVersion, Dependency(..) )
+ ( PackageIdentifier, packageId, packageName, packageVersion
+ , Dependency(..) )
import qualified Distribution.Client.PackageIndex as PackageIndex
import Distribution.Simple.Compiler
( Compiler(compilerId), PackageDBStack )
import Distribution.Simple.Program
( ProgramConfiguration )
+import Distribution.Simple.Setup
+ ( fromFlag )
import Distribution.Simple.Utils
( die, notice, info, debug, setupMessage )
import Distribution.System
@@ -97,7 +105,9 @@ downloadIndex verbosity repo cacheDir = do
-- |Returns @True@ if the package has already been fetched.
isFetched :: AvailablePackage -> IO Bool
isFetched (AvailablePackage pkgid _ source) = case source of
- LocalUnpackedPackage -> return True
+ LocalUnpackedPackage _ -> return True
+ LocalTarballPackage _ -> return True
+ RemoteTarballPackage _ -> return False --TODO: ad-hoc download caching
RepoTarballPackage repo -> doesFileExist (packageFile repo pkgid)
-- |Fetch a package if we don't have it already.
@@ -116,48 +126,105 @@ fetch :: Verbosity
-> [Repo]
-> Compiler
-> ProgramConfiguration
+ -> FetchFlags
-> [UnresolvedDependency]
-> IO ()
-fetch verbosity packageDBs repos comp conf deps = do
+fetch verbosity _ _ _ _ _ [] =
+ notice verbosity "No packages requested. Nothing to do."
+
+fetch verbosity packageDBs repos comp conf flags deps = do
+
installed <- getInstalledPackages verbosity comp packageDBs conf
- AvailablePackageDb available availablePrefs
- <- getAvailablePackages verbosity repos
+ availableDb@(AvailablePackageDb available _)
+ <- getAvailablePackages verbosity repos
deps' <- IndexUtils.disambiguateDependencies available deps
- let -- Hide the packages given on the command line so that the dep resolver
- -- will decide that they need fetching, even if they're already
- -- installed. Sicne we want to get the source packages of things we might
- -- have installed (but not have the sources for).
- installed' = fmap (hideGivenDeps deps') installed
- hideGivenDeps pkgs index =
- foldr PackageIndex.deletePackageName index
- [ name | UnresolvedDependency (Dependency name _) _ <- pkgs ]
-
- let progress = resolveDependenciesWithProgress
- buildPlatform (compilerId comp)
- installed' available
- (PackagesPreference PreferLatestForSelected
- [ PackageVersionPreference name ver
- | (name, ver) <- Map.toList availablePrefs ])
- (dependencyConstraints deps')
- (dependencyTargets deps')
- notice verbosity "Resolving dependencies..."
- maybePlan <- foldProgress (\message rest -> info verbosity message >> rest)
- (return . Left) (return . Right) progress
- case maybePlan of
- Left message -> die message
- Right pkgs -> do
- ps <- filterM (fmap not . isFetched)
- [ pkg | (InstallPlan.Configured
- (InstallPlan.ConfiguredPackage pkg _ _))
- <- InstallPlan.toList pkgs ]
- when (null ps) $
- notice verbosity $ "No packages need to be fetched. "
- ++ "All the requested packages are already cached."
-
- sequence_
- [ fetchPackage verbosity repo pkgid
- | (AvailablePackage pkgid _ (RepoTarballPackage repo)) <- ps ]
+ pkgs <- resolvePackages verbosity
+ includeDeps comp
+ installed availableDb deps'
+
+ pkgs' <- filterM (fmap not . isFetched) pkgs
+ when (null pkgs') $
+ notice verbosity $ "No packages need to be fetched. "
+ ++ "All the requested packages are already cached."
+ if dryRun
+ then notice verbosity $ unlines $
+ "The following packages would be fetched:"
+ : map (display . packageId) pkgs'
+ else sequence_
+ [ fetchPackage verbosity repo pkgid
+ | (AvailablePackage pkgid _ (RepoTarballPackage repo)) <- pkgs' ]
+ where
+ includeDeps = fromFlag (fetchDeps flags)
+ dryRun = fromFlag (fetchDryRun flags)
+
+
+resolvePackages
+ :: Verbosity
+ -> Bool
+ -> Compiler
+ -> PackageIndex InstalledPackage
+ -> AvailablePackageDb
+ -> [UnresolvedDependency]
+ -> IO [AvailablePackage]
+resolvePackages verbosity includeDependencies comp
+ installed (AvailablePackageDb available availablePrefs) deps
+
+ | includeDependencies = do
+
+ notice verbosity "Resolving dependencies..."
+ plan <- foldProgress logMsg die return $
+ resolveDependenciesWithProgress
+ buildPlatform (compilerId comp)
+ installed' available
+ preferences constraints
+ targets
+ --TODO: suggest using --no-deps, unpack or fetch -o
+ -- if cannot satisfy deps
+ --TODO: add commandline constraint and preference args for fetch
+
+ return (selectPackagesToFetch plan)
+
+ | otherwise = do
+
+ either (die . unlines . map show) return $
+ resolveAvailablePackages
+ installed available
+ preferences constraints
+ targets
+
+ where
+ targets = dependencyTargets deps
+ constraints = dependencyConstraints deps
+ preferences = PackagesPreference
+ PreferLatestForSelected
+ [ PackageVersionPreference name ver
+ | (name, ver) <- Map.toList availablePrefs ]
+
+ installed' = hideGivenDeps deps installed
+
+ -- Hide the packages given on the command line so that the dep resolver
+ -- will decide that they need fetching, even if they're already
+ -- installed. Sicne we want to get the source packages of things we might
+ -- have installed (but not have the sources for).
+
+ -- TODO: to allow for preferences on selecting an available version
+ -- corresponding to a package we've got installed, instead of hiding the
+ -- installed instances, we should add a constraint on using an installed
+ -- instance.
+ hideGivenDeps pkgs index =
+ foldr PackageIndex.deletePackageName index
+ [ name | UnresolvedDependency (Dependency name _) _ <- pkgs ]
+
+ -- The packages we want to fetch are those packages the 'InstallPlan' that
+ -- are in the 'InstallPlan.Configured' state.
+ selectPackagesToFetch :: InstallPlan.InstallPlan -> [AvailablePackage]
+ selectPackagesToFetch plan =
+ [ pkg | (InstallPlan.Configured (InstallPlan.ConfiguredPackage pkg _ _))
+ <- InstallPlan.toList plan ]
+
+ logMsg message rest = info verbosity message >> rest
+
-- |Generate the full path to the locally cached copy of
-- the tarball for a given @PackageIdentifer@.
diff --git a/cabal-install-0.9.5_rc20101226/Distribution/Client/GZipUtils.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/GZipUtils.hs
new file mode 100644
index 0000000..e4ce1aa
--- /dev/null
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/GZipUtils.hs
@@ -0,0 +1,44 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Distribution.Client.GZipUtils
+-- Copyright : (c) Dmitry Astapov 2010
+-- License : BSD-like
+--
+-- Maintainer : cabal-devel@gmail.com
+-- Stability : provisional
+-- Portability : portable
+--
+-- Provides a convenience functions for working with files that may or may not
+-- be zipped.
+-----------------------------------------------------------------------------
+module Distribution.Client.GZipUtils (
+ maybeDecompress,
+ ) where
+
+import qualified Data.ByteString.Lazy.Internal as BS (ByteString(..))
+import Data.ByteString.Lazy (ByteString)
+import Codec.Compression.GZip
+import Codec.Compression.Zlib.Internal
+
+-- | Attempts to decompress the `bytes' under the assumption that
+-- "data format" error at the very beginning of the stream means
+-- that it is already decompressed. Caller should make sanity checks
+-- to verify that it is not, in fact, garbage.
+--
+-- This is to deal with http proxies that lie to us and transparently
+-- decompress without removing the content-encoding header. See:
+-- <http://hackage.haskell.org/trac/hackage/ticket/686>
+--
+maybeDecompress :: ByteString -> ByteString
+maybeDecompress bytes = foldStream $ decompressWithErrors gzipOrZlibFormat defaultDecompressParams bytes
+ where
+ -- DataError at the beginning of the stream probably means that stream is not compressed.
+ -- Returning it as-is.
+ -- TODO: alternatively, we might consider looking for the two magic bytes
+ -- at the beginning of the gzip header.
+ foldStream (StreamError DataError _) = bytes
+ foldStream somethingElse = doFold somethingElse
+
+ doFold StreamEnd = BS.Empty
+ doFold (StreamChunk bs stream) = BS.Chunk bs (doFold stream)
+ doFold (StreamError _ msg) = error $ "Codec.Compression.Zlib: " ++ msg
diff --git a/cabal-install-0.8.2/Distribution/Client/Haddock.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Haddock.hs
index 8f1b992..72cebc5 100644
--- a/cabal-install-0.8.2/Distribution/Client/Haddock.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Haddock.hs
@@ -52,10 +52,14 @@ regenerateHaddockIndex verbosity pkgs conf index = do
createDirectoryIfMissing True destDir
- withTempDirectory verbosity destDir "htemp" $ \tempDir -> do
+ withTempDirectory verbosity destDir "tmphaddock" $ \tempDir -> do
- let flags = ["--gen-contents", "--gen-index", "--odir="++tempDir]
- ++ map (\(i,h) -> "--read-interface=" ++ h ++ "," ++ i) paths
+ let flags = [ "--gen-contents"
+ , "--gen-index"
+ , "--odir=" ++ tempDir
+ , "--title=Haskell modules on this system" ]
+ ++ [ "--read-interface=" ++ html ++ "," ++ interface
+ | (interface, html) <- paths ]
rawSystemProgram verbosity confHaddock flags
renameFile (tempDir </> "index.html") (tempDir </> destFile)
installDirectoryContents verbosity tempDir destDir
@@ -71,7 +75,7 @@ regenerateHaddockIndex verbosity pkgs conf index = do
$ pkgs
haddockPackagePaths :: [InstalledPackageInfo]
- -> IO ([(FilePath, FilePath)], Maybe [Char])
+ -> IO ([(FilePath, FilePath)], Maybe String)
haddockPackagePaths pkgs = do
interfaces <- sequence
[ case interfaceAndHtmlPath pkg of
diff --git a/cabal-install-0.8.2/Distribution/Client/HttpUtils.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/HttpUtils.hs
index 81f6d12..81f6d12 100644
--- a/cabal-install-0.8.2/Distribution/Client/HttpUtils.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/HttpUtils.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/IndexUtils.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/IndexUtils.hs
index 065048d..9427586 100644
--- a/cabal-install-0.8.2/Distribution/Client/IndexUtils.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/IndexUtils.hs
@@ -15,7 +15,6 @@ module Distribution.Client.IndexUtils (
getAvailablePackages,
readPackageIndexFile,
- readRepoIndex,
parseRepoIndex,
disambiguatePackageName,
@@ -63,7 +62,7 @@ import Control.Exception (evaluate)
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
import Data.ByteString.Lazy (ByteString)
-import qualified Codec.Compression.GZip as GZip (decompress)
+import Distribution.Client.GZipUtils (maybeDecompress)
import System.FilePath ((</>), takeExtension, splitDirectories, normalise)
import System.FilePath.Posix as FilePath.Posix
( takeFileName )
@@ -75,10 +74,9 @@ import System.Time
getInstalledPackages :: Verbosity -> Compiler
-> PackageDBStack -> ProgramConfiguration
- -> IO (Maybe (PackageIndex InstalledPackage))
+ -> IO (PackageIndex InstalledPackage)
getInstalledPackages verbosity comp packageDbs conf =
- fmap (fmap convert)
- (Configure.getInstalledPackages verbosity comp packageDbs conf)
+ fmap convert (Configure.getInstalledPackages verbosity comp packageDbs conf)
where
convert :: InstalledPackageIndex.PackageIndex -> PackageIndex InstalledPackage
convert index = PackageIndex.fromList $
@@ -180,7 +178,7 @@ readRepoIndex verbosity repo = handleNotFound $ do
case repoKind repo of
Left remoteRepo -> warn verbosity $
"The package list for '" ++ remoteRepoName remoteRepo
- ++ "' does not exist. Run 'cabal update' to download it."
+ ++ "' does not exist. Run 'hackport update' to download it."
Right _localRepo -> warn verbosity $
"The package list for the local repo '" ++ repoLocalDir repo
++ "' is missing. The repo is invalid."
@@ -196,7 +194,7 @@ readRepoIndex verbosity repo = handleNotFound $ do
Left remoteRepo -> warn verbosity $
"The package list for '" ++ remoteRepoName remoteRepo
++ "' is " ++ show (tdDay diff) ++ " days old.\nRun "
- ++ "'cabal update' to get the latest list of available packages."
+ ++ "'hackport update' to get the latest list of available packages."
Right _localRepo -> return ()
parsePreferredVersions :: String -> [Dependency]
@@ -220,7 +218,7 @@ readPackageIndexFile :: Package pkg
readPackageIndexFile mkPkg indexFile = do
pkgs <- either fail return
. parseRepoIndex
- . GZip.decompress
+ . maybeDecompress
=<< BS.readFile indexFile
evaluate $ PackageIndex.fromList
@@ -279,7 +277,7 @@ disambiguateDependencies index deps = do
ambigious -> die $ unlines
[ if null matches
then "There is no package named " ++ display name ++ ". "
- ++ "Perhaps you need to run 'cabal update' first?"
+ ++ "Perhaps you need to run 'hackport update' first?"
else "The package name " ++ display name ++ "is ambigious. "
++ "It could be: " ++ intercalate ", " (map display matches)
| (name, matches) <- ambigious ]
diff --git a/cabal-install-0.8.2/Distribution/Client/Init.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Init.hs
index 429a484..429a484 100644
--- a/cabal-install-0.8.2/Distribution/Client/Init.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Init.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/Init/Heuristics.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Init/Heuristics.hs
index 82f4745..19ec668 100644
--- a/cabal-install-0.8.2/Distribution/Client/Init/Heuristics.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Init/Heuristics.hs
@@ -66,7 +66,9 @@ scanForModulesIn projectRoot srcRoot = scan srcRoot []
scan dir hierarchy = do
entries <- getDirectoryContents (projectRoot </> dir)
(files, dirs) <- liftM partitionEithers (mapM (tagIsDir dir) entries)
- let modules = catMaybes [ guessModuleName hierarchy file | file <- files ]
+ let modules = catMaybes [ guessModuleName hierarchy file
+ | file <- files
+ , isUpper (head file) ]
recMods <- mapM (scanRecursive dir hierarchy) dirs
return $ concat (modules : recMods)
tagIsDir parent entry = do
@@ -83,9 +85,11 @@ scanForModulesIn projectRoot srcRoot = scan srcRoot []
ext = case takeExtension entry of '.':e -> e; e -> e
scanRecursive parent hierarchy entry
| isUpper (head entry) = scan (parent </> entry) (entry : hierarchy)
- | isLower (head entry) && entry /= "dist" =
+ | isLower (head entry) && not (ignoreDir entry) =
scanForModulesIn projectRoot $ foldl (</>) srcRoot (entry : hierarchy)
| otherwise = return []
+ ignoreDir ('.':_) = True
+ ignoreDir dir = dir `elem` ["dist", "_darcs"]
-- Unfortunately we cannot use the version exported by Distribution.Simple.Program
knownSuffixHandlers :: [(String,String)]
diff --git a/cabal-install-0.8.2/Distribution/Client/Init/Licenses.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Init/Licenses.hs
index 73bba06..73bba06 100644
--- a/cabal-install-0.8.2/Distribution/Client/Init/Licenses.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Init/Licenses.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/Init/Types.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Init/Types.hs
index aace727..aace727 100644
--- a/cabal-install-0.8.2/Distribution/Client/Init/Types.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Init/Types.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/Install.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Install.hs
index f8927f3..3cc204e 100644
--- a/cabal-install-0.8.2/Distribution/Client/Install.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Install.hs
@@ -1,10 +1,12 @@
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.Install
--- Copyright : (c) David Himmelstrup 2005
+-- Copyright : (c) 2005 David Himmelstrup
+-- 2007 Bjorn Bringert
+-- 2007-2010 Duncan Coutts
-- License : BSD-like
--
--- Maintainer : lemmih@gmail.com
+-- Maintainer : cabal-devel@haskell.org
-- Stability : provisional
-- Portability : portable
--
@@ -16,7 +18,7 @@ module Distribution.Client.Install (
) where
import Data.List
- ( unfoldr, find, nub, sort )
+ ( unfoldr, find, nub, sort, partition )
import Data.Maybe
( isJust, fromMaybe )
import qualified Data.Map as Map
@@ -49,9 +51,11 @@ import Distribution.Client.Dependency
, PackageConstraint(..), dependencyConstraints, dependencyTargets
, PackagesPreference(..), PackagesPreferenceDefault(..)
, PackagePreference(..)
- , upgradableDependencies
, Progress(..), foldProgress, )
-import Distribution.Client.Fetch (fetchPackage)
+import Distribution.Client.Fetch
+ ( fetchPackage )
+import Distribution.Client.HttpUtils
+ ( downloadURI )
import qualified Distribution.Client.Haddock as Haddock (regenerateHaddockIndex)
-- import qualified Distribution.Client.Info as Info
import Distribution.Client.IndexUtils as IndexUtils
@@ -60,10 +64,11 @@ import Distribution.Client.IndexUtils as IndexUtils
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Client.Setup
- ( ConfigFlags(..), configureCommand, filterConfigureFlags
+ ( GlobalFlags(..)
+ , ConfigFlags(..), configureCommand, filterConfigureFlags
, ConfigExFlags(..), InstallFlags(..) )
import Distribution.Client.Config
- ( defaultLogsDir, defaultCabalDir )
+ ( defaultCabalDir )
import Distribution.Client.Tar (extractTarGzFile)
import Distribution.Client.Types as Available
( UnresolvedDependency(..), AvailablePackage(..)
@@ -82,6 +87,7 @@ import qualified Distribution.Client.BuildReports.Storage as BuildReports
import qualified Distribution.Client.InstallSymlink as InstallSymlink
( symlinkBinaries )
import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade
+import qualified Distribution.Client.World as World
import Paths_cabal_install (getBinDir)
import Distribution.Simple.Compiler
@@ -103,7 +109,7 @@ import Distribution.Simple.InstallDirs as InstallDirs
( PathTemplate, fromPathTemplate, toPathTemplate, substPathTemplate
, initialPathTemplateEnv, installDirsTemplateEnv )
import Distribution.Package
- ( PackageName, PackageIdentifier, packageName, packageVersion
+ ( PackageName(..), PackageIdentifier, packageName, packageVersion
, Package(..), PackageFixedDeps(..)
, Dependency(..), thisPackageVersion )
import qualified Distribution.PackageDescription as PackageDescription
@@ -127,261 +133,135 @@ import Distribution.Verbosity as Verbosity
( Verbosity, showForCabal, verbose )
import Distribution.Simple.BuildPaths ( exeExtension )
-data InstallMisc = InstallMisc {
- rootCmd :: Maybe FilePath,
- libVersion :: Maybe Version
- }
+--TODO:
+-- * add --upgrade-deps flag
+-- * add --only-deps flag
+-- * eliminate upgrade, replaced by --upgrade-deps and world target
+-- * assign flags to packages individually
+-- * complain about flags that do not apply to any package given as target
+-- so flags do not apply to dependencies, only listed, can use flag
+-- constraints for dependencies
+-- * only record applicable flags in world file
+-- * allow flag constraints
+-- * allow installed constraints
+-- * allow flag and installed preferences
+-- * change world file to use cabal section syntax
+-- * allow persistent configure flags for each package individually
+
+-- ------------------------------------------------------------
+-- * Top level user actions
+-- ------------------------------------------------------------
+
+-- | An installation target given by the user. At the moment this
+-- is just a named package, possibly with a version constraint.
+-- It should be generalised to handle other targets like http or dirs.
+--
+type InstallTarget = UnresolvedDependency
--- |Installs the packages needed to satisfy a list of dependencies.
+-- | Installs the packages needed to satisfy a list of dependencies.
+--
install, upgrade
:: Verbosity
-> PackageDBStack
-> [Repo]
-> Compiler
-> ProgramConfiguration
+ -> GlobalFlags
-> ConfigFlags
-> ConfigExFlags
-> InstallFlags
- -> [UnresolvedDependency]
+ -> [InstallTarget]
-> IO ()
install verbosity packageDB repos comp conf
- configFlags configExFlags installFlags deps =
+ globalFlags configFlags configExFlags installFlags targets =
- installWithPlanner planner
- verbosity packageDB repos comp conf
- configFlags configExFlags installFlags
- where
- planner :: Planner
- planner | null deps = planLocalPackage verbosity
- comp configFlags configExFlags
- | otherwise = planRepoPackages PreferLatestForSelected
- comp configFlags configExFlags installFlags deps
-
-upgrade verbosity packageDB repos comp conf
- configFlags configExFlags installFlags deps =
+ installWithPlanner verbosity context planner targets
- installWithPlanner planner
- verbosity packageDB repos comp conf
- configFlags configExFlags installFlags
where
- planner :: Planner
- planner | null deps = planUpgradePackages
- comp configFlags configExFlags
- | otherwise = planRepoPackages PreferAllLatest
- comp configFlags configExFlags installFlags deps
+ context :: InstallContext
+ context = (packageDB, repos, comp, conf,
+ globalFlags, configFlags, configExFlags, installFlags)
-type Planner = Maybe (PackageIndex InstalledPackage)
+ planner :: Planner
+ planner
+ | null targets = planLocalPackage verbosity
+ comp configFlags configExFlags
+
+ | otherwise = planRepoPackages defaultPref
+ comp globalFlags configFlags configExFlags
+ installFlags targets
+
+ defaultPref
+ | fromFlag (installUpgradeDeps installFlags) = PreferAllLatest
+ | otherwise = PreferLatestForSelected
+
+
+upgrade _ _ _ _ _ _ _ _ _ _ = die $
+ "Use the 'cabal install' command instead of 'cabal upgrade'.\n"
+ ++ "You can install the latest version of a package using 'cabal install'. "
+ ++ "The 'cabal upgrade' command has been removed because people found it "
+ ++ "confusing and it often led to broken packages.\n"
+ ++ "If you want the old upgrade behaviour then use the install command "
+ ++ "with the --upgrade-dependencies flag (but check first with --dry-run "
+ ++ "to see what would happen). This will try to pick the latest versions "
+ ++ "of all dependencies, rather than the usual behaviour of trying to pick "
+ ++ "installed versions of all dependencies. If you do use "
+ ++ "--upgrade-dependencies, it is recommended that you do not upgrade core "
+ ++ "packages (e.g. by using appropriate --constraint= flags)."
+
+
+type Planner = PackageIndex InstalledPackage
-> AvailablePackageDb
-> IO (Progress String String InstallPlan)
--- |Installs the packages generated by a planner.
-installWithPlanner ::
- Planner
- -> Verbosity
- -> PackageDBStack
- -> [Repo]
- -> Compiler
- -> ProgramConfiguration
- -> ConfigFlags
- -> ConfigExFlags
- -> InstallFlags
- -> IO ()
-installWithPlanner planner verbosity packageDBs repos comp conf
- configFlags configExFlags installFlags = do
+type InstallContext = ( PackageDBStack
+ , [Repo]
+ , Compiler
+ , ProgramConfiguration
+ , GlobalFlags
+ , ConfigFlags
+ , ConfigExFlags
+ , InstallFlags )
- installed <- getInstalledPackages verbosity comp packageDBs conf
- available <- getAvailablePackages verbosity repos
-
- progress <- planner installed available
+-- | Top-level orchestration. Installs the packages generated by a planner.
+--
+installWithPlanner :: Verbosity
+ -> InstallContext
+ -> Planner
+ -> [UnresolvedDependency]
+ -> IO ()
+installWithPlanner verbosity
+ context@(packageDBs, repos, comp, conf, _, _, _, installFlags)
+ planner targets = do
+
+ installed <- getInstalledPackages verbosity comp packageDBs conf
+ available <- getAvailablePackages verbosity repos
notice verbosity "Resolving dependencies..."
- maybePlan <- foldProgress (\message rest -> info verbosity message >> rest)
- (return . Left) (return . Right) progress
- case maybePlan of
- Left message -> die message
- Right installPlan -> do
- let nothingToInstall = null (InstallPlan.ready installPlan)
- when nothingToInstall $
- notice verbosity $
- "No packages to be installed. All the requested packages are "
- ++ "already installed.\n If you want to reinstall anyway then use "
- ++ "the --reinstall flag."
-
- when (dryRun || verbosity >= verbose) $
- printDryRun verbosity installed installPlan
-
- unless dryRun $ do
- logsDir <- defaultLogsDir
- let platform = InstallPlan.planPlatform installPlan
- compid = InstallPlan.planCompiler installPlan
- installPlan' <-
- executeInstallPlan installPlan $ \cpkg ->
- installConfiguredPackage platform compid configFlags
- cpkg $ \configFlags' src pkg ->
- installAvailablePackage verbosity (packageId pkg) src $ \mpath ->
- installUnpackedPackage verbosity (setupScriptOptions installed)
- miscOptions configFlags' installFlags
- compid pkg mpath (useLogFile logsDir)
-
- -- build reporting, local and remote
- let buildReports = BuildReports.fromInstallPlan installPlan'
- BuildReports.storeLocal (installSummaryFile installFlags) buildReports
- when (reportingLevel >= AnonymousReports) $
- BuildReports.storeAnonymous buildReports
- when (reportingLevel == DetailedReports) $
- storeDetailedBuildReports verbosity logsDir buildReports
- regenerateHaddockIndex verbosity packageDBs comp conf
- configFlags installFlags installPlan'
- symlinkBinaries verbosity configFlags installFlags installPlan'
- printBuildFailures installPlan'
-
- where
- setupScriptOptions index = SetupScriptOptions {
- useCabalVersion = maybe anyVersion thisVersion (libVersion miscOptions),
- useCompiler = Just comp,
- -- Hack: we typically want to allow the UserPackageDB for finding the
- -- Cabal lib when compiling any Setup.hs even if we're doing a global
- -- install. However we also allow looking in a specific package db.
- usePackageDB = if UserPackageDB `elem` packageDBs
- then packageDBs
- else let (db@GlobalPackageDB:dbs) = packageDBs
- in db : UserPackageDB : dbs,
- --TODO: use Ord instance:
- -- insert UserPackageDB packageDBs
- usePackageIndex = if UserPackageDB `elem` packageDBs
- then index
- else Nothing,
- useProgramConfig = conf,
- useDistPref = fromFlagOrDefault
- (useDistPref defaultSetupScriptOptions)
- (configDistPref configFlags),
- useLoggingHandle = Nothing,
- useWorkingDir = Nothing
- }
- reportingLevel = fromFlag (installBuildReports installFlags)
- useLogFile :: FilePath -> Maybe (PackageIdentifier -> FilePath)
- useLogFile logsDir = fmap substLogFileName logFileTemplate
- where
- logFileTemplate :: Maybe PathTemplate
- logFileTemplate --TODO: separate policy from mechanism
- | reportingLevel == DetailedReports
- = Just $ toPathTemplate $ logsDir </> "$pkgid" <.> "log"
- | otherwise
- = flagToMaybe (installLogFile installFlags)
- substLogFileName template pkg = fromPathTemplate
- . substPathTemplate env
- $ template
- where env = initialPathTemplateEnv (packageId pkg) (compilerId comp)
- dryRun = fromFlag (installDryRun installFlags)
- miscOptions = InstallMisc {
- rootCmd = if fromFlag (configUserInstall configFlags)
- then Nothing -- ignore --root-cmd if --user.
- else flagToMaybe (installRootCmd installFlags),
- libVersion = flagToMaybe (configCabalVersion configExFlags)
- }
+ installPlan <- foldProgress logMsg die return =<< planner installed available
-storeDetailedBuildReports :: Verbosity -> FilePath
- -> [(BuildReports.BuildReport, Repo)] -> IO ()
-storeDetailedBuildReports verbosity logsDir reports = sequence_
- [ do dotCabal <- defaultCabalDir
- let logFileName = display (BuildReports.package report) <.> "log"
- logFile = logsDir </> logFileName
- reportsDir = dotCabal </> "reports" </> remoteRepoName remoteRepo
- reportFile = reportsDir </> logFileName
-
- handleMissingLogFile $ do
- buildLog <- readFile logFile
- createDirectoryIfMissing True reportsDir -- FIXME
- writeFile reportFile (show (BuildReports.show report, buildLog))
+ printPlanMessages verbosity installed installPlan dryRun
- | (report, Repo { repoKind = Left remoteRepo }) <- reports
- , isLikelyToHaveLogFile (BuildReports.installOutcome report) ]
+ unless dryRun $
+ performInstallations verbosity context installed installPlan
+ >>= postInstallActions verbosity context targets
where
- isLikelyToHaveLogFile BuildReports.ConfigureFailed {} = True
- isLikelyToHaveLogFile BuildReports.BuildFailed {} = True
- isLikelyToHaveLogFile BuildReports.InstallFailed {} = True
- isLikelyToHaveLogFile BuildReports.InstallOk {} = True
- isLikelyToHaveLogFile _ = False
-
- handleMissingLogFile = Exception.handleJust missingFile $ \ioe ->
- warn verbosity $ "Missing log file for build report: "
- ++ fromMaybe "" (ioeGetFileName ioe)
-
-#if MIN_VERSION_base(4,0,0)
- missingFile ioe
-#else
- missingFile (IOException ioe)
-#endif
- | isDoesNotExistError ioe = Just ioe
- missingFile _ = Nothing
-
-regenerateHaddockIndex :: Verbosity
- -> [PackageDB]
- -> Compiler
- -> ProgramConfiguration
- -> ConfigFlags
- -> InstallFlags
- -> InstallPlan
- -> IO ()
-regenerateHaddockIndex verbosity packageDBs comp conf
- configFlags installFlags installPlan
- | haddockIndexFileIsRequested && shouldRegenerateHaddockIndex = do
-
- defaultDirs <- InstallDirs.defaultInstallDirs
- (compilerFlavor comp)
- (fromFlag (configUserInstall configFlags))
- True
- let indexFileTemplate = fromFlag (installHaddockIndex installFlags)
- indexFile = substHaddockIndexFileName defaultDirs indexFileTemplate
-
- notice verbosity $
- "Updating documentation index " ++ indexFile
-
- --TODO: might be nice if the install plan gave us the new InstalledPackageInfo
- installed <- getInstalledPackages verbosity comp packageDBs conf
- case installed of
- Nothing -> return () -- warning ?
- Just index -> Haddock.regenerateHaddockIndex verbosity index conf indexFile
-
- | otherwise = return ()
- where
- haddockIndexFileIsRequested =
- fromFlag (installDocumentation installFlags)
- && isJust (flagToMaybe (installHaddockIndex installFlags))
-
- -- We want to regenerate the index if some new documentation was actually
- -- installed. Since the index is per-user, we don't do it for global
- -- installs or special cases where we're installing into a specific db.
- shouldRegenerateHaddockIndex = normalUserInstall
- && someDocsWereInstalled installPlan
- where
- someDocsWereInstalled = any installedDocs . InstallPlan.toList
- normalUserInstall = (UserPackageDB `elem` packageDBs)
- && all (not . isSpecificPackageDB) packageDBs
-
- installedDocs (InstallPlan.Installed _ (BuildOk DocsOk _)) = True
- installedDocs _ = False
- isSpecificPackageDB (SpecificPackageDB _) = True
- isSpecificPackageDB _ = False
-
- substHaddockIndexFileName defaultDirs = fromPathTemplate
- . substPathTemplate env
- where
- env = env0 ++ installDirsTemplateEnv absoluteDirs
- env0 = InstallDirs.compilerTemplateEnv (compilerId comp)
- ++ InstallDirs.platformTemplateEnv (buildPlatform)
- absoluteDirs = InstallDirs.substituteInstallDirTemplates
- env0 templateDirs
- templateDirs = InstallDirs.combineInstallDirs fromFlagOrDefault
- defaultDirs (configInstallDirs configFlags)
+ dryRun = fromFlag (installDryRun installFlags)
+ logMsg message rest = info verbosity message >> rest
+-- ------------------------------------------------------------
+-- * Installation planning
+-- ------------------------------------------------------------
-- | Make an 'InstallPlan' for the unpacked package in the current directory,
-- and all its dependencies.
--
-planLocalPackage :: Verbosity -> Compiler
- -> ConfigFlags -> ConfigExFlags -> Planner
+planLocalPackage :: Verbosity
+ -> Compiler
+ -> ConfigFlags
+ -> ConfigExFlags
+ -> Planner
planLocalPackage verbosity comp configFlags configExFlags installed
(AvailablePackageDb available availablePrefs) = do
pkg <- readPackageDescription verbosity =<< defaultPackageDesc verbosity
@@ -390,11 +270,11 @@ planLocalPackage verbosity comp configFlags configExFlags installed
-- dependency on exactly that package. So the resolver ends up having
-- to pick the local package.
available' = PackageIndex.insert localPkg available
- installed' = PackageIndex.deletePackageId (packageId localPkg) `fmap` installed
+ installed' = PackageIndex.deletePackageId (packageId localPkg) installed
localPkg = AvailablePackage {
packageInfoId = packageId pkg,
Available.packageDescription = pkg,
- packageSource = LocalUnpackedPackage
+ packageSource = LocalUnpackedPackage Nothing
}
targets = [packageName pkg]
constraints = [PackageVersionConstraint (packageName pkg)
@@ -409,18 +289,27 @@ planLocalPackage verbosity comp configFlags configExFlags installed
return $ resolveDependenciesWithProgress buildPlatform (compilerId comp)
installed' available' preferences constraints targets
+
-- | Make an 'InstallPlan' for the given dependencies.
--
-planRepoPackages :: PackagesPreferenceDefault -> Compiler
- -> ConfigFlags -> ConfigExFlags -> InstallFlags
- -> [UnresolvedDependency] -> Planner
-planRepoPackages defaultPref comp configFlags configExFlags installFlags
+planRepoPackages :: PackagesPreferenceDefault
+ -> Compiler
+ -> GlobalFlags
+ -> ConfigFlags
+ -> ConfigExFlags
+ -> InstallFlags
+ -> [UnresolvedDependency]
+ -> Planner
+planRepoPackages defaultPref comp
+ globalFlags configFlags configExFlags installFlags
deps installed (AvailablePackageDb available availablePrefs) = do
- deps' <- IndexUtils.disambiguateDependencies available deps
+ deps' <- addWorldPackages deps
+ >>= IndexUtils.disambiguateDependencies available
+
let installed'
| fromFlag (installReinstall installFlags)
- = fmap (hideGivenDeps deps') installed
+ = hideGivenDeps deps' installed
| otherwise = installed
targets = dependencyTargets deps'
constraints = dependencyConstraints deps'
@@ -434,35 +323,19 @@ planRepoPackages defaultPref comp configFlags configExFlags installFlags
foldr PackageIndex.deletePackageName index
[ name | UnresolvedDependency (Dependency name _) _ <- pkgs ]
-planUpgradePackages :: Compiler -> ConfigFlags -> ConfigExFlags -> Planner
-planUpgradePackages _comp _configFlags _configExFlags (Just installed)
- (AvailablePackageDb available _availablePrefs) = die $
- "the 'upgrade' command (when used without any package arguments) has "
- ++ "been disabled in this release. It has been disabled because it has "
- ++ "frequently led people to accidentally break their set of installed "
- ++ "packages. It will be re-enabled when it is safer to use.\n"
- ++ "Below is the list of packages that it would have tried to upgrade. You "
- ++ "can use the 'install' command to install the ones you want. Note that "
- ++ "it is generally not recommended to upgrade core packages.\n"
- ++ unlines [ display pkgid | Dependency pkgid _ <- deps ]
-
---TODO: improve upgrade so we can re-enable it
--- return $
--- resolveDependenciesWithProgress buildPlatform (compilerId comp)
--- (Just installed) available preferences constraints targets
- where
- deps = upgradableDependencies installed available
--- preferences = mergePackagePrefs PreferAllLatest availablePrefs configExFlags
--- constraints = [ PackageVersionConstraint name ver
--- | Dependency name ver <- deps ]
--- ++ [ PackageVersionConstraint name ver
--- | Dependency name ver <- configConstraints configFlags ]
--- targets = [ name | Dependency name _ <- deps ]
-
-planUpgradePackages comp _ _ _ _ =
- die $ display (compilerId comp)
- ++ " does not track installed packages so cabal cannot figure out what"
- ++ " packages need to be upgraded."
+ addWorldPackages :: [UnresolvedDependency] -> IO [UnresolvedDependency]
+ addWorldPackages targets = case partition World.isWorldTarget targets of
+ ([], _) -> return targets
+ (world, otherTargets) -> do
+ unless (all World.isGoodWorldTarget world) $
+ die $ "The virtual package 'world' does not take any version "
+ ++ "or configuration flags."
+ worldTargets <- World.getContents worldFile
+ --TODO: should we warn if there are no world targets?
+ return (otherTargets ++ worldTargets)
+ where
+ worldFile = fromFlag $ globalWorldFile globalFlags
+
mergePackagePrefs :: PackagesPreferenceDefault
-> Map.Map PackageName VersionRange
@@ -477,9 +350,36 @@ mergePackagePrefs defaultPref availablePrefs configExFlags =
++ [ PackageVersionPreference name ver
| Dependency name ver <- configPreferences configExFlags ]
-printDryRun :: Verbosity -> Maybe (PackageIndex InstalledPackage)
- -> InstallPlan -> IO ()
-printDryRun verbosity minstalled plan = case unfoldr next plan of
+
+-- ------------------------------------------------------------
+-- * Informational messages
+-- ------------------------------------------------------------
+
+printPlanMessages :: Verbosity
+ -> PackageIndex InstalledPackage
+ -> InstallPlan
+ -> Bool
+ -> IO ()
+printPlanMessages verbosity installed installPlan dryRun = do
+
+ when nothingToInstall $
+ notice verbosity $
+ "No packages to be installed. All the requested packages are "
+ ++ "already installed.\n If you want to reinstall anyway then use "
+ ++ "the --reinstall flag."
+
+ when (dryRun || verbosity >= verbose) $
+ printDryRun verbosity installed installPlan
+
+ where
+ nothingToInstall = null (InstallPlan.ready installPlan)
+
+
+printDryRun :: Verbosity
+ -> PackageIndex InstalledPackage
+ -> InstallPlan
+ -> IO ()
+printDryRun verbosity installed plan = case unfoldr next plan of
[] -> return ()
pkgs
| verbosity >= Verbosity.verbose -> notice verbosity $ unlines $
@@ -498,9 +398,6 @@ printDryRun verbosity minstalled plan = case unfoldr next plan of
-- pretending that each package is installed
showPkgAndReason pkg' = display (packageId pkg') ++ " " ++
- case minstalled of
- Nothing -> ""
- Just installed ->
case PackageIndex.lookupPackageName installed (packageName pkg') of
[] -> "(new package)"
ps -> case find ((==packageId pkg') . packageId) ps of
@@ -519,6 +416,148 @@ printDryRun verbosity minstalled plan = case unfoldr next plan of
changed (InBoth pkgid pkgid') = pkgid /= pkgid'
changed _ = True
+-- ------------------------------------------------------------
+-- * Post installation stuff
+-- ------------------------------------------------------------
+
+-- | Various stuff we do after successful or unsuccessfully installing a bunch
+-- of packages. This includes:
+--
+-- * build reporting, local and remote
+-- * symlinking binaries
+-- * updating indexes
+-- * updating world file
+-- * error reporting
+--
+postInstallActions :: Verbosity
+ -> InstallContext
+ -> [InstallTarget]
+ -> InstallPlan
+ -> IO ()
+postInstallActions verbosity
+ (packageDBs, _, comp, conf, globalFlags, configFlags, _, installFlags)
+ targets installPlan = do
+
+ unless oneShot $
+ World.insert verbosity worldFile targets'
+
+ let buildReports = BuildReports.fromInstallPlan installPlan
+ BuildReports.storeLocal (installSummaryFile installFlags) buildReports
+ when (reportingLevel >= AnonymousReports) $
+ BuildReports.storeAnonymous buildReports
+ when (reportingLevel == DetailedReports) $
+ storeDetailedBuildReports verbosity logsDir buildReports
+
+ regenerateHaddockIndex verbosity packageDBs comp conf
+ configFlags installFlags installPlan
+
+ symlinkBinaries verbosity configFlags installFlags installPlan
+
+ printBuildFailures installPlan
+
+ where
+ reportingLevel = fromFlag (installBuildReports installFlags)
+ logsDir = fromFlag (globalLogsDir globalFlags)
+ oneShot = fromFlag (installOneShot installFlags)
+ worldFile = fromFlag $ globalWorldFile globalFlags
+ targets' = filter (not . World.isWorldTarget) targets
+
+storeDetailedBuildReports :: Verbosity -> FilePath
+ -> [(BuildReports.BuildReport, Repo)] -> IO ()
+storeDetailedBuildReports verbosity logsDir reports = sequence_
+ [ do dotCabal <- defaultCabalDir
+ let logFileName = display (BuildReports.package report) <.> "log"
+ logFile = logsDir </> logFileName
+ reportsDir = dotCabal </> "reports" </> remoteRepoName remoteRepo
+ reportFile = reportsDir </> logFileName
+
+ handleMissingLogFile $ do
+ buildLog <- readFile logFile
+ createDirectoryIfMissing True reportsDir -- FIXME
+ writeFile reportFile (show (BuildReports.show report, buildLog))
+
+ | (report, Repo { repoKind = Left remoteRepo }) <- reports
+ , isLikelyToHaveLogFile (BuildReports.installOutcome report) ]
+
+ where
+ isLikelyToHaveLogFile BuildReports.ConfigureFailed {} = True
+ isLikelyToHaveLogFile BuildReports.BuildFailed {} = True
+ isLikelyToHaveLogFile BuildReports.InstallFailed {} = True
+ isLikelyToHaveLogFile BuildReports.InstallOk {} = True
+ isLikelyToHaveLogFile _ = False
+
+ handleMissingLogFile = Exception.handleJust missingFile $ \ioe ->
+ warn verbosity $ "Missing log file for build report: "
+ ++ fromMaybe "" (ioeGetFileName ioe)
+
+#if MIN_VERSION_base(4,0,0)
+ missingFile ioe
+#else
+ missingFile (IOException ioe)
+#endif
+ | isDoesNotExistError ioe = Just ioe
+ missingFile _ = Nothing
+
+
+regenerateHaddockIndex :: Verbosity
+ -> [PackageDB]
+ -> Compiler
+ -> ProgramConfiguration
+ -> ConfigFlags
+ -> InstallFlags
+ -> InstallPlan
+ -> IO ()
+regenerateHaddockIndex verbosity packageDBs comp conf
+ configFlags installFlags installPlan
+ | haddockIndexFileIsRequested && shouldRegenerateHaddockIndex = do
+
+ defaultDirs <- InstallDirs.defaultInstallDirs
+ (compilerFlavor comp)
+ (fromFlag (configUserInstall configFlags))
+ True
+ let indexFileTemplate = fromFlag (installHaddockIndex installFlags)
+ indexFile = substHaddockIndexFileName defaultDirs indexFileTemplate
+
+ notice verbosity $
+ "Updating documentation index " ++ indexFile
+
+ --TODO: might be nice if the install plan gave us the new InstalledPackageInfo
+ installed <- getInstalledPackages verbosity comp packageDBs conf
+ Haddock.regenerateHaddockIndex verbosity installed conf indexFile
+
+ | otherwise = return ()
+ where
+ haddockIndexFileIsRequested =
+ fromFlag (installDocumentation installFlags)
+ && isJust (flagToMaybe (installHaddockIndex installFlags))
+
+ -- We want to regenerate the index if some new documentation was actually
+ -- installed. Since the index is per-user, we don't do it for global
+ -- installs or special cases where we're installing into a specific db.
+ shouldRegenerateHaddockIndex = normalUserInstall
+ && someDocsWereInstalled installPlan
+ where
+ someDocsWereInstalled = any installedDocs . InstallPlan.toList
+ normalUserInstall = (UserPackageDB `elem` packageDBs)
+ && all (not . isSpecificPackageDB) packageDBs
+
+ installedDocs (InstallPlan.Installed _ (BuildOk DocsOk _)) = True
+ installedDocs _ = False
+ isSpecificPackageDB (SpecificPackageDB _) = True
+ isSpecificPackageDB _ = False
+
+ substHaddockIndexFileName defaultDirs = fromPathTemplate
+ . substPathTemplate env
+ where
+ env = env0 ++ installDirsTemplateEnv absoluteDirs
+ env0 = InstallDirs.compilerTemplateEnv (compilerId comp)
+ ++ InstallDirs.platformTemplateEnv (buildPlatform)
+ absoluteDirs = InstallDirs.substituteInstallDirTemplates
+ env0 templateDirs
+ templateDirs = InstallDirs.combineInstallDirs fromFlagOrDefault
+ defaultDirs (configInstallDirs configFlags)
+
+
symlinkBinaries :: Verbosity
-> ConfigFlags
-> InstallFlags
@@ -545,6 +584,7 @@ symlinkBinaries verbosity configFlags installFlags plan = do
where
bindir = fromFlag (installSymlinkBinDir installFlags)
+
printBuildFailures :: InstallPlan -> IO ()
printBuildFailures plan =
case [ (pkg, reason)
@@ -569,6 +609,83 @@ printBuildFailures plan =
InstallFailed e -> " failed during the final install step."
++ " The exception was:\n " ++ show e
+
+-- ------------------------------------------------------------
+-- * Actually do the installations
+-- ------------------------------------------------------------
+
+data InstallMisc = InstallMisc {
+ rootCmd :: Maybe FilePath,
+ libVersion :: Maybe Version
+ }
+
+performInstallations :: Verbosity
+ -> InstallContext
+ -> PackageIndex InstalledPackage
+ -> InstallPlan
+ -> IO InstallPlan
+performInstallations verbosity
+ (packageDBs, _, comp, conf,
+ globalFlags, configFlags, configExFlags, installFlags)
+ installed installPlan = do
+
+ executeInstallPlan installPlan $ \cpkg ->
+ installConfiguredPackage platform compid configFlags
+ cpkg $ \configFlags' src pkg ->
+ installAvailablePackage verbosity (packageId pkg) src $ \mpath ->
+ installUnpackedPackage verbosity (setupScriptOptions installed)
+ miscOptions configFlags' installFlags
+ compid pkg mpath useLogFile
+
+ where
+ platform = InstallPlan.planPlatform installPlan
+ compid = InstallPlan.planCompiler installPlan
+
+ setupScriptOptions index = SetupScriptOptions {
+ useCabalVersion = maybe anyVersion thisVersion (libVersion miscOptions),
+ useCompiler = Just comp,
+ -- Hack: we typically want to allow the UserPackageDB for finding the
+ -- Cabal lib when compiling any Setup.hs even if we're doing a global
+ -- install. However we also allow looking in a specific package db.
+ usePackageDB = if UserPackageDB `elem` packageDBs
+ then packageDBs
+ else let (db@GlobalPackageDB:dbs) = packageDBs
+ in db : UserPackageDB : dbs,
+ --TODO: use Ord instance:
+ -- insert UserPackageDB packageDBs
+ usePackageIndex = if UserPackageDB `elem` packageDBs
+ then Just index
+ else Nothing,
+ useProgramConfig = conf,
+ useDistPref = fromFlagOrDefault
+ (useDistPref defaultSetupScriptOptions)
+ (configDistPref configFlags),
+ useLoggingHandle = Nothing,
+ useWorkingDir = Nothing
+ }
+ reportingLevel = fromFlag (installBuildReports installFlags)
+ logsDir = fromFlag (globalLogsDir globalFlags)
+ useLogFile :: Maybe (PackageIdentifier -> FilePath)
+ useLogFile = fmap substLogFileName logFileTemplate
+ where
+ logFileTemplate :: Maybe PathTemplate
+ logFileTemplate --TODO: separate policy from mechanism
+ | reportingLevel == DetailedReports
+ = Just $ toPathTemplate $ logsDir </> "$pkgid" <.> "log"
+ | otherwise
+ = flagToMaybe (installLogFile installFlags)
+ substLogFileName template pkg = fromPathTemplate
+ . substPathTemplate env
+ $ template
+ where env = initialPathTemplateEnv (packageId pkg) (compilerId comp)
+ miscOptions = InstallMisc {
+ rootCmd = if fromFlag (configUserInstall configFlags)
+ then Nothing -- ignore --root-cmd if --user.
+ else flagToMaybe (installRootCmd installFlags),
+ libVersion = flagToMaybe (configCabalVersion configExFlags)
+ }
+
+
executeInstallPlan :: Monad m
=> InstallPlan
-> (ConfiguredPackage -> m BuildResult)
@@ -591,6 +708,7 @@ executeInstallPlan plan installPkg = case InstallPlan.ready plan of
-- now cannot build, we mark as failing due to 'DependentFailed'
-- which kind of means it was not their fault.
+
-- | Call an installer for an 'AvailablePackage' but override the configure
-- flags with the ones given by the 'ConfiguredPackage'. In particular the
-- 'ConfiguredPackage' specifies an exact 'FlagAssignment' and exactly
@@ -615,30 +733,60 @@ installConfiguredPackage platform comp configFlags
Left _ -> error "finalizePackageDescription ConfiguredPackage failed"
Right (desc, _) -> desc
+
installAvailablePackage
:: Verbosity -> PackageIdentifier -> AvailablePackageSource
-> (Maybe FilePath -> IO BuildResult)
-> IO BuildResult
-installAvailablePackage _ _ LocalUnpackedPackage installPkg =
- installPkg Nothing
+installAvailablePackage _ _ (LocalUnpackedPackage dir) installPkg =
+ installPkg dir
+
+installAvailablePackage verbosity pkgid
+ (LocalTarballPackage tarballPath) installPkg = do
+ tmp <- getTemporaryDirectory
+ withTempDirectory verbosity tmp (display pkgid) $ \tmpDirPath ->
+ installLocalTarballPackage verbosity pkgid
+ tarballPath tmpDirPath installPkg
+
+installAvailablePackage verbosity pkgid
+ (RemoteTarballPackage tarballURL) installPkg = do
+ tmp <- getTemporaryDirectory
+ withTempDirectory verbosity tmp (display pkgid) $ \tmpDirPath ->
+ onFailure DownloadFailed $ do
+ let tarballPath = tmpDirPath </> display pkgid <.> "tar.gz"
+ --TODO: perhaps we've already had to download this to a local cache
+ -- so we even know what package version it is. So might be able
+ -- to get it from the local cache rather than from remote.
+ downloadURI verbosity tarballURL tarballPath
+ installLocalTarballPackage verbosity pkgid
+ tarballPath tmpDirPath installPkg
installAvailablePackage verbosity pkgid (RepoTarballPackage repo) installPkg =
onFailure DownloadFailed $ do
- pkgPath <- fetchPackage verbosity repo pkgid
- onFailure UnpackFailed $ do
- tmp <- getTemporaryDirectory
- withTempDirectory verbosity tmp (display pkgid) $ \tmpDirPath -> do
- info verbosity $ "Extracting " ++ pkgPath
- ++ " to " ++ tmpDirPath ++ "..."
- let relUnpackedPath = display pkgid
- absUnpackedPath = tmpDirPath </> relUnpackedPath
- descFilePath = absUnpackedPath
- </> display (packageName pkgid) <.> "cabal"
- extractTarGzFile tmpDirPath relUnpackedPath pkgPath
- exists <- doesFileExist descFilePath
- when (not exists) $
- die $ "Package .cabal file not found: " ++ show descFilePath
- installPkg (Just absUnpackedPath)
+ tarballPath <- fetchPackage verbosity repo pkgid
+ tmp <- getTemporaryDirectory
+ withTempDirectory verbosity tmp (display pkgid) $ \tmpDirPath ->
+ installLocalTarballPackage verbosity pkgid
+ tarballPath tmpDirPath installPkg
+
+installLocalTarballPackage
+ :: Verbosity -> PackageIdentifier -> FilePath -> FilePath
+ -> (Maybe FilePath -> IO BuildResult)
+ -> IO BuildResult
+installLocalTarballPackage verbosity pkgid tarballPath tmpDirPath installPkg =
+ onFailure UnpackFailed $ do
+ info verbosity $ "Extracting " ++ tarballPath
+ ++ " to " ++ tmpDirPath ++ "..."
+ let relUnpackedPath = display pkgid
+ absUnpackedPath = tmpDirPath </> relUnpackedPath
+ descFilePath = absUnpackedPath
+ </> display (packageName pkgid) <.> "cabal"
+ extractTarGzFile tmpDirPath relUnpackedPath tarballPath
+ exists <- doesFileExist descFilePath
+ when (not exists) $
+ die $ "Package .cabal file not found: " ++ show descFilePath
+ installPkg (Just absUnpackedPath)
+
installUnpackedPackage :: Verbosity
-> SetupScriptOptions
@@ -684,7 +832,7 @@ installUnpackedPackage verbosity scriptOptions miscOptions
where
configureFlags = filterConfigureFlags configFlags {
configVerbosity = toFlag verbosity'
- }
+ }
buildCommand' = buildCommand defaultProgramConfiguration
buildFlags _ = emptyBuildFlags {
buildDistPref = configDistPref configFlags,
@@ -729,6 +877,7 @@ installUnpackedPackage verbosity scriptOptions miscOptions
,"--verbose=" ++ showForCabal verbosity]
else die $ "Unable to find cabal executable at: " ++ self
+
-- helper
onFailure :: (SomeException -> BuildFailure) -> IO BuildResult -> IO BuildResult
onFailure result action =
@@ -746,6 +895,11 @@ onFailure result action =
`catchExit` (return . Left . result . ExitException)
#endif
+
+-- ------------------------------------------------------------
+-- * Wierd windows hacks
+-- ------------------------------------------------------------
+
withWin32SelfUpgrade :: Verbosity
-> ConfigFlags
-> CompilerId
diff --git a/cabal-install-0.8.2/Distribution/Client/InstallPlan.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/InstallPlan.hs
index 71fa6a9..71fa6a9 100644
--- a/cabal-install-0.8.2/Distribution/Client/InstallPlan.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/InstallPlan.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/InstallSymlink.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/InstallSymlink.hs
index 8b6a375..8b6a375 100644
--- a/cabal-install-0.8.2/Distribution/Client/InstallSymlink.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/InstallSymlink.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/List.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/List.hs
index e97f256..0633d15 100644
--- a/cabal-install-0.8.2/Distribution/Client/List.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/List.hs
@@ -72,7 +72,7 @@ list :: Verbosity
-> [String]
-> IO ()
list verbosity packageDBs repos comp conf listFlags pats = do
- Just installed <- getInstalledPackages verbosity comp packageDBs conf
+ installed <- getInstalledPackages verbosity comp packageDBs conf
AvailablePackageDb available _ <- getAvailablePackages verbosity repos
let pkgs | null pats = (PackageIndex.allPackages installed
,PackageIndex.allPackages available)
@@ -113,7 +113,7 @@ info :: Verbosity
info verbosity packageDBs repos comp conf _listFlags deps = do
AvailablePackageDb available _ <- getAvailablePackages verbosity repos
deps' <- IndexUtils.disambiguateDependencies available deps
- Just installed <- getInstalledPackages verbosity comp packageDBs conf
+ installed <- getInstalledPackages verbosity comp packageDBs conf
let deps'' = [ name | UnresolvedDependency (Dependency name _) _ <- deps' ]
let pkgs = (concatMap (PackageIndex.lookupPackageName installed) deps''
,concatMap (PackageIndex.lookupPackageName available) deps'')
diff --git a/cabal-install-0.8.2/Distribution/Client/PackageIndex.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/PackageIndex.hs
index 2f336f5..2f336f5 100644
--- a/cabal-install-0.8.2/Distribution/Client/PackageIndex.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/PackageIndex.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/PackageUtils.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/PackageUtils.hs
index bd2b1df..bd2b1df 100644
--- a/cabal-install-0.8.2/Distribution/Client/PackageUtils.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/PackageUtils.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/Setup.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Setup.hs
index 4441a8f..34316c6 100644
--- a/cabal-install-0.8.2/Distribution/Client/Setup.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Setup.hs
@@ -20,7 +20,7 @@ module Distribution.Client.Setup
, updateCommand
, upgradeCommand
, infoCommand, InfoFlags(..)
- , fetchCommand
+ , fetchCommand, FetchFlags(..)
, checkCommand
, uploadCommand, UploadFlags(..)
, reportCommand
@@ -50,7 +50,7 @@ import Distribution.Simple.Setup
( ConfigFlags(..) )
import Distribution.Simple.Setup
( Flag(..), toFlag, fromFlag, flagToList, flagToMaybe
- , optionVerbosity, trueArg )
+ , optionVerbosity, trueArg, falseArg )
import Distribution.Simple.InstallDirs
( PathTemplate, toPathTemplate, fromPathTemplate )
import Distribution.Version
@@ -92,7 +92,9 @@ data GlobalFlags = GlobalFlags {
globalConfigFile :: Flag FilePath,
globalRemoteRepos :: [RemoteRepo], -- ^Available Hackage servers.
globalCacheDir :: Flag FilePath,
- globalLocalRepos :: [FilePath]
+ globalLocalRepos :: [FilePath],
+ globalLogsDir :: Flag FilePath,
+ globalWorldFile :: Flag FilePath
}
defaultGlobalFlags :: GlobalFlags
@@ -102,7 +104,9 @@ defaultGlobalFlags = GlobalFlags {
globalConfigFile = mempty,
globalRemoteRepos = [],
globalCacheDir = mempty,
- globalLocalRepos = mempty
+ globalLocalRepos = mempty,
+ globalLogsDir = mempty,
+ globalWorldFile = mempty
}
globalCommand :: CommandUI GlobalFlags
@@ -152,6 +156,16 @@ globalCommand = CommandUI {
"The location of a local repository"
globalLocalRepos (\v flags -> flags { globalLocalRepos = v })
(reqArg' "DIR" (\x -> [x]) id)
+
+ ,option [] ["logs-dir"]
+ "The location to put log files"
+ globalLogsDir (\v flags -> flags { globalLogsDir = v })
+ (reqArgFlag "DIR")
+
+ ,option [] ["world-file"]
+ "The location of the world file"
+ globalWorldFile (\v flags -> flags { globalWorldFile = v })
+ (reqArgFlag "FILE")
]
}
@@ -162,7 +176,9 @@ instance Monoid GlobalFlags where
globalConfigFile = mempty,
globalRemoteRepos = mempty,
globalCacheDir = mempty,
- globalLocalRepos = mempty
+ globalLocalRepos = mempty,
+ globalLogsDir = mempty,
+ globalWorldFile = mempty
}
mappend a b = GlobalFlags {
globalVersion = combine globalVersion,
@@ -170,7 +186,9 @@ instance Monoid GlobalFlags where
globalConfigFile = combine globalConfigFile,
globalRemoteRepos = combine globalRemoteRepos,
globalCacheDir = combine globalCacheDir,
- globalLocalRepos = combine globalLocalRepos
+ globalLocalRepos = combine globalLocalRepos,
+ globalLogsDir = combine globalLogsDir,
+ globalWorldFile = combine globalWorldFile
}
where combine field = field a `mappend` field b
@@ -260,19 +278,60 @@ instance Monoid ConfigExFlags where
where combine field = field a `mappend` field b
-- ------------------------------------------------------------
--- * Other commands
+-- * Fetch command
-- ------------------------------------------------------------
-fetchCommand :: CommandUI (Flag Verbosity)
+data FetchFlags = FetchFlags {
+-- fetchOutput :: Flag FilePath,
+ fetchDeps :: Flag Bool,
+ fetchDryRun :: Flag Bool,
+ fetchVerbosity :: Flag Verbosity
+ }
+
+defaultFetchFlags :: FetchFlags
+defaultFetchFlags = FetchFlags {
+-- fetchOutput = mempty,
+ fetchDeps = toFlag True,
+ fetchDryRun = toFlag False,
+ fetchVerbosity = toFlag normal
+ }
+
+fetchCommand :: CommandUI FetchFlags
fetchCommand = CommandUI {
commandName = "fetch",
commandSynopsis = "Downloads packages for later installation.",
commandDescription = Nothing,
commandUsage = usagePackages "fetch",
- commandDefaultFlags = toFlag normal,
- commandOptions = \_ -> [optionVerbosity id const]
+ commandDefaultFlags = defaultFetchFlags,
+ commandOptions = \_ -> [
+ optionVerbosity fetchVerbosity (\v flags -> flags { fetchVerbosity = v })
+
+-- , option "o" ["output"]
+-- "Put the package(s) somewhere specific rather than the usual cache."
+-- fetchOutput (\v flags -> flags { fetchOutput = v })
+-- (reqArgFlag "PATH")
+
+ , option [] ["dependencies", "deps"]
+ "Resolve and fetch dependencies (default)"
+ fetchDeps (\v flags -> flags { fetchDeps = v })
+ trueArg
+
+ , option [] ["no-dependencies", "no-deps"]
+ "Ignore dependencies"
+ fetchDeps (\v flags -> flags { fetchDeps = v })
+ falseArg
+
+ , option [] ["dry-run"]
+ "Do not install anything, only print what would be installed."
+ fetchDryRun (\v flags -> flags { fetchDryRun = v })
+ trueArg
+ ]
}
+-- ------------------------------------------------------------
+-- * Other commands
+-- ------------------------------------------------------------
+
updateCommand :: CommandUI (Flag Verbosity)
updateCommand = CommandUI {
commandName = "update",
@@ -286,7 +345,7 @@ updateCommand = CommandUI {
upgradeCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags)
upgradeCommand = configureCommand {
commandName = "upgrade",
- commandSynopsis = "Upgrades installed packages to the latest available version",
+ commandSynopsis = "(command disabled, use install instead)",
commandDescription = Nothing,
commandUsage = usagePackages "upgrade",
commandDefaultFlags = (mempty, mempty, mempty),
@@ -456,12 +515,14 @@ data InstallFlags = InstallFlags {
installHaddockIndex :: Flag PathTemplate,
installDryRun :: Flag Bool,
installReinstall :: Flag Bool,
+ installUpgradeDeps :: Flag Bool,
installOnly :: Flag Bool,
installRootCmd :: Flag String,
installSummaryFile :: [PathTemplate],
installLogFile :: Flag PathTemplate,
installBuildReports :: Flag ReportLevel,
- installSymlinkBinDir:: Flag FilePath
+ installSymlinkBinDir:: Flag FilePath,
+ installOneShot :: Flag Bool
}
defaultInstallFlags :: InstallFlags
@@ -470,12 +531,14 @@ defaultInstallFlags = InstallFlags {
installHaddockIndex = Flag docIndexFile,
installDryRun = Flag False,
installReinstall = Flag False,
+ installUpgradeDeps = Flag False,
installOnly = Flag False,
installRootCmd = mempty,
installSummaryFile = mempty,
installLogFile = mempty,
installBuildReports = Flag NoReports,
- installSymlinkBinDir= mempty
+ installSymlinkBinDir= mempty,
+ installOneShot = Flag False
}
where
docIndexFile = toPathTemplate ("$datadir" </> "doc" </> "index.html")
@@ -533,6 +596,11 @@ installOptions showOrParseArgs =
installReinstall (\v flags -> flags { installReinstall = v })
trueArg
+ , option [] ["upgrade-dependencies"]
+ "Pick the latest version for all dependencies, rather than trying to pick an installed version."
+ installUpgradeDeps (\v flags -> flags { installUpgradeDeps = v })
+ trueArg
+
, option [] ["root-cmd"]
"Command used to gain root privileges, when installing with --global."
installRootCmd (\v flags -> flags { installRootCmd = v })
@@ -562,6 +630,10 @@ installOptions showOrParseArgs =
(toFlag `fmap` parse))
(flagToList . fmap display))
+ , option [] ["one-shot"]
+ "Do not record the packages in the world file."
+ installOneShot (\v flags -> flags { installOneShot = v })
+ trueArg
] ++ case showOrParseArgs of -- TODO: remove when "cabal install" avoids
ParseArgs ->
option [] ["only"]
@@ -577,24 +649,28 @@ instance Monoid InstallFlags where
installHaddockIndex = mempty,
installDryRun = mempty,
installReinstall = mempty,
+ installUpgradeDeps = mempty,
installOnly = mempty,
installRootCmd = mempty,
installSummaryFile = mempty,
installLogFile = mempty,
installBuildReports = mempty,
- installSymlinkBinDir= mempty
+ installSymlinkBinDir= mempty,
+ installOneShot = mempty
}
mappend a b = InstallFlags {
installDocumentation= combine installDocumentation,
installHaddockIndex = combine installHaddockIndex,
installDryRun = combine installDryRun,
installReinstall = combine installReinstall,
+ installUpgradeDeps = combine installUpgradeDeps,
installOnly = combine installOnly,
installRootCmd = combine installRootCmd,
installSummaryFile = combine installSummaryFile,
installLogFile = combine installLogFile,
installBuildReports = combine installBuildReports,
- installSymlinkBinDir= combine installSymlinkBinDir
+ installSymlinkBinDir= combine installSymlinkBinDir,
+ installOneShot = combine installOneShot
}
where combine field = field a `mappend` field b
diff --git a/cabal-install-0.8.2/Distribution/Client/SetupWrapper.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/SetupWrapper.hs
index b48a929..9315339 100644
--- a/cabal-install-0.8.2/Distribution/Client/SetupWrapper.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/SetupWrapper.hs
@@ -26,14 +26,15 @@ import Distribution.Client.Types
import qualified Distribution.Make as Make
import qualified Distribution.Simple as Simple
import Distribution.Version
- ( Version(..), VersionRange, anyVersion, intersectVersionRanges
+ ( Version(..), VersionRange, anyVersion
+ , intersectVersionRanges, orLaterVersion
, withinRange )
import Distribution.Package
( PackageIdentifier(..), PackageName(..), Package(..), packageName
, packageVersion, Dependency(..) )
import Distribution.PackageDescription
( GenericPackageDescription(packageDescription)
- , PackageDescription(..), BuildType(..) )
+ , PackageDescription(..), specVersion, BuildType(..) )
import Distribution.PackageDescription.Parse
( readPackageDescription )
import Distribution.Simple.Configure
@@ -71,7 +72,6 @@ import System.Process ( runProcess, waitForProcess )
import Control.Monad ( when, unless )
import Data.List ( maximumBy )
import Data.Maybe ( fromMaybe, isJust )
-import Data.Monoid ( Monoid(mempty) )
import Data.Char ( isSpace )
data SetupScriptOptions = SetupScriptOptions {
@@ -110,7 +110,7 @@ setupWrapper verbosity options mpkg cmd flags extraArgs = do
options' = options {
useCabalVersion = intersectVersionRanges
(useCabalVersion options)
- (descCabalVersion pkg)
+ (orLaterVersion (specVersion pkg))
}
buildType' = fromMaybe Custom (buildType pkg)
mkArgs cabalLibVersion = commandName cmd
@@ -207,8 +207,7 @@ externalSetupMethod verbosity options pkg bt mkargs = do
installedCabalVersion options' comp conf = do
index <- case usePackageIndex options' of
Just index -> return index
- Nothing -> fromMaybe mempty
- `fmap` getInstalledPackages verbosity
+ Nothing -> getInstalledPackages verbosity
comp (usePackageDB options') conf
let cabalDep = Dependency (PackageName "Cabal") (useCabalVersion options)
diff --git a/cabal-install-0.8.2/Distribution/Client/SrcDist.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/SrcDist.hs
index f17a5ce..f17a5ce 100644
--- a/cabal-install-0.8.2/Distribution/Client/SrcDist.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/SrcDist.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/Tar.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Tar.hs
index ff7f254..f80509f 100644
--- a/cabal-install-0.8.2/Distribution/Client/Tar.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Tar.hs
@@ -68,6 +68,7 @@ import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
import Data.ByteString.Lazy (ByteString)
import qualified Codec.Compression.GZip as GZip
+import qualified Distribution.Client.GZipUtils as GZipUtils
import System.FilePath
( (</>) )
@@ -105,8 +106,8 @@ extractTarGzFile :: FilePath -- ^ Destination directory
-> FilePath -- ^ Expected subdir (to check for tarbombs)
-> FilePath -- ^ Tarball
-> IO ()
-extractTarGzFile dir expected tar =
- unpack dir . checkTarbomb expected . read . GZip.decompress =<< BS.readFile tar
+extractTarGzFile dir expected tar = do
+ unpack dir . checkTarbomb expected . read . GZipUtils.maybeDecompress =<< BS.readFile tar
--
-- * Entry type
diff --git a/cabal-install-0.8.2/Distribution/Client/Types.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Types.hs
index 3012056..a0da743 100644
--- a/cabal-install-0.8.2/Distribution/Client/Types.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Types.hs
@@ -18,12 +18,18 @@ import Distribution.Package
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import Distribution.PackageDescription
- ( GenericPackageDescription, FlagAssignment )
+ ( GenericPackageDescription, FlagAssignment, FlagName(FlagName) )
import Distribution.Client.PackageIndex
( PackageIndex )
import Distribution.Version
( VersionRange )
+import Distribution.Text
+ ( Text(disp,parse) )
+import qualified Distribution.Compat.ReadP as Parse
+import qualified Text.PrettyPrint as Disp
+
+import Data.Char as Char
import Data.Map (Map)
import Network.URI (URI)
import Distribution.Compat.Exception
@@ -96,8 +102,14 @@ instance Package AvailablePackage where packageId = packageInfoId
data AvailablePackageSource =
- -- | The unpacked package in the current dir
- LocalUnpackedPackage
+ -- | An unpacked package in the given dir, or current dir
+ LocalUnpackedPackage (Maybe FilePath)
+
+ -- | A package as a tarball that's available as a local tarball
+ | LocalTarballPackage FilePath
+
+ -- | A package as a tarball from a remote URI
+ | RemoteTarballPackage URI
-- | A package available as a tarball from a repository.
--
@@ -109,8 +121,6 @@ data AvailablePackageSource =
deriving Show
--TODO:
--- * generalise local package to any local unpacked package, not just in the
--- current dir, ie add a FilePath param
-- * add support for darcs and other SCM style remote repos with a local cache
data LocalRepo = LocalRepo
@@ -133,7 +143,60 @@ data UnresolvedDependency
{ dependency :: Dependency
, depFlags :: FlagAssignment
}
- deriving (Show)
+ deriving (Show,Eq)
+
+
+instance Text UnresolvedDependency where
+ disp udep = disp (dependency udep) Disp.<+> dispFlags (depFlags udep)
+ where
+ dispFlags [] = Disp.empty
+ dispFlags fs = Disp.text "--flags="
+ Disp.<>
+ (Disp.doubleQuotes $ flagAssToDoc fs)
+ flagAssToDoc = foldr (\(FlagName fname,val) flagAssDoc ->
+ (if not val then Disp.char '-'
+ else Disp.empty)
+ Disp.<> Disp.text fname
+ Disp.<+> flagAssDoc)
+ Disp.empty
+ parse = do
+ dep <- parse
+ Parse.skipSpaces
+ flagAss <- Parse.option [] parseFlagAssignment
+ return $ UnresolvedDependency dep flagAss
+ where
+ parseFlagAssignment :: Parse.ReadP r FlagAssignment
+ parseFlagAssignment = do
+ Parse.string "--flags"
+ Parse.skipSpaces
+ Parse.char '='
+ Parse.skipSpaces
+ inDoubleQuotes $ Parse.many1 flag
+ where
+ inDoubleQuotes :: Parse.ReadP r a -> Parse.ReadP r a
+ inDoubleQuotes = Parse.between (Parse.char '"') (Parse.char '"')
+
+ flag = do
+ Parse.skipSpaces
+ val <- negative Parse.+++ positive
+ name <- ident
+ Parse.skipSpaces
+ return (FlagName name,val)
+ negative = do
+ Parse.char '-'
+ return False
+ positive = return True
+
+ ident :: Parse.ReadP r String
+ ident = do
+ -- First character must be a letter/digit to avoid flags
+ -- like "+-debug":
+ c <- Parse.satisfy Char.isAlphaNum
+ cs <- Parse.munch (\ch -> Char.isAlphaNum ch || ch == '_'
+ || ch == '-')
+ return (c:cs)
+
+
type BuildResult = Either BuildFailure BuildSuccess
data BuildFailure = DependentFailed PackageId
diff --git a/cabal-install-0.8.2/Distribution/Client/Unpack.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Unpack.hs
index 63dd298..ce7780b 100644
--- a/cabal-install-0.8.2/Distribution/Client/Unpack.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Unpack.hs
@@ -18,16 +18,13 @@ module Distribution.Client.Unpack (
) where
import Distribution.Package
- ( PackageId, packageId, Dependency(..) )
-import Distribution.Client.PackageIndex as PackageIndex (lookupDependency)
+ ( PackageId, Dependency(..) )
import Distribution.Simple.Setup(fromFlag, fromFlagOrDefault)
import Distribution.Simple.Utils
( notice, die )
import Distribution.Verbosity
( Verbosity )
import Distribution.Text(display)
-import Distribution.Version
- ( anyVersion, intersectVersionRanges )
import Distribution.Client.Setup(UnpackFlags(unpackVerbosity,
unpackDestDir))
@@ -35,51 +32,72 @@ import Distribution.Client.Types(UnresolvedDependency(..),
Repo, AvailablePackageSource(..),
AvailablePackage(AvailablePackage),
AvailablePackageDb(AvailablePackageDb))
-import Distribution.Client.Fetch(fetchPackage)
+import Distribution.Client.Dependency as Dependency
+ ( resolveAvailablePackages
+ , dependencyConstraints, dependencyTargets
+ , PackagesPreference(..), PackagesPreferenceDefault(..)
+ , PackagePreference(..) )
+import Distribution.Client.Fetch
+ ( fetchPackage )
+import Distribution.Client.HttpUtils
+ ( downloadURI )
import qualified Distribution.Client.Tar as Tar (extractTarGzFile)
import Distribution.Client.IndexUtils as IndexUtils
(getAvailablePackages, disambiguateDependencies)
import System.Directory
- ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist )
+ ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
+ , getTemporaryDirectory )
+import System.IO
+ ( openTempFile, hClose )
import Control.Monad
( unless, when )
-import Data.Ord (comparing)
-import Data.List(maximumBy)
+import Data.Monoid
+ ( mempty )
import System.FilePath
( (</>), addTrailingPathSeparator )
import qualified Data.Map as Map
unpack :: UnpackFlags -> [Repo] -> [Dependency] -> IO ()
-unpack flags repos deps
- | null deps = notice verbosity
- "No packages requested. Nothing to do."
- | otherwise = do
+unpack flags _ [] =
+ notice verbosity "No packages requested. Nothing to do."
+ where
+ verbosity = fromFlag (unpackVerbosity flags)
+
+unpack flags repos deps = do
db@(AvailablePackageDb available _)
<- getAvailablePackages verbosity repos
- deps' <- fmap (map dependency)
- . IndexUtils.disambiguateDependencies available
- . map toUnresolved $ deps
+ deps' <- IndexUtils.disambiguateDependencies available
+ . map toUnresolved $ deps
- let pkgs = resolvePackages db deps'
+ pkgs <- resolvePackages db deps'
unless (null prefix) $
createDirectoryIfMissing True prefix
- flip mapM_ pkgs $ \pkg ->
- case pkg of
+ flip mapM_ pkgs $ \pkg -> case pkg of
+
+ AvailablePackage pkgid _ (LocalTarballPackage tarballPath) ->
+ unpackPackage verbosity prefix pkgid tarballPath
+
+ AvailablePackage pkgid _ (RemoteTarballPackage tarballURL) -> do
+ tmp <- getTemporaryDirectory
+ (tarballPath, hnd) <- openTempFile tmp (display pkgid)
+ hClose hnd
+ --TODO: perhaps we've already had to download this to a local cache
+ -- so we even know what package version it is. So might be able
+ -- to get it from the local cache rather than from remote.
+ downloadURI verbosity tarballURL tarballPath
+ unpackPackage verbosity prefix pkgid tarballPath
- Left (Dependency name ver) ->
- die $ "There is no available version of " ++ display name
- ++ " that satisfies " ++ display ver
+ AvailablePackage pkgid _ (RepoTarballPackage repo) -> do
+ tarballPath <- fetchPackage verbosity repo pkgid
+ unpackPackage verbosity prefix pkgid tarballPath
- Right (AvailablePackage pkgid _ (RepoTarballPackage repo)) -> do
- pkgPath <- fetchPackage verbosity repo pkgid
- unpackPackage verbosity prefix pkgid pkgPath
+ AvailablePackage _ _ (LocalUnpackedPackage _) ->
+ error "Distribution.Client.Unpack.unpack: the impossible happened."
- Right (AvailablePackage _ _ LocalUnpackedPackage) ->
- error "Distribution.Client.Unpack.unpack: the impossible happened."
- where
+ where
verbosity = fromFlag (unpackVerbosity flags)
prefix = fromFlagOrDefault "" (unpackDestDir flags)
toUnresolved d = UnresolvedDependency d []
@@ -99,18 +117,22 @@ unpackPackage verbosity prefix pkgid pkgPath = do
Tar.extractTarGzFile prefix pkgdirname pkgPath
resolvePackages :: AvailablePackageDb
- -> [Dependency]
- -> [Either Dependency AvailablePackage]
-resolvePackages (AvailablePackageDb available prefs) deps =
- map (\d -> best d (candidates d)) deps
- where
- candidates dep@(Dependency name ver) =
- let [x,y] = map (PackageIndex.lookupDependency available)
- [ Dependency name
- (maybe anyVersion id (Map.lookup name prefs)
- `intersectVersionRanges` ver)
- , dep ]
- in if null x then y else x
- best d [] = Left d
- best _ xs = Right $ maximumBy (comparing packageId) xs
+ -> [UnresolvedDependency]
+ -> IO [AvailablePackage]
+resolvePackages
+ (AvailablePackageDb available availablePrefs) deps =
+
+ either (die . unlines . map show) return $
+ resolveAvailablePackages
+ installed available
+ preferences constraints
+ targets
+ where
+ installed = mempty
+ targets = dependencyTargets deps
+ constraints = dependencyConstraints deps
+ preferences = PackagesPreference
+ PreferLatestForSelected
+ [ PackageVersionPreference name ver
+ | (name, ver) <- Map.toList availablePrefs ]
diff --git a/cabal-install-0.8.2/Distribution/Client/Update.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Update.hs
index 6288b34..87f10fa 100644
--- a/cabal-install-0.8.2/Distribution/Client/Update.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Update.hs
@@ -35,7 +35,7 @@ import Distribution.Verbosity
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
-import qualified Codec.Compression.GZip as GZip (decompress)
+import Distribution.Client.GZipUtils (maybeDecompress)
import qualified Data.Map as Map
import System.FilePath (dropExtension)
import Data.Maybe (fromMaybe)
@@ -58,7 +58,7 @@ updateRepo verbosity repo = case repoKind repo of
++ remoteRepoName remoteRepo
indexPath <- downloadIndex verbosity remoteRepo (repoLocalDir repo)
writeFileAtomic (dropExtension indexPath) . BS.Char8.unpack
- . GZip.decompress
+ . maybeDecompress
=<< BS.readFile indexPath
checkForSelfUpgrade :: Verbosity -> [Repo] -> IO ()
diff --git a/cabal-install-0.8.2/Distribution/Client/Upload.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Upload.hs
index 1e812c7..1e812c7 100644
--- a/cabal-install-0.8.2/Distribution/Client/Upload.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Upload.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/Utils.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Utils.hs
index 39035b9..39035b9 100644
--- a/cabal-install-0.8.2/Distribution/Client/Utils.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Utils.hs
diff --git a/cabal-install-0.8.2/Distribution/Client/Win32SelfUpgrade.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/Win32SelfUpgrade.hs
index 0417122..0417122 100644
--- a/cabal-install-0.8.2/Distribution/Client/Win32SelfUpgrade.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/Win32SelfUpgrade.hs
diff --git a/cabal-install-0.9.5_rc20101226/Distribution/Client/World.hs b/cabal-install-0.9.5_rc20101226/Distribution/Client/World.hs
new file mode 100644
index 0000000..5c53512
--- /dev/null
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Client/World.hs
@@ -0,0 +1,132 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Distribution.Client.World
+-- Copyright : (c) Peter Robinson 2009
+-- License : BSD-like
+--
+-- Maintainer : thaldyron@gmail.com
+-- Stability : provisional
+-- Portability : portable
+--
+-- Interface to the world-file that contains a list of explicitly
+-- requested packages. Meant to be imported qualified.
+--
+-- A world file entry stores the package-name, package-version, and
+-- user flags.
+-- For example, the entry generated by
+-- # cabal install stm-io-hooks --flags="-debug"
+-- looks like this:
+-- # stm-io-hooks -any --flags="-debug"
+-- To rebuild/upgrade the packages in world (e.g. when updating the compiler)
+-- use
+-- # cabal install world
+--
+-----------------------------------------------------------------------------
+module Distribution.Client.World (
+ insert,
+ delete,
+ getContents,
+
+ worldPkg,
+ isWorldTarget,
+ isGoodWorldTarget,
+ ) where
+
+import Distribution.Simple.Utils( writeFileAtomic )
+import Distribution.Client.Types
+ ( UnresolvedDependency(..) )
+import Distribution.Package
+ ( PackageName(..), Dependency( Dependency ) )
+import Distribution.Version( anyVersion )
+import Distribution.Text( display, simpleParse )
+import Distribution.Verbosity ( Verbosity )
+import Distribution.Simple.Utils ( die, info, chattyTry )
+import Data.List( unionBy, deleteFirstsBy, nubBy )
+import Data.Maybe( isJust, fromJust )
+import System.IO.Error( isDoesNotExistError, )
+import qualified Data.ByteString.Lazy.Char8 as B
+import Prelude hiding ( getContents )
+
+-- | Adds packages to the world file; creates the file if it doesn't
+-- exist yet. Version constraints and flag assignments for a package are
+-- updated if already present. IO errors are non-fatal.
+insert :: Verbosity -> FilePath -> [UnresolvedDependency] -> IO ()
+insert = modifyWorld $ unionBy equalUDep
+
+-- | Removes packages from the world file.
+-- Note: Currently unused as there is no mechanism in Cabal (yet) to
+-- handle uninstalls. IO errors are non-fatal.
+delete :: Verbosity -> FilePath -> [UnresolvedDependency] -> IO ()
+delete = modifyWorld $ flip (deleteFirstsBy equalUDep)
+
+-- | UnresolvedDependency values are considered equal if they refer to
+-- the same package, i.e., we don't care about differing versions or flags.
+equalUDep :: UnresolvedDependency -> UnresolvedDependency -> Bool
+equalUDep (UnresolvedDependency (Dependency pkg1 _) _)
+ (UnresolvedDependency (Dependency pkg2 _) _) = pkg1 == pkg2
+
+-- | Modifies the world file by applying an update-function ('unionBy'
+-- for 'insert', 'deleteFirstsBy' for 'delete') to the given list of
+-- packages. IO errors are considered non-fatal.
+modifyWorld :: ([UnresolvedDependency] -> [UnresolvedDependency]
+ -> [UnresolvedDependency])
+ -- ^ Function that defines how
+ -- the list of user packages are merged with
+ -- existing world packages.
+ -> Verbosity
+ -> FilePath -- ^ Location of the world file
+ -> [UnresolvedDependency] -- ^ list of user supplied packages
+ -> IO ()
+modifyWorld _ _ _ [] = return ()
+modifyWorld f verbosity world pkgs =
+ chattyTry "Error while updating world-file. " $ do
+ pkgsOldWorld <- getContents world
+ -- Filter out packages that are not in the world file:
+ let pkgsNewWorld = nubBy equalUDep $ f pkgs pkgsOldWorld
+ -- 'Dependency' is not an Ord instance, so we need to check for
+ -- equivalence the awkward way:
+ if not (all (`elem` pkgsOldWorld) pkgsNewWorld &&
+ all (`elem` pkgsNewWorld) pkgsOldWorld)
+ then do
+ info verbosity "Updating world file..."
+ writeFileAtomic world $ unlines
+ [ (display pkg) | pkg <- pkgsNewWorld]
+ else
+ info verbosity "World file is already up to date."
+
+
+-- | Returns the content of the world file as a list
+getContents :: FilePath -> IO [UnresolvedDependency]
+getContents world = do
+ content <- safelyReadFile world
+ let result = map simpleParse (lines $ B.unpack content)
+ if all isJust result
+ then return $ map fromJust result
+ else die "Could not parse world file."
+ where
+ safelyReadFile :: FilePath -> IO B.ByteString
+ safelyReadFile file = B.readFile file `catch` handler
+ where
+ handler e | isDoesNotExistError e = return B.empty
+ | otherwise = ioError e
+
+
+-- | A dummy package that represents the world file.
+worldPkg :: PackageName
+worldPkg = PackageName "world"
+
+-- | Currently we have a silly way of representing the world target as
+-- an 'UnresolvedDependency' so we need a way to recognise it.
+--
+-- We should be using a structured type with various target kinds, like
+-- local file, repo package etc.
+--
+isWorldTarget :: UnresolvedDependency -> Bool
+isWorldTarget (UnresolvedDependency (Dependency pkg _) _) =
+ pkg == worldPkg
+
+isGoodWorldTarget :: UnresolvedDependency -> Bool
+isGoodWorldTarget (UnresolvedDependency (Dependency pkg ver) flags) =
+ pkg == worldPkg
+ && ver == anyVersion
+ && null flags
diff --git a/cabal-install-0.8.2/Distribution/Compat/Exception.hs b/cabal-install-0.9.5_rc20101226/Distribution/Compat/Exception.hs
index 2baafb5..2baafb5 100644
--- a/cabal-install-0.8.2/Distribution/Compat/Exception.hs
+++ b/cabal-install-0.9.5_rc20101226/Distribution/Compat/Exception.hs
diff --git a/cabal-install-0.8.2/LICENSE b/cabal-install-0.9.5_rc20101226/LICENSE
index 0d5bcda..0d5bcda 100644
--- a/cabal-install-0.8.2/LICENSE
+++ b/cabal-install-0.9.5_rc20101226/LICENSE
diff --git a/cabal-install-0.9.5_rc20101226/Main.hs b/cabal-install-0.9.5_rc20101226/Main.hs
new file mode 100644
index 0000000..31b6a9c
--- /dev/null
+++ b/cabal-install-0.9.5_rc20101226/Main.hs
@@ -0,0 +1,388 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Main
+-- Copyright : (c) David Himmelstrup 2005
+-- License : BSD-like
+--
+-- Maintainer : lemmih@gmail.com
+-- Stability : provisional
+-- Portability : portable
+--
+-- Entry point to the default cabal-install front-end.
+-----------------------------------------------------------------------------
+
+module Main (main) where
+
+import Distribution.Client.Setup
+ ( GlobalFlags(..), globalCommand, globalRepos
+ , ConfigFlags(..)
+ , ConfigExFlags(..), configureExCommand
+ , InstallFlags(..), defaultInstallFlags
+ , installCommand, upgradeCommand
+ , FetchFlags(..), fetchCommand
+ , checkCommand
+ , updateCommand
+ , ListFlags(..), listCommand
+ , InfoFlags(..), infoCommand
+ , UploadFlags(..), uploadCommand
+ , InitFlags, initCommand
+ , reportCommand
+ , unpackCommand, UnpackFlags(..)
+ , parsePackageArgs )
+import Distribution.Simple.Setup
+ ( BuildFlags(..), buildCommand
+ , HaddockFlags(..), haddockCommand
+ , HscolourFlags(..), hscolourCommand
+ , CopyFlags(..), copyCommand
+ , RegisterFlags(..), registerCommand
+ , CleanFlags(..), cleanCommand
+ , SDistFlags(..), sdistCommand
+ , TestFlags(..), testCommand
+ , Flag(..), fromFlag, fromFlagOrDefault, flagToMaybe )
+
+import Distribution.Client.Types
+ ( UnresolvedDependency(UnresolvedDependency) )
+import Distribution.Client.SetupWrapper
+ ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
+import Distribution.Client.Config
+ ( SavedConfig(..), loadConfig, defaultConfigFile )
+import Distribution.Client.List (list, info)
+import Distribution.Client.Install (install, upgrade)
+import Distribution.Client.Configure (configure)
+import Distribution.Client.Update (update)
+import Distribution.Client.Fetch (fetch)
+import Distribution.Client.Check as Check (check)
+--import Distribution.Client.Clean (clean)
+import Distribution.Client.Upload as Upload (upload, check, report)
+import Distribution.Client.SrcDist (sdist)
+import Distribution.Client.Unpack (unpack)
+import Distribution.Client.Init (initCabal)
+import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade
+
+import Distribution.Simple.Compiler
+ ( PackageDB(..), PackageDBStack )
+import Distribution.Simple.Program (defaultProgramConfiguration)
+import Distribution.Simple.Command
+import Distribution.Simple.Configure (configCompilerAux)
+import Distribution.Simple.Utils
+ ( cabalVersion, die, topHandler, intercalate )
+import Distribution.Text
+ ( display )
+import Distribution.Verbosity as Verbosity
+ ( Verbosity, normal, intToVerbosity )
+import qualified Paths_cabal_install (version)
+
+import System.Environment (getArgs, getProgName)
+import System.Exit (exitFailure)
+import System.FilePath (splitExtension, takeExtension)
+import System.Directory (doesFileExist)
+import Data.List (intersperse)
+import Data.Maybe (fromMaybe)
+import Data.Monoid (Monoid(..))
+import Control.Monad (unless)
+
+-- | Entry point
+--
+main :: IO ()
+main = getArgs >>= mainWorker
+
+mainWorker :: [String] -> IO ()
+mainWorker ("win32selfupgrade":args) = win32SelfUpgradeAction args
+mainWorker args = topHandler $
+ case commandsRun globalCommand commands args of
+ CommandHelp help -> printGlobalHelp help
+ CommandList opts -> printOptionsList opts
+ CommandErrors errs -> printErrors errs
+ CommandReadyToGo (globalflags, commandParse) ->
+ case commandParse of
+ _ | fromFlag (globalVersion globalflags) -> printVersion
+ | fromFlag (globalNumericVersion globalflags) -> printNumericVersion
+ CommandHelp help -> printCommandHelp help
+ CommandList opts -> printOptionsList opts
+ CommandErrors errs -> printErrors errs
+ CommandReadyToGo action -> action globalflags
+
+ where
+ printCommandHelp help = do
+ pname <- getProgName
+ putStr (help pname)
+ printGlobalHelp help = do
+ pname <- getProgName
+ configFile <- defaultConfigFile
+ putStr (help pname)
+ putStr $ "\nYou can edit the cabal configuration file to set defaults:\n"
+ ++ " " ++ configFile ++ "\n"
+ printOptionsList = putStr . unlines
+ printErrors errs = die $ concat (intersperse "\n" errs)
+ printNumericVersion = putStrLn $ display Paths_cabal_install.version
+ printVersion = putStrLn $ "cabal-install version "
+ ++ display Paths_cabal_install.version
+ ++ "\nusing version "
+ ++ display cabalVersion
+ ++ " of the Cabal library "
+
+ commands =
+ [installCommand `commandAddAction` installAction
+ ,updateCommand `commandAddAction` updateAction
+ ,listCommand `commandAddAction` listAction
+ ,infoCommand `commandAddAction` infoAction
+ ,fetchCommand `commandAddAction` fetchAction
+ ,unpackCommand `commandAddAction` unpackAction
+ ,checkCommand `commandAddAction` checkAction
+ ,sdistCommand `commandAddAction` sdistAction
+ ,uploadCommand `commandAddAction` uploadAction
+ ,reportCommand `commandAddAction` reportAction
+ ,initCommand `commandAddAction` initAction
+ ,configureExCommand `commandAddAction` configureAction
+ ,wrapperAction (buildCommand defaultProgramConfiguration)
+ buildVerbosity buildDistPref
+ ,wrapperAction copyCommand
+ copyVerbosity copyDistPref
+ ,wrapperAction haddockCommand
+ haddockVerbosity haddockDistPref
+ ,wrapperAction cleanCommand
+ cleanVerbosity cleanDistPref
+ ,wrapperAction hscolourCommand
+ hscolourVerbosity hscolourDistPref
+ ,wrapperAction registerCommand
+ regVerbosity regDistPref
+ ,wrapperAction testCommand
+ testVerbosity testDistPref
+ ,upgradeCommand `commandAddAction` upgradeAction
+ ]
+
+wrapperAction :: Monoid flags
+ => CommandUI flags
+ -> (flags -> Flag Verbosity)
+ -> (flags -> Flag String)
+ -> Command (GlobalFlags -> IO ())
+wrapperAction command verbosityFlag distPrefFlag =
+ commandAddAction command
+ { commandDefaultFlags = mempty } $ \flags extraArgs _globalFlags -> do
+ let verbosity = fromFlagOrDefault normal (verbosityFlag flags)
+ setupScriptOptions = defaultSetupScriptOptions {
+ useDistPref = fromFlagOrDefault
+ (useDistPref defaultSetupScriptOptions)
+ (distPrefFlag flags)
+ }
+ setupWrapper verbosity setupScriptOptions Nothing
+ command (const flags) extraArgs
+
+configureAction :: (ConfigFlags, ConfigExFlags)
+ -> [String] -> GlobalFlags -> IO ()
+configureAction (configFlags, configExFlags) extraArgs globalFlags = do
+ let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ config <- loadConfig verbosity (globalConfigFile globalFlags)
+ (configUserInstall configFlags)
+ let configFlags' = savedConfigureFlags config `mappend` configFlags
+ configExFlags' = savedConfigureExFlags config `mappend` configExFlags
+ globalFlags' = savedGlobalFlags config `mappend` globalFlags
+ (comp, conf) <- configCompilerAux configFlags'
+ configure verbosity
+ (configPackageDB' configFlags') (globalRepos globalFlags')
+ comp conf configFlags' configExFlags' extraArgs
+
+installAction :: (ConfigFlags, ConfigExFlags, InstallFlags)
+ -> [String] -> GlobalFlags -> IO ()
+installAction (configFlags, _, installFlags) _ _globalFlags
+ | fromFlagOrDefault False (installOnly installFlags)
+ = let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ in setupWrapper verbosity defaultSetupScriptOptions Nothing
+ installCommand (const mempty) []
+
+installAction (configFlags, configExFlags, installFlags)
+ extraArgs globalFlags = do
+ pkgs <- either die return (parsePackageArgs extraArgs)
+ let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ config <- loadConfig verbosity (globalConfigFile globalFlags)
+ (configUserInstall configFlags)
+ let configFlags' = savedConfigureFlags config `mappend` configFlags
+ configExFlags' = savedConfigureExFlags config `mappend` configExFlags
+ installFlags' = defaultInstallFlags `mappend`
+ savedInstallFlags config `mappend` installFlags
+ globalFlags' = savedGlobalFlags config `mappend` globalFlags
+ (comp, conf) <- configCompilerAux configFlags'
+ install verbosity
+ (configPackageDB' configFlags') (globalRepos globalFlags')
+ comp conf globalFlags' configFlags' configExFlags' installFlags'
+ [ UnresolvedDependency pkg (configConfigurationsFlags configFlags')
+ | pkg <- pkgs ]
+
+listAction :: ListFlags -> [String] -> GlobalFlags -> IO ()
+listAction listFlags extraArgs globalFlags = do
+ let verbosity = fromFlag (listVerbosity listFlags)
+ config <- loadConfig verbosity (globalConfigFile globalFlags) mempty
+ let configFlags = savedConfigureFlags config
+ globalFlags' = savedGlobalFlags config `mappend` globalFlags
+ (comp, conf) <- configCompilerAux configFlags
+ list verbosity
+ (configPackageDB' configFlags)
+ (globalRepos globalFlags')
+ comp
+ conf
+ listFlags
+ extraArgs
+
+infoAction :: InfoFlags -> [String] -> GlobalFlags -> IO ()
+infoAction infoFlags extraArgs globalFlags = do
+ pkgs <- either die return (parsePackageArgs extraArgs)
+ let verbosity = fromFlag (infoVerbosity infoFlags)
+ config <- loadConfig verbosity (globalConfigFile globalFlags) mempty
+ let configFlags = savedConfigureFlags config
+ globalFlags' = savedGlobalFlags config `mappend` globalFlags
+ (comp, conf) <- configCompilerAux configFlags
+ info verbosity
+ (configPackageDB' configFlags)
+ (globalRepos globalFlags')
+ comp
+ conf
+ infoFlags
+ [ UnresolvedDependency pkg [] | pkg <- pkgs ]
+
+updateAction :: Flag Verbosity -> [String] -> GlobalFlags -> IO ()
+updateAction verbosityFlag extraArgs globalFlags = do
+ unless (null extraArgs) $ do
+ die $ "'update' doesn't take any extra arguments: " ++ unwords extraArgs
+ let verbosity = fromFlag verbosityFlag
+ config <- loadConfig verbosity (globalConfigFile globalFlags) mempty
+ let globalFlags' = savedGlobalFlags config `mappend` globalFlags
+ update verbosity (globalRepos globalFlags')
+
+upgradeAction :: (ConfigFlags, ConfigExFlags, InstallFlags)
+ -> [String] -> GlobalFlags -> IO ()
+upgradeAction (configFlags, configExFlags, installFlags)
+ extraArgs globalFlags = do
+ pkgs <- either die return (parsePackageArgs extraArgs)
+ let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+ config <- loadConfig verbosity (globalConfigFile globalFlags)
+ (configUserInstall configFlags)
+ let configFlags' = savedConfigureFlags config `mappend` configFlags
+ configExFlags' = savedConfigureExFlags config `mappend` configExFlags
+ installFlags' = defaultInstallFlags `mappend`
+ savedInstallFlags config `mappend` installFlags
+ globalFlags' = savedGlobalFlags config `mappend` globalFlags
+ (comp, conf) <- configCompilerAux configFlags'
+ upgrade verbosity
+ (configPackageDB' configFlags') (globalRepos globalFlags')
+ comp conf globalFlags' configFlags' configExFlags' installFlags'
+ [ UnresolvedDependency pkg (configConfigurationsFlags configFlags')
+ | pkg <- pkgs ]
+
+fetchAction :: FetchFlags -> [String] -> GlobalFlags -> IO ()
+fetchAction fetchFlags extraArgs globalFlags = do
+ pkgs <- either die return (parsePackageArgs extraArgs)
+ let verbosity = fromFlag (fetchVerbosity fetchFlags)
+ config <- loadConfig verbosity (globalConfigFile globalFlags) mempty
+ let configFlags = savedConfigureFlags config
+ globalFlags' = savedGlobalFlags config `mappend` globalFlags
+ (comp, conf) <- configCompilerAux configFlags
+ fetch verbosity
+ (configPackageDB' configFlags) (globalRepos globalFlags')
+ comp conf fetchFlags
+ [ UnresolvedDependency pkg [] --TODO: flags?
+ | pkg <- pkgs ]
+
+uploadAction :: UploadFlags -> [String] -> GlobalFlags -> IO ()
+uploadAction uploadFlags extraArgs globalFlags = do
+ let verbosity = fromFlag (uploadVerbosity uploadFlags)
+ config <- loadConfig verbosity (globalConfigFile globalFlags) mempty
+ let uploadFlags' = savedUploadFlags config `mappend` uploadFlags
+ globalFlags' = savedGlobalFlags config `mappend` globalFlags
+ tarfiles = extraArgs
+ checkTarFiles extraArgs
+ if fromFlag (uploadCheck uploadFlags')
+ then Upload.check verbosity tarfiles
+ else upload verbosity
+ (globalRepos globalFlags')
+ (flagToMaybe $ uploadUsername uploadFlags')
+ (flagToMaybe $ uploadPassword uploadFlags')
+ tarfiles
+ where
+ checkTarFiles tarfiles
+ | null tarfiles
+ = die "the 'upload' command expects one or more .tar.gz packages."
+ | not (null otherFiles)
+ = die $ "the 'upload' command expects only .tar.gz packages: "
+ ++ intercalate ", " otherFiles
+ | otherwise = sequence_
+ [ do exists <- doesFileExist tarfile
+ unless exists $ die $ "file not found: " ++ tarfile
+ | tarfile <- tarfiles ]
+
+ where otherFiles = filter (not . isTarGzFile) tarfiles
+ isTarGzFile file = case splitExtension file of
+ (file', ".gz") -> takeExtension file' == ".tar"
+ _ -> False
+
+checkAction :: Flag Verbosity -> [String] -> GlobalFlags -> IO ()
+checkAction verbosityFlag extraArgs _globalFlags = do
+ unless (null extraArgs) $ do
+ die $ "'check' doesn't take any extra arguments: " ++ unwords extraArgs
+ allOk <- Check.check (fromFlag verbosityFlag)
+ unless allOk exitFailure
+
+
+sdistAction :: SDistFlags -> [String] -> GlobalFlags -> IO ()
+sdistAction sflags extraArgs _globalFlags = do
+ unless (null extraArgs) $ do
+ die $ "'sdist' doesn't take any extra arguments: " ++ unwords extraArgs
+ sdist sflags
+
+reportAction :: Flag Verbosity -> [String] -> GlobalFlags -> IO ()
+reportAction verbosityFlag extraArgs globalFlags = do
+ unless (null extraArgs) $ do
+ die $ "'report' doesn't take any extra arguments: " ++ unwords extraArgs
+
+ let verbosity = fromFlag verbosityFlag
+ config <- loadConfig verbosity (globalConfigFile globalFlags) mempty
+ let globalFlags' = savedGlobalFlags config `mappend` globalFlags
+
+ Upload.report verbosity (globalRepos globalFlags')
+
+unpackAction :: UnpackFlags -> [String] -> GlobalFlags -> IO ()
+unpackAction flags extraArgs globalFlags = do
+ pkgs <- either die return (parsePackageArgs extraArgs)
+ let verbosity = fromFlag (unpackVerbosity flags)
+ config <- loadConfig verbosity (globalConfigFile globalFlags) mempty
+ unpack flags (globalRepos (savedGlobalFlags config)) pkgs
+
+initAction :: InitFlags -> [String] -> GlobalFlags -> IO ()
+initAction flags _extraArgs _globalFlags = do
+ initCabal flags
+
+-- | See 'Distribution.Client.Install.withWin32SelfUpgrade' for details.
+--
+win32SelfUpgradeAction :: [String] -> IO ()
+win32SelfUpgradeAction (pid:path:rest) =
+ Win32SelfUpgrade.deleteOldExeFile verbosity (read pid) path
+ where
+ verbosity = case rest of
+ (['-','-','v','e','r','b','o','s','e','=',n]:_) | n `elem` ['0'..'9']
+ -> fromMaybe Verbosity.normal (Verbosity.intToVerbosity (read [n]))
+ _ -> Verbosity.normal
+win32SelfUpgradeAction _ = return ()
+
+--
+-- Utils (transitionary)
+--
+
+-- | Currently the user interface specifies the package dbs to use with just a
+-- single valued option, a 'PackageDB'. However internally we represent the
+-- stack of 'PackageDB's explictly as a list. This function converts encodes
+-- the package db stack implicit in a single packagedb.
+--
+-- TODO: sort this out, make it consistent with the command line UI
+implicitPackageDbStack :: Bool -> Maybe PackageDB -> PackageDBStack
+implicitPackageDbStack userInstall packageDbFlag
+ | userInstall = GlobalPackageDB : UserPackageDB : extra
+ | otherwise = GlobalPackageDB : extra
+ where
+ extra = case packageDbFlag of
+ Just (SpecificPackageDB db) -> [SpecificPackageDB db]
+ _ -> []
+
+configPackageDB' :: ConfigFlags -> PackageDBStack
+configPackageDB' cfg =
+ implicitPackageDbStack userInstall (flagToMaybe (configPackageDB cfg))
+ where
+ userInstall = fromFlagOrDefault True (configUserInstall cfg)
diff --git a/cabal-install-0.8.2/Paths_cabal_install.hs b/cabal-install-0.9.5_rc20101226/Paths_cabal_install.hs
index f26d297..4398934 100644
--- a/cabal-install-0.8.2/Paths_cabal_install.hs
+++ b/cabal-install-0.9.5_rc20101226/Paths_cabal_install.hs
@@ -5,4 +5,4 @@ module Paths_cabal_install (
import Data.Version (Version(..))
version :: Version
-version = Version {versionBranch = [0,8,2], versionTags = []}
+version = Version {versionBranch = [0,9,5], versionTags = []}
diff --git a/cabal-install-0.9.5_rc20101226/README b/cabal-install-0.9.5_rc20101226/README
new file mode 100644
index 0000000..8c7053c
--- /dev/null
+++ b/cabal-install-0.9.5_rc20101226/README
@@ -0,0 +1,153 @@
+The cabal-install package
+=========================
+
+[Cabal home page](http://www.haskell.org/cabal/)
+
+The `cabal-install` package provides a command line tool called `cabal`. The
+tool uses the `Cabal` library and provides a convenient user interface to the
+Cabal/Hackage package build and distribution system. It can build and install
+both local and remote packages, including dependencies.
+
+
+Installation instructions for the cabal-install command line tool
+=================================================================
+
+The `cabal-install` package requires a number of other packages, most of which
+come with a standard ghc installation. It requires the `network` package, which
+is sometimes packaged separately by Linux distributions, for example on
+debian or ubuntu it is in "libghc6-network-dev".
+
+It requires a few other Haskell packages that are not always installed:
+
+ * Cabal (version 1.8 or later)
+ * HTTP (version 4000 or later)
+ * zlib (version 0.4 or later)
+
+All of these are available from [Hackage](http://hackage.haskell.org).
+
+Note that on some Unix systems you may need to install an additional zlib
+development package using your system package manager, for example on
+debian or ubuntu it is in "zlib1g-dev". It is needed is because the
+Haskell zlib package uses the system zlib C library and header files.
+
+The `cabal-install` package is now part of the Haskell Platform so you do not
+usually need to install it separately. However if you are starting from a
+minimal ghc installation then you need to install `cabal-install` manually.
+Since it is just an ordinary Cabal package it can be built in the standard
+way, but to make it a bit easier we have partly automated the process:
+
+
+Quickstart on Unix systems
+--------------------------
+
+As a convenience for users on Unix systems there is a `bootstrap.sh` script
+which will download and install each of the dependencies in turn.
+
+ $ ./bootstrap.sh
+
+It will download and install the above three dependencies. The script will
+install the library packages into `$HOME/.cabal/` and the `cabal` program will
+be installed into `$HOME/.cabal/bin/`.
+
+You then have two choices:
+
+ * put `$HOME/.cabal/bin` on your `$PATH`
+ * move the `cabal` program somewhere that is on your `$PATH`
+
+The next thing to do is to get the latest list of packages with:
+
+ $ cabal update
+
+This will also create a default config file (if it does not already echo exist)
+at `$HOME/.cabal/config`
+
+By default cabal will install programs to `$HOME/.cabal/bin`. If you do not
+want to add this directory to your `$PATH` then you can change the setting in
+the config file, for example you could use:
+
+ symlink-bindir: $HOME/bin
+
+
+Quickstart on Windows systems
+-----------------------------
+
+For Windows users we provide a pre-compiled [cabal.exe] program. Just download
+it and put it somewhere on your `%PATH%`, for example
+`C:\Program Files\Haskell\bin`.
+
+[cabal.exe]: http://haskell.org/cabal/release/cabal-install-latest/cabal.exe
+
+The next thing to do is to get the latest list of packages with
+
+ cabal update
+
+This will also create a default config file (if it does not already echo exist)
+at `C:\Documents and Settings\username\Application Data\cabal\config`
+
+
+Using cabal-install
+===================
+
+There are two sets of commands: commands for working with a local project build
+tree and ones for working with distributed released packages from hackage.
+
+For a list of the full set of commands and the flags for each command see
+
+ $ cabal --help
+
+
+Commands for developers for local build trees
+---------------------------------------------
+
+The commands for local project build trees are almost exactly the same as the
+`runghc Setup` command line interface that many people are already familiar
+with. In particular there are the commands
+
+ cabal configure
+ cabal build
+ cabal haddock
+ cabal clean
+ cabal sdist
+
+The `install` command is somewhat different. It is an all-in-one operation. If
+you run
+
+ $ cabal install
+
+in your build tree it will configure, build and install. It takes all the flags
+that `configure` takes such as `--global` and `--prefix`.
+
+In addition, if any dependencies are not installed it will download and install
+them. If can also rebuild packages to ensure a consistent set of dependencies.
+
+
+Commands for released hackage packages
+--------------------------------------
+
+ $ cabal update
+
+This command gets the latest list of packages from the hackage server.
+Currently this command has to be run manually occasionally, in particular if
+you want to install a newly released package.
+
+
+ $ cabal install xmonad
+
+This is the eponymous command. It installs one or more named packages (and all
+their dependencies) from hackage.
+
+By default it installs the latest available version however you can optionally
+specify exact versions or version ranges. For example `cabal install alex-2.2`
+or `cabal install parsec < 3`.
+
+ $ cabal upgrade xmonad
+
+This is a variation on the `install` command. Both mean to install the latest
+version, the only difference is in the treatment of dependencies. The `install`
+command tries to use existing installed versions of dependent packages while
+the `upgrade` command tries to upgrade all the dependencies too.
+
+ $ cabal list xml
+
+This does a search of the installed and available packages. It does a
+case-insensitive substring match on the package name.
diff --git a/cabal-install-0.9.5_rc20101226/Setup.hs b/cabal-install-0.9.5_rc20101226/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/cabal-install-0.9.5_rc20101226/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/cabal-install-0.9.5_rc20101226/bash-completion/cabal b/cabal-install-0.9.5_rc20101226/bash-completion/cabal
new file mode 100644
index 0000000..8ebfabc
--- /dev/null
+++ b/cabal-install-0.9.5_rc20101226/bash-completion/cabal
@@ -0,0 +1,24 @@
+# cabal command line completion
+# Copyright 2007-2008 "Lennart Kolmodin" <kolmodin@gentoo.org>
+# "Duncan Coutts" <dcoutts@gentoo.org>
+#
+
+_cabal()
+{
+ # get the word currently being completed
+ local cur
+ cur=${COMP_WORDS[$COMP_CWORD]}
+
+ # create a command line to run
+ local cmd
+ # copy all words the user has entered
+ cmd=( ${COMP_WORDS[@]} )
+
+ # replace the current word with --list-options
+ cmd[${COMP_CWORD}]="--list-options"
+
+ # the resulting completions should be put into this array
+ COMPREPLY=( $( compgen -W "$( ${cmd[@]} )" -- $cur ) )
+}
+
+complete -F _cabal -o default cabal
diff --git a/cabal-install-0.9.5_rc20101226/bootstrap.sh b/cabal-install-0.9.5_rc20101226/bootstrap.sh
new file mode 100644
index 0000000..ecacd73
--- /dev/null
+++ b/cabal-install-0.9.5_rc20101226/bootstrap.sh
@@ -0,0 +1,241 @@
+#!/bin/sh
+
+# A script to bootstrap cabal-install.
+
+# It works by downloading and installing the Cabal, zlib and
+# HTTP packages. It then installs cabal-install itself.
+# It expects to be run inside the cabal-install directory.
+
+# install settings, you can override these by setting environment vars
+PREFIX=${PREFIX:-${HOME}/.cabal}
+#VERBOSE
+#EXTRA_CONFIGURE_OPTS
+
+# programs, you can override these by setting environment vars
+GHC=${GHC:-ghc}
+GHC_PKG=${GHC_PKG:-ghc-pkg}
+WGET=${WGET:-wget}
+CURL=${CURL:-curl}
+TAR=${TAR:-tar}
+GUNZIP=${GUNZIP:-gunzip}
+SCOPE_OF_INSTALLATION="--user"
+
+
+for arg in $*
+do
+ case "${arg}" in
+ "--user")
+ SCOPE_OF_INSTALLATION=${arg}
+ shift;;
+ "--global")
+ SCOPE_OF_INSTALLATION=${arg}
+ PREFIX="/usr/local"
+ shift;;
+ *)
+ echo "Unknown argument or option, quitting: ${arg}"
+ echo "usage: bootstrap.sh [OPTION]"
+ echo
+ echo "options:"
+ echo " --user Install for the local user (default)"
+ echo " --global Install systemwide"
+ exit;;
+ esac
+done
+
+
+# Versions of the packages to install.
+# The version regex says what existing installed versions are ok.
+PARSEC_VER="2.1.0.1"; PARSEC_VER_REGEXP="2\." # == 2.*
+NETWORK_VER="2.2.1.10"; NETWORK_VER_REGEXP="2\." # == 2.*
+CABAL_VER="1.10.0.0"; CABAL_VER_REGEXP="1\.10\." # == 1.10.*
+MTL_VER="1.1.1.0"; MTL_VER_REGEXP="1\.1\." # == 1.1.*
+HTTP_VER="4000.0.10"; HTTP_VER_REGEXP="4000\.0" # == 4000.0.*
+ZLIB_VER="0.5.2.0"; ZLIB_VER_REGEXP="0\.[45]\." # == 0.4.* || ==0.5.*
+TIME_VER="1.2.0.3" TIME_VER_REGEXP="1\.[12]\." # == 0.1.* || ==0.2.*
+
+HACKAGE_URL="http://hackage.haskell.org/packages/archive"
+
+die () {
+ echo
+ echo "Error during cabal-install bootstrap:"
+ echo $1 >&2
+ exit 2
+}
+
+# Check we're in the right directory:
+grep "cabal-install" ./cabal-install.cabal > /dev/null 2>&1 \
+ || die "The bootstrap.sh script must be run in the cabal-install directory"
+
+${GHC} --numeric-version > /dev/null \
+ || die "${GHC} not found (or could not be run). If ghc is installed make sure it is on your PATH or set the GHC and GHC_PKG vars."
+${GHC_PKG} --version > /dev/null \
+ || die "${GHC_PKG} not found."
+GHC_VER=`${GHC} --numeric-version`
+GHC_PKG_VER=`${GHC_PKG} --version | cut -d' ' -f 5`
+[ ${GHC_VER} = ${GHC_PKG_VER} ] \
+ || die "Version mismatch between ${GHC} and ${GHC_PKG} If you set the GHC variable then set GHC_PKG too"
+
+# Cache the list of packages:
+echo "Checking installed packages for ghc-${GHC_VER}..."
+${GHC_PKG} list > ghc-pkg.list \
+ || die "running '${GHC_PKG} list' failed"
+
+# Will we need to install this package, or is a suitable version installed?
+need_pkg () {
+ PKG=$1
+ VER_MATCH=$2
+ if grep " ${PKG}-${VER_MATCH}" ghc-pkg.list > /dev/null 2>&1
+ then
+ return 1;
+ else
+ return 0;
+ fi
+ #Note: we cannot use "! grep" here as Solaris 9 /bin/sh doesn't like it.
+}
+
+info_pkg () {
+ PKG=$1
+ VER=$2
+ VER_MATCH=$3
+
+ if need_pkg ${PKG} ${VER_MATCH}
+ then
+ echo "${PKG}-${VER} will be downloaded and installed."
+ else
+ echo "${PKG} is already installed and the version is ok."
+ fi
+}
+
+dep_pkg () {
+ PKG=$1
+ VER_MATCH=$2
+ if need_pkg ${PKG} ${VER_MATCH}
+ then
+ echo
+ echo "The Haskell package '${PKG}' is required but it is not installed."
+ echo "If you are using a ghc package provided by your operating system"
+ echo "then install the corresponding packages for 'parsec' and 'network'."
+ echo "If you built ghc from source with only the core libraries then you"
+ echo "should install these extra packages. You can get them from hackage."
+ die "The Haskell package '${PKG}' is required but it is not installed."
+ else
+ echo "${PKG} is already installed and the version is ok."
+ fi
+}
+
+fetch_pkg () {
+ PKG=$1
+ VER=$2
+
+ URL=${HACKAGE_URL}/${PKG}/${VER}/${PKG}-${VER}.tar.gz
+ if which ${CURL} > /dev/null
+ then
+ ${CURL} -C - -O ${URL} || die "Failed to download ${PKG}."
+ elif which ${WGET} > /dev/null
+ then
+ ${WGET} -c ${URL} || die "Failed to download ${PKG}."
+ else
+ die "Failed to find a downloader. 'wget' or 'curl' is required."
+ fi
+ [ -f "${PKG}-${VER}.tar.gz" ] \
+ || die "Downloading ${URL} did not create ${PKG}-${VER}.tar.gz"
+}
+
+unpack_pkg () {
+ PKG=$1
+ VER=$2
+
+ rm -rf "${PKG}-${VER}.tar" "${PKG}-${VER}"/
+ ${GUNZIP} -f "${PKG}-${VER}.tar.gz" \
+ || die "Failed to gunzip ${PKG}-${VER}.tar.gz"
+ ${TAR} -xf "${PKG}-${VER}.tar" \
+ || die "Failed to untar ${PKG}-${VER}.tar.gz"
+ [ -d "${PKG}-${VER}" ] \
+ || die "Unpacking ${PKG}-${VER}.tar.gz did not create ${PKG}-${VER}/"
+}
+
+install_pkg () {
+ PKG=$1
+
+ [ -x Setup ] && ./Setup clean
+ [ -f Setup ] && rm Setup
+
+ ${GHC} --make Setup -o Setup \
+ || die "Compiling the Setup script failed"
+ [ -x Setup ] || die "The Setup script does not exist or cannot be run"
+
+ ./Setup configure ${SCOPE_OF_INSTALLATION} "--prefix=${PREFIX}" \
+ --with-compiler=${GHC} --with-hc-pkg=${GHC_PKG} \
+ ${EXTRA_CONFIGURE_OPTS} ${VERBOSE} \
+ || die "Configuring the ${PKG} package failed"
+
+ ./Setup build ${VERBOSE} \
+ || die "Building the ${PKG} package failed"
+
+ ./Setup install ${VERBOSE} \
+ || die "Installing the ${PKG} package failed"
+}
+
+do_pkg () {
+ PKG=$1
+ VER=$2
+ VER_MATCH=$3
+
+ if need_pkg ${PKG} ${VER_MATCH}
+ then
+ echo
+ echo "Downloading ${PKG}-${VER}..."
+ fetch_pkg ${PKG} ${VER}
+ unpack_pkg ${PKG} ${VER}
+ cd "${PKG}-${VER}"
+ install_pkg ${PKG} ${VER}
+ cd ..
+ fi
+}
+
+# Actually do something!
+
+info_pkg "parsec" ${PARSEC_VER} ${PARSEC_VER_REGEXP}
+info_pkg "network" ${NETWORK_VER} ${NETWORK_VER_REGEXP}
+info_pkg "Cabal" ${CABAL_VER} ${CABAL_VER_REGEXP}
+info_pkg "mtl" ${MTL_VER} ${MTL_VER_REGEXP}
+info_pkg "time" ${TIME_VER} ${TIME_VER_REGEXP}
+info_pkg "HTTP" ${HTTP_VER} ${HTTP_VER_REGEXP}
+info_pkg "zlib" ${ZLIB_VER} ${ZLIB_VER_REGEXP}
+
+do_pkg "parsec" ${PARSEC_VER} ${PARSEC_VER_REGEXP}
+do_pkg "network" ${NETWORK_VER} ${NETWORK_VER_REGEXP}
+do_pkg "Cabal" ${CABAL_VER} ${CABAL_VER_REGEXP}
+do_pkg "mtl" ${MTL_VER} ${MTL_VER_REGEXP}
+do_pkg "time" ${TIME_VER} ${TIME_VER_REGEXP}
+do_pkg "HTTP" ${HTTP_VER} ${HTTP_VER_REGEXP}
+do_pkg "zlib" ${ZLIB_VER} ${ZLIB_VER_REGEXP}
+
+install_pkg "cabal-install"
+
+echo
+echo "==========================================="
+CABAL_BIN="$PREFIX/bin"
+if [ -x "$CABAL_BIN/cabal" ]
+then
+ echo "The 'cabal' program has been installed in $CABAL_BIN/"
+ echo "You should either add $CABAL_BIN to your PATH"
+ echo "or copy the cabal program to a directory that is on your PATH."
+ echo
+ echo "The first thing to do is to get the latest list of packages with:"
+ echo " cabal update"
+ echo "This will also create a default config file (if it does not already"
+ echo "exist) at $HOME/.cabal/config"
+ echo
+ echo "By default cabal will install programs to $HOME/.cabal/bin"
+ echo "If you do not want to add this directory to your PATH then you can"
+ echo "change the setting in the config file, for example you could use:"
+ echo "symlink-bindir: $HOME/bin"
+else
+ echo "Sorry, something went wrong."
+ echo "The 'cabal' executable was not successfully installed into"
+ echo "$CABAL_BIN/"
+fi
+echo
+
+rm ghc-pkg.list
diff --git a/cabal-install-0.8.2/cabal-install.cabal b/cabal-install-0.9.5_rc20101226/cabal-install.cabal
index 38cf8f5..b143d2f 100644
--- a/cabal-install-0.8.2/cabal-install.cabal
+++ b/cabal-install-0.9.5_rc20101226/cabal-install.cabal
@@ -1,5 +1,5 @@
Name: cabal-install
-Version: 0.8.2
+Version: 0.9.5
Synopsis: The command-line interface for Cabal and Hackage.
Description:
The \'cabal\' command-line program simplifies the process of managing
@@ -19,22 +19,16 @@ Copyright: 2005 Lemmih <lemmih@gmail.com>
2006 Paolo Martini <paolo@nemail.it>
2007 Bjorn Bringert <bjorn@bringert.net>
2007 Isaac Potoczny-Jones <ijones@syntaxpolice.org>
- 2008-2009 Duncan Coutts <duncan@haskell.org>
+ 2007-2010 Duncan Coutts <duncan@haskell.org>
Category: Distribution
Build-type: Simple
Extra-Source-Files: README bash-completion/cabal bootstrap.sh
Cabal-Version: >= 1.6
-Tested-With: GHC==6.6.1, GHC==6.8.2, GHC==6.10.4, GHC==6.12.1
source-repository head
type: darcs
location: http://darcs.haskell.org/cabal-install/
-source-repository this
- type: darcs
- location: http://darcs.haskell.org/cabal-branches/cabal-install-0.8/
- tag: 0.8.2
-
flag old-base
description: Old, monolithic base
default: False
@@ -57,12 +51,12 @@ Executable cabal
Distribution.Client.Config
Distribution.Client.Configure
Distribution.Client.Dependency
- Distribution.Client.Dependency.Bogus
Distribution.Client.Dependency.TopDown
Distribution.Client.Dependency.TopDown.Constraints
Distribution.Client.Dependency.TopDown.Types
Distribution.Client.Dependency.Types
Distribution.Client.Fetch
+ Distribution.Client.GZipUtils
Distribution.Client.Haddock
Distribution.Client.HttpUtils
Distribution.Client.IndexUtils
@@ -85,27 +79,28 @@ Executable cabal
Distribution.Client.Update
Distribution.Client.Upload
Distribution.Client.Utils
+ Distribution.Client.World
Distribution.Client.Win32SelfUpgrade
Distribution.Compat.Exception
Paths_cabal_install
build-depends: base >= 2 && < 5,
- Cabal >= 1.8 && < 1.9,
- filepath >= 1.0,
+ Cabal >= 1.10 && < 1.11,
+ filepath >= 1.0 && < 1.3,
network >= 1 && < 3,
HTTP >= 4000.0.2 && < 4001,
zlib >= 0.4 && < 0.6,
- time >= 1.1 && < 1.2
+ time >= 1.1 && < 1.3
if flag(old-base)
build-depends: base < 3
else
build-depends: base >= 3,
process >= 1 && < 1.1,
- directory >= 1 && < 1.1,
+ directory >= 1 && < 1.2,
pretty >= 1 && < 1.1,
random >= 1 && < 1.1,
- containers >= 0.1 && < 0.4,
+ containers >= 0.1 && < 0.5,
array >= 0.1 && < 0.4,
old-time >= 1 && < 1.1
diff --git a/cabal-install-0.9.5_rc20101226/changelog b/cabal-install-0.9.5_rc20101226/changelog
new file mode 100644
index 0000000..bf0df48
--- /dev/null
+++ b/cabal-install-0.9.5_rc20101226/changelog
@@ -0,0 +1,100 @@
+-*-change-log-*-
+
+0.8.0 Duncan Coutts <duncan@haskell.org> Dec 2009
+ * Works with ghc-6.12
+ * New "cabal init" command for making initial project .cabal file
+ * New feature to maintain an index of haddock documentation
+
+0.6.4 Duncan Coutts <duncan@haskell.org> Nov 2009
+ * Improve the algorithm for selecting the base package version
+ * Hackage errors now reported by "cabal upload [--check]"
+ * Improved format of messages from "cabal check"
+ * Config file can now be selected by an env var
+ * Updated tar reading/writing code
+ * Improve instructions in the README and bootstrap output
+ * Fix bootstrap.sh on Solaris 9
+ * Fix bootstrap for systems where network uses parsec 3
+ * Fix building with ghc-6.6
+
+0.6.2 Duncan Coutts <duncan@haskell.org> Feb 2009
+ * The upgrade command has been disabled in this release
+ * The configure and install commands now have consistent behaviour
+ * Reduce the tendancy to re-install already existing packages
+ * The --constraint= flag now works for the install command
+ * New --preference= flag for soft constraints / version preferences
+ * Improved bootstrap.sh script, smarter and better error checking
+ * New cabal info command to display detailed info on packages
+ * New cabal unpack command to download and untar a package
+ * HTTP-4000 package required, should fix bugs with http proxies
+ * Now works with authenticated proxies.
+ * On Windows can now override the proxy setting using an env var
+ * Fix compatability with config files generated by older versions
+ * Warn if the hackage package list is very old
+ * More helpful --help output, mention config file and examples
+ * Better documentation in ~/.cabal/config file
+ * Improved command line interface for logging and build reporting
+ * Minor improvements to some messages
+
+0.6.0 Duncan Coutts <duncan@haskell.org> Oct 2008
+ * Constraint solver can now cope with base 3 and base 4
+ * Allow use of package version preferences from hackage index
+ * More detailed output from cabal install --dry-run -v
+ * Improved bootstrap.sh
+
+0.5.2 Duncan Coutts <duncan@haskell.org> Aug 2008
+ * Suport building haddock documentaion
+ * Self-reinstall now works on Windows
+ * Allow adding symlinks to excutables into a separate bindir
+ * New self-documenting config file
+ * New install --reinstall flag
+ * More helpful status messages in a couple places
+ * Upload failures now report full text error message from the server
+ * Support for local package repositories
+ * New build logging and reporting
+ * New command to upload build reports to (a compatible) server
+ * Allow tilde in hackage server URIs
+ * Internal code improvements
+ * Many other minor improvements and bug fixes
+
+0.5.1 Duncan Coutts <duncan@haskell.org> June 2008
+ * Restore minimal hugs support in dependency resolver
+ * Fix for disabled http proxies on Windows
+ * Revert to global installs on Windows by default
+
+0.5.0 Duncan Coutts <duncan@haskell.org> June 2008
+ * New package dependency resolver, solving diamond dep problem
+ * Integrate cabal-setup functionality
+ * Integrate cabal-upload functionality
+ * New cabal update and check commands
+ * Improved behavior for install and upgrade commands
+ * Full Windows support
+ * New command line handling
+ * Bash command line completion
+ * Allow case insensitive package names on command line
+ * New --dry-run flag for install, upgrade and fetch commands
+ * New --root-cmd flag to allow installing as root
+ * New --cabal-lib-version flag to select different Cabal lib versions
+ * Support for HTTP proxies
+ * Improved cabal list output
+ * Build other non-dependent packages even when some fail
+ * Report a summary of all build failures at the end
+ * Partial support for hugs
+ * Partial implementation of build reporting and logging
+ * More consistent logging and verbosity
+ * Significant internal code restructuring
+
+0.4 Duncan Coutts <duncan@haskell.org> Oct 2007
+ * Renamed executable from 'cabal-install' to 'cabal'
+ * Partial Windows compatability
+ * Do per-user installs by default
+ * cabal install now installs the package in the current directory
+ * Allow multiple remote servers
+ * Use zlib lib and internal tar code and rather than external tar
+ * Reorganised configuration files
+ * Significant code restructuring
+ * Cope with packages with conditional dependencies
+
+0.3 and older versions by Lemmih, Paolo Martini and others 2006-2007
+ * Switch from smart-server, dumb-client model to the reverse
+ * New .tar.gz based index format
+ * New remote and local package archive format
diff --git a/cabal-install-0.9.5_rc20101226/tests/test-cabal-install b/cabal-install-0.9.5_rc20101226/tests/test-cabal-install
new file mode 100644
index 0000000..431afa1
--- /dev/null
+++ b/cabal-install-0.9.5_rc20101226/tests/test-cabal-install
@@ -0,0 +1,9 @@
+#!/bin/sh
+
+darcs get --partial http://darcs.haskell.org/packages/Cabal/ && \
+cd Cabal/cabal-install && \
+make && \
+sudo make install && \
+sudo cabal-install update && \
+cabal-install install --prefix=/tmp --user hnop && \
+ls -l /tmp/bin/hnop
diff --git a/cabal-install-0.9.5_rc20101226/tests/test-cabal-install-user b/cabal-install-0.9.5_rc20101226/tests/test-cabal-install-user
new file mode 100644
index 0000000..057494a
--- /dev/null
+++ b/cabal-install-0.9.5_rc20101226/tests/test-cabal-install-user
@@ -0,0 +1,8 @@
+#!/bin/sh
+
+darcs get --partial http://darcs.haskell.org/packages/Cabal/ && \
+cd Cabal/cabal-install && \
+make install-user && \
+cabal-install update && \
+cabal-install install --prefix=/tmp --user hnop && \
+ls -l /tmp/bin/hnop
diff --git a/hackport.cabal b/hackport.cabal
index 6f8ee59..f4eb7fb 100644
--- a/hackport.cabal
+++ b/hackport.cabal
@@ -1,5 +1,5 @@
Name: hackport
-Version: 0.2.9
+Version: 0.2.10
License: GPL
License-file: LICENSE
Author: Henning G√ľnther, Duncan Coutts, Lennart Kolmodin
@@ -9,7 +9,7 @@ Synopsis: Hackage and Portage integration tool
Description: A command line tool to manage an overlay of Gentoo ebuilds
that are generated from a hackage repo of Cabal packages.
Build-Type: Simple
-Cabal-Version: >=1.8
+Cabal-Version: >=1.10
source-repository head
type: darcs
@@ -19,7 +19,8 @@ Flag split-base
Executable hackport
Main-Is: Main.hs
- Hs-Source-Dirs: ., cabal-install-0.8.2
+ Default-Language: Haskell98
+ Hs-Source-Dirs: ., cabal-install-0.9.5_rc20101226
Build-Depends:
base >= 2.0 && < 5,
filepath,
@@ -28,15 +29,27 @@ Executable hackport
network,
pretty,
regex-compat,
- Cabal == 1.8.*,
+ Cabal == 1.10.*,
HTTP >= 4000.0.3,
zlib,
tar,
+ xml>1.3.5,
array,
-- array is inherited from cabal-install
-- tar >= 0.3.0.0 && < 0.4
extensible-exceptions
+ -- extensions due to hackport
+ other-extensions:
+ DeriveDataTypeable,
+ PatternGuards
+
+ -- extensions due to bundled cabal-install
+ other-extensions:
+ CPP,
+ ForeignFunctionInterface,
+ PatternGuards
+
if flag(split-base)
Build-Depends:
base >= 3 && < 5,
@@ -58,12 +71,11 @@ Executable hackport
Error
Paths_hackport
Main
- MaybeRead
Overlays
- P2
Portage
Portage.Version
Portage.Dependency
+ Portage.GHCCore
Portage.PackageId
Portage.Overlay
Portage.Resolve
@@ -73,3 +85,42 @@ Executable hackport
Status
Merge
Util
+
+
+Executable hackport-guess-ghc-version
+ Main-Is: Main-GuessGHC.hs
+ Default-Language: Haskell98
+ Buildable: False
+ -- this was used as a test while developing the
+ -- ghc-guessfeature. now we can disable building
+ Build-Depends:
+ base >= 2.0 && < 5,
+ filepath,
+ parsec,
+ mtl,
+ network,
+ pretty,
+ regex-compat,
+ Cabal > 1.8 && < 1.11,
+ HTTP >= 4000.0.3,
+ zlib,
+ tar,
+ array,
+ -- array is inherited from cabal-install
+ -- tar >= 0.3.0.0 && < 0.4
+ extensible-exceptions
+
+ if flag(split-base)
+ Build-Depends:
+ base >= 3 && < 5,
+ directory,
+ containers,
+ process,
+ old-time,
+ bytestring
+ else
+ Build-Depends: base < 3
+
+ ghc-options: -Wall
+ other-modules:
+ Portage.GHCCore