diff --git a/Distribution/Client/Configure.hs b/Distribution/Client/Configure.hs --- a/Distribution/Client/Configure.hs +++ b/Distribution/Client/Configure.hs @@ -27,49 +27,44 @@ import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.InstallPlan (InstallPlan) import Distribution.Client.IndexUtils as IndexUtils - ( getAvailablePackages ) + ( getAvailablePackages, getInstalledPackages ) import Distribution.Client.Setup ( ConfigExFlags(..), configureCommand, filterConfigureFlags ) import Distribution.Client.Types as Available ( AvailablePackage(..), AvailablePackageSource(..), Repo(..) - , AvailablePackageDb(..), ConfiguredPackage(..) ) + , AvailablePackageDb(..), ConfiguredPackage(..), InstalledPackage ) import Distribution.Client.SetupWrapper ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions ) import Distribution.Simple.Compiler - ( CompilerId(..), Compiler(compilerId), PackageDB(..) ) + ( CompilerId(..), Compiler(compilerId) + , PackageDB(..), PackageDBStack ) import Distribution.Simple.Program (ProgramConfiguration ) -import Distribution.Simple.Configure (getInstalledPackages) import Distribution.Simple.Setup ( ConfigFlags(..), toFlag, flagToMaybe, fromFlagOrDefault ) -import qualified Distribution.Simple.PackageIndex as PackageIndex -import Distribution.Simple.PackageIndex (PackageIndex) +import qualified Distribution.Client.PackageIndex as PackageIndex +import Distribution.Client.PackageIndex (PackageIndex) import Distribution.Simple.Utils ( defaultPackageDesc ) import Distribution.Package ( PackageName, packageName, packageVersion , Package(..), Dependency(..), thisPackageVersion ) -import qualified Distribution.PackageDescription as PackageDescription -import Distribution.PackageDescription - ( PackageDescription ) import Distribution.PackageDescription.Parse ( readPackageDescription ) import Distribution.PackageDescription.Configuration ( finalizePackageDescription ) -import Distribution.InstalledPackageInfo - ( InstalledPackageInfo ) import Distribution.Version - ( VersionRange(AnyVersion, ThisVersion) ) + ( VersionRange, anyVersion, thisVersion ) import Distribution.Simple.Utils as Utils ( notice, info, die ) import Distribution.System - ( Platform(Platform), buildPlatform ) + ( Platform, buildPlatform ) import Distribution.Verbosity as Verbosity ( Verbosity ) -- | Configure the package found in the local directory configure :: Verbosity - -> PackageDB + -> PackageDBStack -> [Repo] -> Compiler -> ProgramConfiguration @@ -77,10 +72,10 @@ -> ConfigExFlags -> [String] -> IO () -configure verbosity packageDB repos comp conf +configure verbosity packageDBs repos comp conf configFlags configExFlags extraArgs = do - installed <- getInstalledPackages verbosity comp packageDB conf + installed <- getInstalledPackages verbosity comp packageDBs conf available <- getAvailablePackages verbosity repos progress <- planLocalPackage verbosity comp configFlags configExFlags @@ -108,18 +103,18 @@ where setupScriptOptions index = SetupScriptOptions { - useCabalVersion = maybe AnyVersion ThisVersion + useCabalVersion = maybe anyVersion thisVersion (flagToMaybe (configCabalVersion configExFlags)), 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. - -- TODO: if we specify a specific db then we do not look in the user - -- package db but we probably should ie [global, user, specific] - usePackageDB = if packageDB == GlobalPackageDB then UserPackageDB - else packageDB, - usePackageIndex = if packageDB == GlobalPackageDB then Nothing - else index, + usePackageDB = if UserPackageDB `elem` packageDBs + then packageDBs + else packageDBs ++ [UserPackageDB], + usePackageIndex = if UserPackageDB `elem` packageDBs + then index + else Nothing, useProgramConfig = conf, useDistPref = fromFlagOrDefault (useDistPref defaultSetupScriptOptions) @@ -133,7 +128,7 @@ -- planLocalPackage :: Verbosity -> Compiler -> ConfigFlags -> ConfigExFlags - -> Maybe (PackageIndex InstalledPackageInfo) + -> Maybe (PackageIndex InstalledPackage) -> AvailablePackageDb -> IO (Progress String String InstallPlan) planLocalPackage verbosity comp configFlags configExFlags installed @@ -152,7 +147,7 @@ } targets = [packageName pkg] constraints = [PackageVersionConstraint (packageName pkg) - (ThisVersion (packageVersion pkg)) + (thisVersion (packageVersion pkg)) ,PackageFlagsConstraint (packageName pkg) (configConfigurationsFlags configFlags)] ++ [ PackageVersionConstraint name ver @@ -190,7 +185,7 @@ -> ConfiguredPackage -> [String] -> IO () -configurePackage verbosity (Platform arch os) comp scriptOptions configFlags +configurePackage verbosity platform comp scriptOptions configFlags (ConfiguredPackage (AvailablePackage _ gpkg _) flags deps) extraArgs = setupWrapper verbosity @@ -204,7 +199,7 @@ } pkg = case finalizePackageDescription flags - (Nothing :: Maybe (PackageIndex PackageDescription)) - os arch comp [] gpkg of + (const True) + platform comp [] gpkg of Left _ -> error "finalizePackageDescription ConfiguredPackage failed" Right (desc, _) -> desc diff --git a/Distribution/Client/Dependency.hs b/Distribution/Client/Dependency.hs --- a/Distribution/Client/Dependency.hs +++ b/Distribution/Client/Dependency.hs @@ -29,13 +29,12 @@ import Distribution.Client.Dependency.Bogus (bogusResolver) import Distribution.Client.Dependency.TopDown (topDownResolver) -import qualified Distribution.Simple.PackageIndex as PackageIndex -import Distribution.Simple.PackageIndex (PackageIndex) -import Distribution.InstalledPackageInfo (InstalledPackageInfo) +import qualified Distribution.Client.PackageIndex as PackageIndex +import Distribution.Client.PackageIndex (PackageIndex) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.InstallPlan (InstallPlan) import Distribution.Client.Types - ( UnresolvedDependency(..), AvailablePackage(..) ) + ( UnresolvedDependency(..), AvailablePackage(..), InstalledPackage ) import Distribution.Client.Dependency.Types ( DependencyResolver, PackageConstraint(..) , PackagePreferences(..), InstalledPreference(..) @@ -44,7 +43,7 @@ ( PackageIdentifier(..), PackageName(..), packageVersion, packageName , Dependency(..), Package(..), PackageFixedDeps(..) ) import Distribution.Version - ( VersionRange(AnyVersion), orLaterVersion, isAnyVersion ) + ( VersionRange, anyVersion, orLaterVersion, isAnyVersion ) import Distribution.Compiler ( CompilerId(..) ) import Distribution.System @@ -113,7 +112,7 @@ resolveDependencies :: Platform -> CompilerId - -> Maybe (PackageIndex InstalledPackageInfo) + -> Maybe (PackageIndex InstalledPackage) -> PackageIndex AvailablePackage -> PackagesPreference -> [PackageConstraint] @@ -127,7 +126,7 @@ resolveDependenciesWithProgress :: Platform -> CompilerId - -> Maybe (PackageIndex InstalledPackageInfo) + -> Maybe (PackageIndex InstalledPackage) -> PackageIndex AvailablePackage -> PackagesPreference -> [PackageConstraint] @@ -152,7 +151,7 @@ dependencyResolver :: DependencyResolver -> Platform -> CompilerId - -> PackageIndex InstalledPackageInfo + -> PackageIndex InstalledPackage -> PackageIndex AvailablePackage -> PackagesPreference -> [PackageConstraint] @@ -195,7 +194,7 @@ where versionPref pkgname = - fromMaybe AnyVersion (Map.lookup pkgname versionPrefs) + fromMaybe anyVersion (Map.lookup pkgname versionPrefs) versionPrefs = Map.fromList [ (pkgname, pref) | PackageVersionPreference pkgname pref <- prefs ] @@ -217,7 +216,7 @@ -- | Given the list of installed packages and available packages, figure -- out which packages can be upgraded. -- -upgradableDependencies :: PackageIndex InstalledPackageInfo +upgradableDependencies :: PackageIndex InstalledPackage -> PackageIndex AvailablePackage -> [Dependency] upgradableDependencies installed available = diff --git a/Distribution/Client/Dependency/Bogus.hs b/Distribution/Client/Dependency/Bogus.hs --- a/Distribution/Client/Dependency/Bogus.hs +++ b/Distribution/Client/Dependency/Bogus.hs @@ -29,16 +29,14 @@ ( GenericPackageDescription(..), CondTree(..), FlagAssignment ) import Distribution.PackageDescription.Configuration ( finalizePackageDescription ) -import qualified Distribution.Simple.PackageIndex as PackageIndex -import Distribution.Simple.PackageIndex (PackageIndex) +import qualified Distribution.Client.PackageIndex as PackageIndex +import Distribution.Client.PackageIndex (PackageIndex) import Distribution.Version - ( VersionRange(AnyVersion, IntersectVersionRanges), withinRange ) + ( VersionRange, anyVersion, intersectVersionRanges, withinRange ) import Distribution.Simple.Utils ( comparing ) import Distribution.Text ( display ) -import Distribution.System - ( Platform(Platform) ) import Data.List ( maximumBy ) @@ -52,7 +50,7 @@ -- We just pretend that everything is installed and hope for the best. -- bogusResolver :: DependencyResolver -bogusResolver (Platform arch os) comp _ available +bogusResolver platform comp _ available preferences constraints targets = resolveFromAvailable [] (combineConstraints preferences constraints targets) @@ -62,7 +60,7 @@ case latestAvailableSatisfying available name verConstraint verPref of Nothing -> Fail ("Unresolved dependency: " ++ display dep) Just apkg@(AvailablePackage _ pkg _) -> - case finalizePackageDescription flags none os arch comp [] pkg of + case finalizePackageDescription flags none platform comp [] pkg of Right (_, flags') -> Step msg (resolveFromAvailable chosen' deps) where msg = "selecting " ++ display (packageId pkg) @@ -70,8 +68,8 @@ chosen' = InstallPlan.Configured cpkg : chosen _ -> error "bogusResolver: impossible happened" where - none :: Maybe (PackageIndex PackageIdentifier) - none = Nothing + none :: Dependency -> Bool + none = const True where dep = Dependency name verConstraint @@ -104,11 +102,11 @@ combineConstraints preferences constraints targets = [ (name, ver, flags, pref) | name <- targets - , let ver = fromMaybe AnyVersion (Map.lookup name versionConstraints) + , let ver = fromMaybe anyVersion (Map.lookup name versionConstraints) flags = fromMaybe [] (Map.lookup name flagsConstraints) PackagePreferences pref _ = preferences name ] where - versionConstraints = Map.fromListWith IntersectVersionRanges + versionConstraints = Map.fromListWith intersectVersionRanges [ (name, versionRange) | PackageVersionConstraint name versionRange <- constraints ] diff --git a/Distribution/Client/Dependency/TopDown.hs b/Distribution/Client/Dependency/TopDown.hs --- a/Distribution/Client/Dependency/TopDown.hs +++ b/Distribution/Client/Dependency/TopDown.hs @@ -22,16 +22,14 @@ import Distribution.Client.InstallPlan ( PlanPackage(..) ) import Distribution.Client.Types - ( AvailablePackage(..), ConfiguredPackage(..) ) + ( AvailablePackage(..), ConfiguredPackage(..), InstalledPackage(..) ) import Distribution.Client.Dependency.Types ( DependencyResolver, PackageConstraint(..) , PackagePreferences(..), InstalledPreference(..) , Progress(..), foldProgress ) -import qualified Distribution.Simple.PackageIndex as PackageIndex -import Distribution.Simple.PackageIndex (PackageIndex) -import Distribution.InstalledPackageInfo - ( InstalledPackageInfo ) +import qualified Distribution.Client.PackageIndex as PackageIndex +import Distribution.Client.PackageIndex (PackageIndex) import Distribution.Package ( PackageName(..), PackageIdentifier, Package(packageId), packageVersion, packageName , Dependency(Dependency), thisPackageVersion, notThisPackageVersion @@ -41,13 +39,12 @@ import Distribution.PackageDescription.Configuration ( finalizePackageDescription, flattenPackageDescription ) import Distribution.Version - ( VersionRange(AnyVersion), withinRange ) -import Distribution.Compat.Version - ( asVersionIntervals, UpperBound(..), simplifyVersionRange ) + ( VersionRange, anyVersion, withinRange, simplifyVersionRange + , UpperBound(..), asVersionIntervals ) import Distribution.Compiler ( CompilerId ) import Distribution.System - ( Platform(Platform) ) + ( Platform ) import Distribution.Simple.Utils ( equating, comparing ) import Distribution.Text @@ -74,7 +71,7 @@ -- ------------------------------------------------------------ type Constraints = Constraints.Constraints - InstalledPackage UnconfiguredPackage ExclusionReason + InstalledPackageEx UnconfiguredPackage ExclusionReason type SelectedPackages = PackageIndex SelectedPackage -- ------------------------------------------------------------ @@ -106,7 +103,7 @@ (_, node') = maximumBy (bestByPref pkgname) choice where topSortNumber choice = case fst (head choice) of - InstalledOnly (InstalledPackage _ i _) -> i + InstalledOnly (InstalledPackageEx _ i _) -> i AvailableOnly (UnconfiguredPackage _ i _) -> i InstalledAndAvailable _ (UnconfiguredPackage _ i _) -> i @@ -187,7 +184,7 @@ preferAvailable (InstalledOnly pkg) = Left pkg preferAvailable (AvailableOnly pkg) = Right pkg preferAvailable (InstalledAndAvailable _ pkg) = Right pkg - installedConstraints (InstalledPackage _ _ deps) = + installedConstraints (InstalledPackageEx _ _ deps) = [ TaggedDependency InstalledConstraint (thisPackageVersion dep) | dep <- deps ] availableConstraints (SemiConfiguredPackage _ _ deps) = @@ -235,7 +232,7 @@ -- | The native resolver with detailed structured logging and failure types. -- topDownResolver' :: Platform -> CompilerId - -> PackageIndex InstalledPackageInfo + -> PackageIndex InstalledPackage -> PackageIndex AvailablePackage -> (PackageName -> PackagePreferences) -> [PackageConstraint] @@ -249,6 +246,7 @@ where configure = configurePackage platform comp + constraintSet :: Constraints constraintSet = Constraints.empty (annotateInstalledPackages topSortNumber installed') (annotateAvailablePackages constraints topSortNumber available') @@ -292,29 +290,32 @@ Fail (TopLevelInstallConstraintConflict pkg conflicts) configurePackage :: Platform -> CompilerId -> ConfigurePackage -configurePackage (Platform arch os) comp available spkg = case spkg of +configurePackage platform comp available spkg = case spkg of InstalledOnly ipkg -> Right (InstalledOnly ipkg) AvailableOnly apkg -> fmap AvailableOnly (configure apkg) InstalledAndAvailable ipkg apkg -> fmap (InstalledAndAvailable ipkg) (configure apkg) where configure (UnconfiguredPackage apkg@(AvailablePackage _ p _) _ flags) = - case finalizePackageDescription flags (Just available) os arch comp [] p of + case finalizePackageDescription flags dependencySatisfiable + platform comp [] p of Left missing -> Left missing Right (pkg, flags') -> Right $ SemiConfiguredPackage apkg flags' (buildDepends pkg) + dependencySatisfiable = not . null . PackageIndex.lookupDependency available + -- | Annotate each installed packages with its set of transative dependencies -- and its topological sort number. -- annotateInstalledPackages :: (PackageName -> TopologicalSortNumber) - -> PackageIndex InstalledPackageInfo -> PackageIndex InstalledPackage + -> PackageIndex InstalledPackageEx annotateInstalledPackages dfsNumber installed = PackageIndex.fromList - [ InstalledPackage pkg (dfsNumber (packageName pkg)) (transitiveDepends pkg) + [ InstalledPackageEx pkg (dfsNumber (packageName pkg)) (transitiveDepends pkg) | pkg <- PackageIndex.allPackages installed ] where - transitiveDepends :: InstalledPackageInfo -> [PackageIdentifier] + transitiveDepends :: InstalledPackage -> [PackageIdentifier] transitiveDepends = map (packageId . toPkg) . tail . Graph.reachable graph . fromJust . toVertex . packageId (graph, toPkg, toVertex) = PackageIndex.dependencyGraph installed @@ -356,7 +357,7 @@ -- edges and even cycles, but that doesn't really matter here, it's only a -- heuristic. -- -topologicalSortNumbering :: PackageIndex InstalledPackageInfo +topologicalSortNumbering :: PackageIndex InstalledPackage -> PackageIndex AvailablePackage -> (PackageName -> TopologicalSortNumber) topologicalSortNumbering installed available = @@ -383,17 +384,17 @@ -- each index that we could possibly ever need. Do this by flattening packages -- and looking at the names of all possible dependencies. -- -selectNeededSubset :: PackageIndex InstalledPackageInfo +selectNeededSubset :: PackageIndex InstalledPackage -> PackageIndex AvailablePackage -> Set PackageName - -> (PackageIndex InstalledPackageInfo + -> (PackageIndex InstalledPackage ,PackageIndex AvailablePackage) selectNeededSubset installed available = select mempty mempty where - select :: PackageIndex InstalledPackageInfo + select :: PackageIndex InstalledPackage -> PackageIndex AvailablePackage -> Set PackageName - -> (PackageIndex InstalledPackageInfo + -> (PackageIndex InstalledPackage ,PackageIndex AvailablePackage) select installed' available' remaining | Set.null remaining = (installed', available') @@ -440,7 +441,7 @@ Just (InstalledOnly _) -> finaliseInstalled ipkg Just (InstalledAndAvailable _ _) -> finaliseAvailable (Just ipkg) apkg - finaliseInstalled (InstalledPackage pkg _ _) = InstallPlan.PreExisting pkg + finaliseInstalled (InstalledPackageEx pkg _ _) = InstallPlan.PreExisting pkg finaliseAvailable mipkg (SemiConfiguredPackage pkg flags deps) = InstallPlan.Configured (ConfiguredPackage pkg flags deps') where @@ -460,7 +461,7 @@ -- Is the package already used by the installed version of this -- package? If so we should pick that first. This stops us from doing -- silly things like deciding to rebuild haskell98 against base 3. - isCurrent = case mipkg :: Maybe InstalledPackage of + isCurrent = case mipkg :: Maybe InstalledPackageEx of Nothing -> \_ -> False Just ipkg -> \p -> packageId p `elem` depends ipkg -- If there is no upper bound on the version range then we apply a @@ -492,7 +493,7 @@ -- This may add additional constraints due to the dependencies of installed -- packages on other installed packages. -- -improvePlan :: PackageIndex InstalledPackageInfo +improvePlan :: PackageIndex InstalledPackage -> Constraints -> PackageIndex PlanPackage -> (PackageIndex PlanPackage, Constraints) @@ -519,7 +520,7 @@ _ -> False tryInstalled :: PackageIndex PlanPackage -> Constraints - -> [InstalledPackageInfo] + -> [InstalledPackage] -> Maybe (PackageIndex PlanPackage, Constraints) tryInstalled selected constraints [] = Just (selected, constraints) tryInstalled selected constraints (pkg:pkgs) = @@ -600,7 +601,7 @@ addTopLevelInstalledConstraint pkg constraints = Constraints.constrain taggedDep reason constraints where - dep = Dependency pkg AnyVersion + dep = Dependency pkg anyVersion taggedDep = TaggedDependency InstalledConstraint dep reason = ExcludedByTopLevelDependency dep diff --git a/Distribution/Client/Dependency/TopDown/Constraints.hs b/Distribution/Client/Dependency/TopDown/Constraints.hs --- a/Distribution/Client/Dependency/TopDown/Constraints.hs +++ b/Distribution/Client/Dependency/TopDown/Constraints.hs @@ -22,8 +22,8 @@ ) where import Distribution.Client.Dependency.TopDown.Types -import qualified Distribution.Simple.PackageIndex as PackageIndex -import Distribution.Simple.PackageIndex (PackageIndex) +import qualified Distribution.Client.PackageIndex as PackageIndex +import Distribution.Client.PackageIndex (PackageIndex) import Distribution.Package ( PackageName, PackageIdentifier(..) , Package(packageId), packageName, packageVersion diff --git a/Distribution/Client/Dependency/TopDown/Types.hs b/Distribution/Client/Dependency/TopDown/Types.hs --- a/Distribution/Client/Dependency/TopDown/Types.hs +++ b/Distribution/Client/Dependency/TopDown/Types.hs @@ -13,9 +13,8 @@ module Distribution.Client.Dependency.TopDown.Types where import Distribution.Client.Types - ( AvailablePackage(..) ) + ( AvailablePackage(..), InstalledPackage ) -import Distribution.InstalledPackageInfo (InstalledPackageInfo) import Distribution.Package ( PackageIdentifier, Dependency , Package(packageId), PackageFixedDeps(depends) ) @@ -27,10 +26,10 @@ -- ------------------------------------------------------------ type SelectablePackage - = InstalledOrAvailable InstalledPackage UnconfiguredPackage + = InstalledOrAvailable InstalledPackageEx UnconfiguredPackage type SelectedPackage - = InstalledOrAvailable InstalledPackage SemiConfiguredPackage + = InstalledOrAvailable InstalledPackageEx SemiConfiguredPackage data InstalledOrAvailable installed available = InstalledOnly installed @@ -39,11 +38,11 @@ type TopologicalSortNumber = Int -data InstalledPackage - = InstalledPackage - InstalledPackageInfo +data InstalledPackageEx + = InstalledPackageEx + InstalledPackage !TopologicalSortNumber - [PackageIdentifier] + [PackageIdentifier] -- transative closure of installed deps data UnconfiguredPackage = UnconfiguredPackage @@ -58,11 +57,11 @@ [Dependency] -- dependencies we end up with when we apply -- the flag assignment -instance Package InstalledPackage where - packageId (InstalledPackage p _ _) = packageId p +instance Package InstalledPackageEx where + packageId (InstalledPackageEx p _ _) = packageId p -instance PackageFixedDeps InstalledPackage where - depends (InstalledPackage _ _ deps) = deps +instance PackageFixedDeps InstalledPackageEx where + depends (InstalledPackageEx _ _ deps) = deps instance Package UnconfiguredPackage where packageId (UnconfiguredPackage p _ _) = packageId p diff --git a/Distribution/Client/Dependency/Types.hs b/Distribution/Client/Dependency/Types.hs --- a/Distribution/Client/Dependency/Types.hs +++ b/Distribution/Client/Dependency/Types.hs @@ -22,14 +22,12 @@ ) where import Distribution.Client.Types - ( AvailablePackage(..) ) + ( AvailablePackage(..), InstalledPackage ) import qualified Distribution.Client.InstallPlan as InstallPlan -import Distribution.InstalledPackageInfo - ( InstalledPackageInfo ) import Distribution.PackageDescription ( FlagAssignment ) -import Distribution.Simple.PackageIndex +import Distribution.Client.PackageIndex ( PackageIndex ) import Distribution.Package ( PackageName ) @@ -52,7 +50,7 @@ -- type DependencyResolver = Platform -> CompilerId - -> PackageIndex InstalledPackageInfo + -> PackageIndex InstalledPackage -> PackageIndex AvailablePackage -> (PackageName -> PackagePreferences) -> [PackageConstraint] diff --git a/Distribution/Client/Fetch.hs b/Distribution/Client/Fetch.hs --- a/Distribution/Client/Fetch.hs +++ b/Distribution/Client/Fetch.hs @@ -33,24 +33,21 @@ import Distribution.Client.Dependency.Types ( foldProgress ) import Distribution.Client.IndexUtils as IndexUtils - ( getAvailablePackages, disambiguateDependencies ) + ( getAvailablePackages, disambiguateDependencies + , getInstalledPackages ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.HttpUtils (getHTTP, isOldHackageURI) -import Distribution.Client.Utils - ( writeFileAtomic ) import Distribution.Package ( PackageIdentifier, packageName, packageVersion, Dependency(..) ) -import qualified Distribution.Simple.PackageIndex as PackageIndex +import qualified Distribution.Client.PackageIndex as PackageIndex import Distribution.Simple.Compiler - ( Compiler(compilerId), PackageDB ) + ( Compiler(compilerId), PackageDBStack ) import Distribution.Simple.Program ( ProgramConfiguration ) -import Distribution.Simple.Configure - ( getInstalledPackages ) import Distribution.Simple.Utils ( die, notice, info, debug, setupMessage - , copyFileVerbose ) + , copyFileVerbose, writeFileAtomic ) import Distribution.System ( buildPlatform ) import Distribution.Text @@ -59,6 +56,7 @@ ( Verbosity ) import qualified Data.Map as Map +import qualified Data.ByteString.Lazy.Char8 as BS import Control.Monad ( when, filterM ) import System.Directory @@ -89,7 +87,7 @@ Right rsp | rspCode rsp == (2,0,0) -> do info verbosity ("Downloaded to " ++ path) - writeFileAtomic path (rspBody rsp) + writeFileAtomic path (BS.unpack $ rspBody rsp) --FIXME: check the content-length header matches the body length. --TODO: stream the download into the file rather than buffering the whole -- thing in memory. @@ -148,14 +146,14 @@ -- |Fetch a list of packages and their dependencies. fetch :: Verbosity - -> PackageDB + -> PackageDBStack -> [Repo] -> Compiler -> ProgramConfiguration -> [UnresolvedDependency] -> IO () -fetch verbosity packageDB repos comp conf deps = do - installed <- getInstalledPackages verbosity comp packageDB conf +fetch verbosity packageDBs repos comp conf deps = do + installed <- getInstalledPackages verbosity comp packageDBs conf AvailablePackageDb available availablePrefs <- getAvailablePackages verbosity repos deps' <- IndexUtils.disambiguateDependencies available deps @@ -223,7 +221,6 @@ (remoteRepoURI repo) { uriPath = FilePath.Posix.joinPath [uriPath (remoteRepoURI repo) - ,"packages" - ,display pkgid - ,"tarball"] + ,"package" + ,display pkgid <.> "tar.gz"] } diff --git a/Distribution/Client/Haddock.hs b/Distribution/Client/Haddock.hs new file mode 100644 --- /dev/null +++ b/Distribution/Client/Haddock.hs @@ -0,0 +1,101 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Client.Haddock +-- Copyright : (c) Andrea Vezzosi 2009 +-- License : BSD-like +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Interfacing with Haddock +-- +----------------------------------------------------------------------------- +module Distribution.Client.Haddock + ( + regenerateHaddockIndex + ) + where + +import Data.Maybe (Maybe(..), listToMaybe) +import Data.List (maximumBy) +import Control.Monad (Monad(return), sequence, guard) +import System.Directory (createDirectoryIfMissing, doesFileExist, + renameFile) +import System.FilePath (FilePath, (), splitFileName) +import Distribution.Package (Package(..)) +import Distribution.Simple.Program (haddockProgram, ProgramConfiguration + , rawSystemProgram, requireProgramVersion) +import Distribution.Version (Version(Version), orLaterVersion) +import Distribution.Verbosity (Verbosity) +import Distribution.Text (display) +import Distribution.Client.PackageIndex(PackageIndex, allPackages, + allPackagesByName, fromList) +import Distribution.Simple.Utils + ( comparing, intercalate, debug + , installDirectoryContents, withTempDirectory ) +import Distribution.InstalledPackageInfo as InstalledPackageInfo + ( InstalledPackageInfo + , InstalledPackageInfo_(haddockHTMLs, haddockInterfaces, exposed) ) +import Distribution.Client.Types + ( InstalledPackage(..) ) + +regenerateHaddockIndex :: Verbosity -> PackageIndex InstalledPackage -> ProgramConfiguration -> FilePath -> IO () +regenerateHaddockIndex verbosity pkgs conf index = do + (paths,warns) <- haddockPackagePaths pkgs' + case warns of + Nothing -> return () + Just m -> debug verbosity m + + (confHaddock, _, _) <- + requireProgramVersion verbosity haddockProgram + (orLaterVersion (Version [0,6] [])) conf + + createDirectoryIfMissing True destDir + + withTempDirectory verbosity destDir "htemp" $ \tempDir -> do + + let flags = ["--gen-contents", "--gen-index", "--odir="++tempDir] + ++ map (\(i,h) -> "--read-interface=" ++ h ++ "," ++ i) paths + rawSystemProgram verbosity confHaddock flags + renameFile (tempDir "index.html") (tempDir destFile) + installDirectoryContents verbosity tempDir destDir + + where + (destDir,destFile) = splitFileName index + pkgs' = map (maximumBy $ comparing packageId) + . allPackagesByName + . fromList + . filter exposed + . map (\(InstalledPackage pkg _) -> pkg) + . allPackages + $ pkgs + +haddockPackagePaths :: [InstalledPackageInfo] + -> IO ([(FilePath, FilePath)], Maybe [Char]) +haddockPackagePaths pkgs = do + interfaces <- sequence + [ case interfaceAndHtmlPath pkg of + Just (interface, html) -> do + exists <- doesFileExist interface + if exists + then return (pkgid, Just (interface, html)) + else return (pkgid, Nothing) + Nothing -> return (pkgid, Nothing) + | pkg <- pkgs, let pkgid = packageId pkg ] + + let missing = [ pkgid | (pkgid, Nothing) <- interfaces ] + + warning = "The documentation for the following packages are not " + ++ "installed. No links will be generated to these packages: " + ++ intercalate ", " (map display missing) + + flags = [ x | (_, Just x) <- interfaces ] + + return (flags, if null missing then Nothing else Just warning) + + where + interfaceAndHtmlPath pkg = do + interface <- listToMaybe (InstalledPackageInfo.haddockInterfaces pkg) + html <- listToMaybe (InstalledPackageInfo.haddockHTMLs pkg) + guard (not . null $ html) + return (interface, html) diff --git a/Distribution/Client/HttpUtils.hs b/Distribution/Client/HttpUtils.hs --- a/Distribution/Client/HttpUtils.hs +++ b/Distribution/Client/HttpUtils.hs @@ -24,7 +24,9 @@ ( hKEY_CURRENT_USER, regOpenKey, regCloseKey , regQueryValue, regQueryValueEx ) import Control.Exception - ( handle, bracket ) + ( bracket ) +import Distribution.Compat.Exception + ( handleIO ) import Foreign ( toBool, Storable(peek, sizeOf), castPtr, alloca ) #endif @@ -46,7 +48,7 @@ proxyString, envProxyString, registryProxyString :: IO (Maybe String) #ifdef WIN32 -- read proxy settings from the windows registry -registryProxyString = handle (\_ -> return Nothing) $ +registryProxyString = handleIO (\_ -> return Nothing) $ bracket (regOpenKey hive path) regCloseKey $ \hkey -> do enable <- fmap toBool $ regQueryValueDWORD hkey "ProxyEnable" if enable diff --git a/Distribution/Client/IndexUtils.hs b/Distribution/Client/IndexUtils.hs --- a/Distribution/Client/IndexUtils.hs +++ b/Distribution/Client/IndexUtils.hs @@ -11,6 +11,7 @@ -- Extra utils related to the package indexes. ----------------------------------------------------------------------------- module Distribution.Client.IndexUtils ( + getInstalledPackages, getAvailablePackages, readPackageIndexFile, @@ -24,21 +25,29 @@ import Distribution.Client.Types ( UnresolvedDependency(..), AvailablePackage(..) , AvailablePackageSource(..), Repo(..), RemoteRepo(..) - , AvailablePackageDb(..) ) + , AvailablePackageDb(..), InstalledPackage(..) ) import Distribution.Package ( PackageId, PackageIdentifier(..), PackageName(..), Package(..) - , Dependency(Dependency) ) -import Distribution.Simple.PackageIndex (PackageIndex) -import qualified Distribution.Simple.PackageIndex as PackageIndex + , Dependency(Dependency), InstalledPackageId(..) ) +import Distribution.Client.PackageIndex (PackageIndex) +import qualified Distribution.Client.PackageIndex as PackageIndex +import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex +import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo import Distribution.PackageDescription ( GenericPackageDescription ) import Distribution.PackageDescription.Parse ( parsePackageDescription ) +import Distribution.Simple.Compiler + ( Compiler, PackageDBStack ) +import Distribution.Simple.Program + ( ProgramConfiguration ) +import qualified Distribution.Simple.Configure as Configure + ( getInstalledPackages ) import Distribution.ParseUtils ( ParseResult(..) ) import Distribution.Version - ( VersionRange(IntersectVersionRanges) ) + ( Version(Version), intersectVersionRanges ) import Distribution.Text ( display, simpleParse ) import Distribution.Verbosity (Verbosity) @@ -63,6 +72,40 @@ import System.Time ( getClockTime, diffClockTimes, normalizeTimeDiff, TimeDiff(tdDay) ) +getInstalledPackages :: Verbosity -> Compiler + -> PackageDBStack -> ProgramConfiguration + -> IO (Maybe (PackageIndex InstalledPackage)) +getInstalledPackages verbosity comp packageDbs conf = + fmap (fmap convert) + (Configure.getInstalledPackages verbosity comp packageDbs conf) + where + convert :: InstalledPackageIndex.PackageIndex -> PackageIndex InstalledPackage + convert index = PackageIndex.fromList $ + reverse -- because later ones mask earlier ones, but + -- InstalledPackageIndex.allPackages gives us the most preferred + -- instances first, when packages share a package id, like when + -- the same package is installed in the global & user dbs. + [ InstalledPackage ipkg (sourceDeps index ipkg) + | ipkg <- InstalledPackageIndex.allPackages index ] + + -- The InstalledPackageInfo only lists dependencies by the + -- InstalledPackageId, which means we do not directly know the corresponding + -- source dependency. The only way to find out is to lookup the + -- InstalledPackageId to get the InstalledPackageInfo and look at its + -- source PackageId. But if the package is broken because it depends on + -- other packages that do not exist then we have a problem we cannot find + -- the original source package id. Instead we make up a bogus package id. + -- This should have the same effect since it should be a dependency on a + -- non-existant package. + sourceDeps index ipkg = + [ maybe (brokenPackageId depid) packageId mdep + | let depids = InstalledPackageInfo.depends ipkg + getpkg = InstalledPackageIndex.lookupInstalledPackageId index + , (depid, mdep) <- zip depids (map getpkg depids) ] + + brokenPackageId (InstalledPackageId str) = + PackageIdentifier (PackageName (str ++ "-broken")) (Version [] []) + -- | Read a repository index from disk, from the local files specified by -- a list of 'Repo's. -- @@ -83,7 +126,7 @@ info verbosity "Reading available packages..." pkgss <- mapM (readRepoIndex verbosity) repos let (pkgs, prefs) = mconcat pkgss - prefs' = Map.fromListWith IntersectVersionRanges + prefs' = Map.fromListWith intersectVersionRanges [ (name, range) | Dependency name range <- prefs ] evaluate pkgs evaluate prefs' diff --git a/Distribution/Client/Init.hs b/Distribution/Client/Init.hs new file mode 100644 --- /dev/null +++ b/Distribution/Client/Init.hs @@ -0,0 +1,571 @@ +{-# LANGUAGE CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Client.Init +-- Copyright : (c) Brent Yorgey 2009 +-- License : BSD-like +-- +-- Maintainer : cabal-devel@haskell.org +-- Stability : provisional +-- Portability : portable +-- +-- Implementation of the 'cabal init' command, which creates an initial .cabal +-- file for a project. +-- +----------------------------------------------------------------------------- + +module Distribution.Client.Init ( + + -- * Commands + initCabal + + ) where + +import System.IO + ( hSetBuffering, stdout, BufferMode(..) ) +import System.Directory + ( getCurrentDirectory ) +import Data.Time + ( getCurrentTime, utcToLocalTime, toGregorian, localDay, getCurrentTimeZone ) + +import Data.List + ( intersperse ) +import Data.Maybe + ( fromMaybe, isJust ) +import Data.Traversable + ( traverse ) +import Control.Monad + ( when ) +#if MIN_VERSION_base(3,0,0) +import Control.Monad + ( (>=>) ) +#endif + +import Text.PrettyPrint.HughesPJ hiding (mode, cat) + +import Data.Version + ( Version(..) ) +import Distribution.Version + ( orLaterVersion ) + +import Distribution.Client.Init.Types + ( InitFlags(..), PackageType(..), Category(..), Stability(..) ) +import Distribution.Client.Init.Licenses + ( bsd3, gplv2, gplv3, lgpl2, lgpl3 ) +import Distribution.Client.Init.Heuristics + ( guessPackageName, guessAuthorNameMail, SourceFileEntry(..), scanForModules, neededBuildPrograms ) + +import Distribution.License + ( License(..), knownLicenses ) +import Distribution.ModuleName + ( ) -- for the Text instance + +import Distribution.ReadE + ( runReadE, readP_to_E ) +import Distribution.Simple.Setup + ( Flag(..), flagToMaybe ) +import Distribution.Text + ( display, Text(..) ) + +initCabal :: InitFlags -> IO () +initCabal initFlags = do + hSetBuffering stdout NoBuffering + + initFlags' <- extendFlags initFlags + + writeLicense initFlags' + writeSetupFile initFlags' + success <- writeCabalFile initFlags' + + when success $ generateWarnings initFlags' + +--------------------------------------------------------------------------- +-- Flag acquisition ----------------------------------------------------- +--------------------------------------------------------------------------- + +-- | Fill in more details by guessing, discovering, or prompting the +-- user. +extendFlags :: InitFlags -> IO InitFlags +extendFlags = getPackageName + >=> getVersion + >=> getLicense + >=> getAuthorInfo + >=> getHomepage + >=> getSynopsis + >=> getStability + >=> getCategory + >=> getLibOrExec + >=> getSrcDir + >=> getModulesAndBuildTools + +-- | Combine two actions which may return a value, preferring the first. That +-- is, run the second action only if the first doesn't return a value. +infixr 1 ?>> +(?>>) :: IO (Maybe a) -> IO (Maybe a) -> IO (Maybe a) +f ?>> g = do + ma <- f + if isJust ma + then return ma + else g + +-- | Witness the isomorphism between Maybe and Flag. +maybeToFlag :: Maybe a -> Flag a +maybeToFlag = maybe NoFlag Flag + +-- | Get the package name: use the package directory (supplied, or the current +-- directory by default) as a guess. +getPackageName :: InitFlags -> IO InitFlags +getPackageName flags = do + guess <- traverse guessPackageName (flagToMaybe $ packageDir flags) + ?>> Just `fmap` (getCurrentDirectory >>= guessPackageName) + + pkgName' <- return (flagToMaybe $ packageName flags) + ?>> maybePrompt flags (promptStr "Package name" guess) + ?>> return guess + + return $ flags { packageName = maybeToFlag pkgName' } + +-- | Package version: use 0.1 as a last resort, but try prompting the user if +-- possible. +getVersion :: InitFlags -> IO InitFlags +getVersion flags = do + let v = Just $ Version { versionBranch = [0,1], versionTags = [] } + v' <- return (flagToMaybe $ version flags) + ?>> maybePrompt flags (prompt "Package version" v) + ?>> return v + return $ flags { version = maybeToFlag v' } + +-- | Choose a license. +getLicense :: InitFlags -> IO InitFlags +getLicense flags = do + lic <- return (flagToMaybe $ license flags) + ?>> fmap (fmap (either UnknownLicense id)) + (maybePrompt flags + (promptList "Please choose a license" + knownLicenses (Just BSD3) True)) + return $ flags { license = maybeToFlag lic } + +-- | The author's name and email. Prompt, or try to guess from an existing +-- darcs repo. +getAuthorInfo :: InitFlags -> IO InitFlags +getAuthorInfo flags = do + (authorName, authorEmail) <- (\(a,e) -> (flagToMaybe a, flagToMaybe e)) `fmap` guessAuthorNameMail + authorName' <- return (flagToMaybe $ author flags) + ?>> maybePrompt flags (promptStr "Author name" authorName) + ?>> return authorName + + authorEmail' <- return (flagToMaybe $ email flags) + ?>> maybePrompt flags (promptStr "Maintainer email" authorEmail) + ?>> return authorEmail + + return $ flags { author = maybeToFlag authorName' + , email = maybeToFlag authorEmail' + } + +-- | Prompt for a homepage URL. +getHomepage :: InitFlags -> IO InitFlags +getHomepage flags = do + hp <- queryHomepage + hp' <- return (flagToMaybe $ homepage flags) + ?>> maybePrompt flags (promptStr "Project homepage/repo URL" hp) + ?>> return hp + + return $ flags { homepage = maybeToFlag hp' } + +-- | Right now this does nothing, but it could be changed to do some +-- intelligent guessing. +queryHomepage :: IO (Maybe String) +queryHomepage = return Nothing -- get default remote darcs repo? + +-- | Prompt for a project synopsis. +getSynopsis :: InitFlags -> IO InitFlags +getSynopsis flags = do + syn <- return (flagToMaybe $ synopsis flags) + ?>> maybePrompt flags (promptStr "Project synopsis" Nothing) + + return $ flags { synopsis = maybeToFlag syn } + +getStability :: InitFlags -> IO InitFlags +getStability flags = do + stab <- return (flagToMaybe $ stability flags) + ?>> maybePrompt flags (promptList "Project stability" [Stable ..] + (Just Experimental) + True) + + return $ flags { stability = maybeToFlag stab } + +-- | Prompt for a package category. +-- Note that it should be possible to do some smarter guessing here too, i.e. +-- look at the name of the top level source directory. +getCategory :: InitFlags -> IO InitFlags +getCategory flags = do + cat <- return (flagToMaybe $ category flags) + ?>> maybePrompt flags (promptList "Project category" [Codec ..] + Nothing True) + return $ flags { category = maybeToFlag cat } + +-- | Ask whether the project builds a library or executable. +getLibOrExec :: InitFlags -> IO InitFlags +getLibOrExec flags = do + isLib <- return (flagToMaybe $ packageType flags) + ?>> maybePrompt flags (either (const Library) id `fmap` + (promptList "What does the package build" + [Library, Executable] + Nothing False)) + ?>> return (Just Library) + + return $ flags { packageType = maybeToFlag isLib } + +-- | Try to guess the source root directory (don't prompt the user). +getSrcDir :: InitFlags -> IO InitFlags +getSrcDir flags = do + srcDirs <- return (sourceDirs flags) + ?>> guessSourceDirs + + return $ flags { sourceDirs = srcDirs } + +-- XXX +-- | Try to guess source directories. +guessSourceDirs :: IO (Maybe [String]) +guessSourceDirs = return Nothing + +-- | Get the list of exposed modules and extra tools needed to build them. +getModulesAndBuildTools :: InitFlags -> IO InitFlags +getModulesAndBuildTools flags = do + dir <- fromMaybe getCurrentDirectory + (fmap return . flagToMaybe $ packageDir flags) + + -- XXX really should use guessed source roots. + sourceFiles <- scanForModules dir + + mods <- return (exposedModules flags) + ?>> (return . Just . map moduleName $ sourceFiles) + + tools <- return (buildTools flags) + ?>> (return . Just . neededBuildPrograms $ sourceFiles) + + return $ flags { exposedModules = mods + , buildTools = tools } + +--------------------------------------------------------------------------- +-- Prompting/user interaction ------------------------------------------- +--------------------------------------------------------------------------- + +-- | Run a prompt or not based on the nonInteractive flag of the +-- InitFlags structure. +maybePrompt :: InitFlags -> IO t -> IO (Maybe t) +maybePrompt flags p = + case nonInteractive flags of + Flag True -> return Nothing + _ -> Just `fmap` p + +-- | Create a prompt with optional default value that returns a +-- String. +promptStr :: String -> Maybe String -> IO String +promptStr = promptDefault' Just id + +-- | Create a prompt with optional default value that returns a value +-- of some Text instance. +prompt :: Text t => String -> Maybe t -> IO t +prompt = promptDefault' + (either (const Nothing) Just . runReadE (readP_to_E id parse)) + display + +-- | Create a prompt with an optional default value. +promptDefault' :: (String -> Maybe t) -- ^ parser + -> (t -> String) -- ^ pretty-printer + -> String -- ^ prompt message + -> Maybe t -- ^ optional default value + -> IO t +promptDefault' parser pretty pr def = do + putStr $ mkDefPrompt pr (pretty `fmap` def) + inp <- getLine + case (inp, def) of + ("", Just d) -> return d + _ -> case parser inp of + Just t -> return t + Nothing -> do putStrLn $ "Couldn't parse " ++ inp ++ ", please try again!" + promptDefault' parser pretty pr def + +-- | Create a prompt from a prompt string and a String representation +-- of an optional default value. +mkDefPrompt :: String -> Maybe String -> String +mkDefPrompt pr def = pr ++ defStr def ++ "? " + where defStr Nothing = "" + defStr (Just s) = " [default \"" ++ s ++ "\"]" + +-- | Create a prompt from a list of items. +promptList :: (Text t, Eq t) + => String -- ^ prompt + -> [t] -- ^ choices + -> Maybe t -- ^ optional default value + -> Bool -- ^ whether to allow an 'other' option + -> IO (Either String t) +promptList pr choices def other = do + putStrLn $ pr ++ ":" + let options1 = map (\c -> (Just c == def, display c)) choices + options2 = zip ([1..]::[Int]) + (options1 ++ if other then [(False, "Other (specify)")] + else []) + mapM_ (putStrLn . \(n,(i,s)) -> showOption n i ++ s) options2 + promptList' (length options2) choices def other + where showOption n i | n < 10 = " " ++ star i ++ " " ++ rest + | otherwise = " " ++ star i ++ rest + where rest = show n ++ ") " + star True = "*" + star False = " " + +promptList' :: Text t => Int -> [t] -> Maybe t -> Bool -> IO (Either String t) +promptList' numChoices choices def other = do + putStr $ mkDefPrompt "Your choice" (display `fmap` def) + inp <- getLine + case (inp, def) of + ("", Just d) -> return $ Right d + _ -> case readMaybe inp of + Nothing -> invalidChoice inp + Just n -> getChoice n + where invalidChoice inp = do putStrLn $ inp ++ " is not a valid choice." + promptList' numChoices choices def other + getChoice n | n < 1 || n > numChoices = invalidChoice (show n) + | n < numChoices || + (n == numChoices && not other) + = return . Right $ choices !! (n-1) + | otherwise = Left `fmap` promptStr "Please specify" Nothing + +readMaybe :: (Read a) => String -> Maybe a +readMaybe s = case reads s of + [(a,"")] -> Just a + _ -> Nothing + +--------------------------------------------------------------------------- +-- File generation ------------------------------------------------------ +--------------------------------------------------------------------------- + +writeLicense :: InitFlags -> IO () +writeLicense flags = do + message flags "Generating LICENSE..." + year <- getYear + let licenseFile = + case license flags of + Flag BSD3 -> Just $ bsd3 (fromMaybe "???" + . flagToMaybe + . author + $ flags) + (show year) + + Flag (GPL (Just (Version {versionBranch = [2]}))) + -> Just gplv2 + + Flag (GPL (Just (Version {versionBranch = [3]}))) + -> Just gplv3 + + Flag (LGPL (Just (Version {versionBranch = [2]}))) + -> Just lgpl2 + + Flag (LGPL (Just (Version {versionBranch = [3]}))) + -> Just lgpl3 + + _ -> Nothing + + case licenseFile of + Just licenseText -> writeFile "LICENSE" licenseText + Nothing -> message flags "Warning: unknown license type, you must put a copy in LICENSE yourself." + +getYear :: IO Integer +getYear = do + u <- getCurrentTime + z <- getCurrentTimeZone + let l = utcToLocalTime z u + (y, _, _) = toGregorian $ localDay l + return y + +writeSetupFile :: InitFlags -> IO () +writeSetupFile flags = do + message flags "Generating Setup.hs..." + writeFile "Setup.hs" setupFile + where + setupFile = unlines + [ "#!/usr/bin/env runhaskell" + , "import Distribution.Simple" + , "main = defaultMain" + ] + +writeCabalFile :: InitFlags -> IO Bool +writeCabalFile flags@(InitFlags{packageName = NoFlag}) = do + message flags "Error: no package name provided." + return False +writeCabalFile flags@(InitFlags{packageName = Flag p}) = do + let cabalFileName = p ++ ".cabal" + message flags $ "Generating " ++ cabalFileName ++ "..." + writeFile cabalFileName (generateCabalFile cabalFileName flags) + return True + +-- | Generate a .cabal file from an InitFlags structure. NOTE: this +-- is rather ad-hoc! What we would REALLY like is to have a +-- standard low-level AST type representing .cabal files, which +-- preserves things like comments, and to write an *inverse* +-- parser/pretty-printer pair between .cabal files and this AST. +-- Then instead of this ad-hoc code we could just map an InitFlags +-- structure onto a low-level AST structure and use the existing +-- pretty-printing code to generate the file. +generateCabalFile :: String -> InitFlags -> String +generateCabalFile fileName c = render $ + (if (minimal c /= Flag True) + then showComment (Just $ fileName ++ " auto-generated by cabal init. For additional options, see http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.") + else empty) + $$ + vcat [ fieldS "Name" (packageName c) + (Just "The name of the package.") + True + + , field "Version" (version c) + (Just "The package version. See the Haskell package versioning policy (http://www.haskell.org/haskellwiki/Package_versioning_policy) for standards guiding when and how versions should be incremented.") + True + + , fieldS "Synopsis" (synopsis c) + (Just "A short (one-line) description of the package.") + True + + , fieldS "Description" NoFlag + (Just "A longer description of the package.") + True + + , fieldS "Homepage" (homepage c) + (Just "URL for the project homepage or repository.") + False + + , fieldS "Bug-reports" NoFlag + (Just "A URL where users can report bugs.") + False + + , field "License" (license c) + (Just "The license under which the package is released.") + True + + , fieldS "License-file" (Flag "LICENSE") + (Just "The file containing the license text.") + True + + , fieldS "Author" (author c) + (Just "The package author(s).") + True + + , fieldS "Maintainer" (email c) + (Just "An email address to which users can send suggestions, bug reports, and patches.") + True + + , fieldS "Copyright" NoFlag + (Just "A copyright notice.") + True + + , fieldS "Stability" (either id display `fmap` stability c) + (Just "Stability of the pakcage (experimental, provisional, stable...)") + True + + , fieldS "Category" (either id display `fmap` category c) + Nothing + True + + , fieldS "Build-type" (Flag "Simple") + Nothing + True + + , fieldS "Extra-source-files" NoFlag + (Just "Extra files to be distributed with the package, such as examples or a README.") + True + + , field "Cabal-version" (Flag $ orLaterVersion (Version [1,2] [])) + (Just "Constraint on the version of Cabal needed to build this package.") + False + + , case packageType c of + Flag Executable -> + text "\nExecutable" <+> text (fromMaybe "" . flagToMaybe $ packageName c) $$ (nest 2 $ vcat + [ fieldS "Main-is" NoFlag (Just ".hs or .lhs file containing the Main module.") True + + , generateBuildInfo c + ]) + Flag Library -> text "\nLibrary" $$ (nest 2 $ vcat + [ fieldS "Exposed-modules" (listField (exposedModules c)) + (Just "Modules exported by the library.") + True + + , generateBuildInfo c + ]) + _ -> empty + ] + where + generateBuildInfo :: InitFlags -> Doc + generateBuildInfo c' = vcat + [ fieldS "Build-depends" (listField (dependencies c')) + (Just "Packages needed in order to build this package.") + True + + , fieldS "Other-modules" (listField (otherModules c')) + (Just "Modules not exported by this package.") + True + + , fieldS "hs-source-dirs" (listFieldS (sourceDirs c')) + (Just "Directories other than the root containing source files.") + False + + , fieldS "Build-tools" (listFieldS (buildTools c')) + (Just "Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.") + True + ] + + listField :: Text s => Maybe [s] -> Flag String + listField = listFieldS . fmap (map display) + + listFieldS :: Maybe [String] -> Flag String + listFieldS = Flag . maybe "" (concat . intersperse ", ") + + field :: Text t => String -> Flag t -> Maybe String -> Bool -> Doc + field s f = fieldS s (fmap display f) + + fieldS :: String -- ^ Name of the field + -> Flag String -- ^ Field contents + -> Maybe String -- ^ Comment to explain the field + -> Bool -- ^ Should the field be included (commented out) even if blank? + -> Doc + fieldS _ NoFlag _ inc | not inc || (minimal c == Flag True) = empty + fieldS _ (Flag "") _ inc | not inc || (minimal c == Flag True) = empty + fieldS s f com _ = case (isJust com, noComments c, minimal c) of + (_, _, Flag True) -> id + (_, Flag True, _) -> id + (True, _, _) -> (showComment com $$) . ($$ text "") + (False, _, _) -> ($$ text "") + $ + comment f <> text s <> colon + <> text (take (20 - length s) (repeat ' ')) + <> text (fromMaybe "" . flagToMaybe $ f) + comment NoFlag = text "-- " + comment (Flag "") = text "-- " + comment _ = text "" + + showComment :: Maybe String -> Doc + showComment (Just t) = vcat . map text + . map ("-- "++) . lines + . render . fsep . map text . words $ t + showComment Nothing = text "" + +-- | Generate warnings for missing fields etc. +generateWarnings :: InitFlags -> IO () +generateWarnings flags = do + message flags "" + when (synopsis flags `elem` [NoFlag, Flag ""]) + (message flags "Warning: no synopsis given. You should edit the .cabal file and add one.") + + message flags "You may want to edit the .cabal file and add a Description field." + +-- | Possibly generate a message to stdout, taking into account the +-- --quiet flag. +message :: InitFlags -> String -> IO () +message (InitFlags{quiet = Flag True}) _ = return () +message _ s = putStrLn s + +#if MIN_VERSION_base(3,0,0) +#else +(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c) +f >=> g = \x -> f x >>= g +#endif diff --git a/Distribution/Client/Init/Heuristics.hs b/Distribution/Client/Init/Heuristics.hs new file mode 100644 --- /dev/null +++ b/Distribution/Client/Init/Heuristics.hs @@ -0,0 +1,187 @@ +{-# LANGUAGE CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Client.Init.Heuristics +-- Copyright : (c) Benedikt Huber 2009 +-- License : BSD-like +-- +-- Maintainer : cabal-devel@haskell.org +-- Stability : provisional +-- Portability : portable +-- +-- Heuristics for creating initial cabal files. +-- +----------------------------------------------------------------------------- +module Distribution.Client.Init.Heuristics ( + guessPackageName, + scanForModules, SourceFileEntry(..), + neededBuildPrograms, + guessAuthorNameMail, + knownCategories, +) where +import Distribution.Simple.Setup(Flag(..)) +import Distribution.ModuleName ( ModuleName, fromString ) +import Distribution.Client.PackageIndex + ( allPackagesByName ) +import qualified Distribution.PackageDescription as PD + ( category, packageDescription ) +import Distribution.Simple.Utils + ( intercalate ) + +import Distribution.Client.Types ( packageDescription, AvailablePackageDb(..) ) +import Control.Monad (liftM ) +import Data.Char ( isUpper, isLower, isSpace ) +#if MIN_VERSION_base(3,0,3) +import Data.Either ( partitionEithers ) +#endif +import Data.Maybe ( catMaybes ) +import Data.Monoid ( mempty, mappend ) +import qualified Data.Set as Set ( fromList, toList ) +import System.Directory ( getDirectoryContents, doesDirectoryExist, doesFileExist, + getHomeDirectory, canonicalizePath ) +import System.Environment ( getEnvironment ) +import System.FilePath ( takeExtension, takeBaseName, dropExtension, + (), splitDirectories, makeRelative ) + +-- |Guess the package name based on the given root directory +guessPackageName :: FilePath -> IO String +guessPackageName = liftM (last . splitDirectories) . canonicalizePath + +-- |Data type of source files found in the working directory +data SourceFileEntry = SourceFileEntry + { relativeSourcePath :: FilePath + , moduleName :: ModuleName + , fileExtension :: String + } deriving Show + +-- |Search for source files in the given directory +-- and return pairs of guessed haskell source path and +-- module names. +scanForModules :: FilePath -> IO [SourceFileEntry] +scanForModules rootDir = scanForModulesIn rootDir rootDir + +scanForModulesIn :: FilePath -> FilePath -> IO [SourceFileEntry] +scanForModulesIn projectRoot srcRoot = scan srcRoot [] + where + scan dir hierarchy = do + entries <- getDirectoryContents (projectRoot dir) + (files, dirs) <- liftM partitionEithers (mapM (tagIsDir dir) entries) + let modules = catMaybes [ guessModuleName hierarchy file | file <- files ] + recMods <- mapM (scanRecursive dir hierarchy) dirs + return $ concat (modules : recMods) + tagIsDir parent entry = do + isDir <- doesDirectoryExist (parent entry) + return $ (if isDir then Right else Left) entry + guessModuleName hierarchy entry + | takeBaseName entry == "Setup" = Nothing + | ext `elem` sourceExtensions = Just $ SourceFileEntry relRoot modName ext + | otherwise = Nothing + where + relRoot = makeRelative projectRoot srcRoot + unqualModName = dropExtension entry + modName = fromString $ intercalate "." . reverse $ (unqualModName : hierarchy) + 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" = + scanForModulesIn projectRoot $ foldl () srcRoot (entry : hierarchy) + | otherwise = return [] + +-- Unfortunately we cannot use the version exported by Distribution.Simple.Program +knownSuffixHandlers :: [(String,String)] +knownSuffixHandlers = + [ ("gc", "greencard") + , ("chs", "chs") + , ("hsc", "hsc2hs") + , ("x", "alex") + , ("y", "happy") + , ("ly", "happy") + , ("cpphs", "cpp") + ] + +sourceExtensions :: [String] +sourceExtensions = "hs" : "lhs" : map fst knownSuffixHandlers + +neededBuildPrograms :: [SourceFileEntry] -> [String] +neededBuildPrograms entries = + [ handler + | ext <- nubSet (map fileExtension entries) + , handler <- maybe [] (:[]) (lookup ext knownSuffixHandlers) + ] + +-- |Guess author and email +guessAuthorNameMail :: IO (Flag String, Flag String) +guessAuthorNameMail = + update (readFromFile authorRepoFile) mempty >>= + update (getAuthorHome >>= readFromFile) >>= + update readFromEnvironment + where + update _ info@(Flag _, Flag _) = return info + update extract info = liftM (`mappend` info) extract -- prefer info + readFromFile file = do + exists <- doesFileExist file + if exists then liftM nameAndMail (readFile file) else return mempty + readFromEnvironment = fmap extractFromEnvironment getEnvironment + extractFromEnvironment env = + let darcsEmailEnv = maybe mempty nameAndMail (lookup "DARCS_EMAIL" env) + emailEnv = maybe mempty (\e -> (mempty, Flag e)) (lookup "EMAIL" env) + in darcsEmailEnv `mappend` emailEnv + getAuthorHome = liftM ( (".darcs" "author")) getHomeDirectory + authorRepoFile = "_darcs" "prefs" "author" + +-- |Get list of categories used in hackage. NOTE: Very slow, needs to be cached +knownCategories :: AvailablePackageDb -> [String] +knownCategories (AvailablePackageDb available _) = nubSet $ + [ cat | pkg <- map head (allPackagesByName available) + , let catList = (PD.category . PD.packageDescription . packageDescription) pkg + , cat <- splitString ',' catList + ] + +-- Parse name and email, from darcs pref files or environment variable +nameAndMail :: String -> (Flag String, Flag String) +nameAndMail str + | all isSpace nameOrEmail = mempty + | null erest = (mempty, Flag $ trim nameOrEmail) + | otherwise = (Flag $ trim nameOrEmail, Flag email) + where + (nameOrEmail,erest) = break (== '<') str + (email,_) = break (== '>') (tail erest) + trim = removeLeadingSpace . reverse . removeLeadingSpace . reverse + removeLeadingSpace = dropWhile isSpace + +-- split string at given character, and remove whitespaces +splitString :: Char -> String -> [String] +splitString sep str = go str where + go s = if null s' then [] else tok : go rest where + s' = dropWhile (\c -> c == sep || isSpace c) s + (tok,rest) = break (==sep) s' + +nubSet :: (Ord a) => [a] -> [a] +nubSet = Set.toList . Set.fromList + +{- +test db testProjectRoot = do + putStrLn "Guessed package name" + (guessPackageName >=> print) testProjectRoot + putStrLn "Guessed name and email" + guessAuthorNameMail >>= print + + mods <- scanForModules testProjectRoot + + putStrLn "Guessed modules" + mapM_ print mods + putStrLn "Needed build programs" + print (neededBuildPrograms mods) + + putStrLn "List of known categories" + print $ knownCategories db +-} + +#if MIN_VERSION_base(3,0,3) +#else +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) +#endif diff --git a/Distribution/Client/Init/Licenses.hs b/Distribution/Client/Init/Licenses.hs new file mode 100644 --- /dev/null +++ b/Distribution/Client/Init/Licenses.hs @@ -0,0 +1,1722 @@ +module Distribution.Client.Init.Licenses + ( License + , bsd3 + , gplv2 + , gplv3 + , lgpl2 + , lgpl3 + + ) where + +type License = String + +bsd3 :: String -> String -> License +bsd3 s y = unlines + [ "Copyright " ++ s ++ " " ++ y + , "" + , "All rights reserved." + , "" + , "Redistribution and use in source and binary forms, with or without" + , "modification, are permitted provided that the following conditions are met:" + , "" + , " * Redistributions of source code must retain the above copyright" + , " notice, this list of conditions and the following disclaimer." + , "" + , " * Redistributions in binary form must reproduce the above" + , " copyright notice, this list of conditions and the following" + , " disclaimer in the documentation and/or other materials provided" + , " with the distribution." + , "" + , " * Neither the name of " ++ s ++ " nor the names of other" + , " contributors may be used to endorse or promote products derived" + , " from this software without specific prior written permission." + , "" + , "THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS" + , "\"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT" + , "LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR" + , "A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT" + , "OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL," + , "SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT" + , "LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE," + , "DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY" + , "THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT" + , "(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE" + , "OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE." + ] + +gplv2 :: License +gplv2 = unlines + [ " GNU GENERAL PUBLIC LICENSE" + , " Version 2, June 1991" + , "" + , " Copyright (C) 1989, 1991 Free Software Foundation, Inc.," + , " 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA" + , " Everyone is permitted to copy and distribute verbatim copies" + , " of this license document, but changing it is not allowed." + , "" + , " Preamble" + , "" + , " The licenses for most software are designed to take away your" + , "freedom to share and change it. By contrast, the GNU General Public" + , "License is intended to guarantee your freedom to share and change free" + , "software--to make sure the software is free for all its users. This" + , "General Public License applies to most of the Free Software" + , "Foundation's software and to any other program whose authors commit to" + , "using it. (Some other Free Software Foundation software is covered by" + , "the GNU Lesser General Public License instead.) You can apply it to" + , "your programs, too." + , "" + , " When we speak of free software, we are referring to freedom, not" + , "price. Our General Public Licenses are designed to make sure that you" + , "have the freedom to distribute copies of free software (and charge for" + , "this service if you wish), that you receive source code or can get it" + , "if you want it, that you can change the software or use pieces of it" + , "in new free programs; and that you know you can do these things." + , "" + , " To protect your rights, we need to make restrictions that forbid" + , "anyone to deny you these rights or to ask you to surrender the rights." + , "These restrictions translate to certain responsibilities for you if you" + , "distribute copies of the software, or if you modify it." + , "" + , " For example, if you distribute copies of such a program, whether" + , "gratis or for a fee, you must give the recipients all the rights that" + , "you have. You must make sure that they, too, receive or can get the" + , "source code. And you must show them these terms so they know their" + , "rights." + , "" + , " We protect your rights with two steps: (1) copyright the software, and" + , "(2) offer you this license which gives you legal permission to copy," + , "distribute and/or modify the software." + , "" + , " Also, for each author's protection and ours, we want to make certain" + , "that everyone understands that there is no warranty for this free" + , "software. If the software is modified by someone else and passed on, we" + , "want its recipients to know that what they have is not the original, so" + , "that any problems introduced by others will not reflect on the original" + , "authors' reputations." + , "" + , " Finally, any free program is threatened constantly by software" + , "patents. We wish to avoid the danger that redistributors of a free" + , "program will individually obtain patent licenses, in effect making the" + , "program proprietary. To prevent this, we have made it clear that any" + , "patent must be licensed for everyone's free use or not licensed at all." + , "" + , " The precise terms and conditions for copying, distribution and" + , "modification follow." + , "" + , " GNU GENERAL PUBLIC LICENSE" + , " TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION" + , "" + , " 0. This License applies to any program or other work which contains" + , "a notice placed by the copyright holder saying it may be distributed" + , "under the terms of this General Public License. The \"Program\", below," + , "refers to any such program or work, and a \"work based on the Program\"" + , "means either the Program or any derivative work under copyright law:" + , "that is to say, a work containing the Program or a portion of it," + , "either verbatim or with modifications and/or translated into another" + , "language. (Hereinafter, translation is included without limitation in" + , "the term \"modification\".) Each licensee is addressed as \"you\"." + , "" + , "Activities other than copying, distribution and modification are not" + , "covered by this License; they are outside its scope. The act of" + , "running the Program is not restricted, and the output from the Program" + , "is covered only if its contents constitute a work based on the" + , "Program (independent of having been made by running the Program)." + , "Whether that is true depends on what the Program does." + , "" + , " 1. You may copy and distribute verbatim copies of the Program's" + , "source code as you receive it, in any medium, provided that you" + , "conspicuously and appropriately publish on each copy an appropriate" + , "copyright notice and disclaimer of warranty; keep intact all the" + , "notices that refer to this License and to the absence of any warranty;" + , "and give any other recipients of the Program a copy of this License" + , "along with the Program." + , "" + , "You may charge a fee for the physical act of transferring a copy, and" + , "you may at your option offer warranty protection in exchange for a fee." + , "" + , " 2. You may modify your copy or copies of the Program or any portion" + , "of it, thus forming a work based on the Program, and copy and" + , "distribute such modifications or work under the terms of Section 1" + , "above, provided that you also meet all of these conditions:" + , "" + , " a) You must cause the modified files to carry prominent notices" + , " stating that you changed the files and the date of any change." + , "" + , " b) You must cause any work that you distribute or publish, that in" + , " whole or in part contains or is derived from the Program or any" + , " part thereof, to be licensed as a whole at no charge to all third" + , " parties under the terms of this License." + , "" + , " c) If the modified program normally reads commands interactively" + , " when run, you must cause it, when started running for such" + , " interactive use in the most ordinary way, to print or display an" + , " announcement including an appropriate copyright notice and a" + , " notice that there is no warranty (or else, saying that you provide" + , " a warranty) and that users may redistribute the program under" + , " these conditions, and telling the user how to view a copy of this" + , " License. (Exception: if the Program itself is interactive but" + , " does not normally print such an announcement, your work based on" + , " the Program is not required to print an announcement.)" + , "" + , "These requirements apply to the modified work as a whole. If" + , "identifiable sections of that work are not derived from the Program," + , "and can be reasonably considered independent and separate works in" + , "themselves, then this License, and its terms, do not apply to those" + , "sections when you distribute them as separate works. But when you" + , "distribute the same sections as part of a whole which is a work based" + , "on the Program, the distribution of the whole must be on the terms of" + , "this License, whose permissions for other licensees extend to the" + , "entire whole, and thus to each and every part regardless of who wrote it." + , "" + , "Thus, it is not the intent of this section to claim rights or contest" + , "your rights to work written entirely by you; rather, the intent is to" + , "exercise the right to control the distribution of derivative or" + , "collective works based on the Program." + , "" + , "In addition, mere aggregation of another work not based on the Program" + , "with the Program (or with a work based on the Program) on a volume of" + , "a storage or distribution medium does not bring the other work under" + , "the scope of this License." + , "" + , " 3. You may copy and distribute the Program (or a work based on it," + , "under Section 2) in object code or executable form under the terms of" + , "Sections 1 and 2 above provided that you also do one of the following:" + , "" + , " a) Accompany it with the complete corresponding machine-readable" + , " source code, which must be distributed under the terms of Sections" + , " 1 and 2 above on a medium customarily used for software interchange; or," + , "" + , " b) Accompany it with a written offer, valid for at least three" + , " years, to give any third party, for a charge no more than your" + , " cost of physically performing source distribution, a complete" + , " machine-readable copy of the corresponding source code, to be" + , " distributed under the terms of Sections 1 and 2 above on a medium" + , " customarily used for software interchange; or," + , "" + , " c) Accompany it with the information you received as to the offer" + , " to distribute corresponding source code. (This alternative is" + , " allowed only for noncommercial distribution and only if you" + , " received the program in object code or executable form with such" + , " an offer, in accord with Subsection b above.)" + , "" + , "The source code for a work means the preferred form of the work for" + , "making modifications to it. For an executable work, complete source" + , "code means all the source code for all modules it contains, plus any" + , "associated interface definition files, plus the scripts used to" + , "control compilation and installation of the executable. However, as a" + , "special exception, the source code distributed need not include" + , "anything that is normally distributed (in either source or binary" + , "form) with the major components (compiler, kernel, and so on) of the" + , "operating system on which the executable runs, unless that component" + , "itself accompanies the executable." + , "" + , "If distribution of executable or object code is made by offering" + , "access to copy from a designated place, then offering equivalent" + , "access to copy the source code from the same place counts as" + , "distribution of the source code, even though third parties are not" + , "compelled to copy the source along with the object code." + , "" + , " 4. You may not copy, modify, sublicense, or distribute the Program" + , "except as expressly provided under this License. Any attempt" + , "otherwise to copy, modify, sublicense or distribute the Program is" + , "void, and will automatically terminate your rights under this License." + , "However, parties who have received copies, or rights, from you under" + , "this License will not have their licenses terminated so long as such" + , "parties remain in full compliance." + , "" + , " 5. You are not required to accept this License, since you have not" + , "signed it. However, nothing else grants you permission to modify or" + , "distribute the Program or its derivative works. These actions are" + , "prohibited by law if you do not accept this License. Therefore, by" + , "modifying or distributing the Program (or any work based on the" + , "Program), you indicate your acceptance of this License to do so, and" + , "all its terms and conditions for copying, distributing or modifying" + , "the Program or works based on it." + , "" + , " 6. Each time you redistribute the Program (or any work based on the" + , "Program), the recipient automatically receives a license from the" + , "original licensor to copy, distribute or modify the Program subject to" + , "these terms and conditions. You may not impose any further" + , "restrictions on the recipients' exercise of the rights granted herein." + , "You are not responsible for enforcing compliance by third parties to" + , "this License." + , "" + , " 7. If, as a consequence of a court judgment or allegation of patent" + , "infringement or for any other reason (not limited to patent issues)," + , "conditions are imposed on you (whether by court order, agreement or" + , "otherwise) that contradict the conditions of this License, they do not" + , "excuse you from the conditions of this License. If you cannot" + , "distribute so as to satisfy simultaneously your obligations under this" + , "License and any other pertinent obligations, then as a consequence you" + , "may not distribute the Program at all. For example, if a patent" + , "license would not permit royalty-free redistribution of the Program by" + , "all those who receive copies directly or indirectly through you, then" + , "the only way you could satisfy both it and this License would be to" + , "refrain entirely from distribution of the Program." + , "" + , "If any portion of this section is held invalid or unenforceable under" + , "any particular circumstance, the balance of the section is intended to" + , "apply and the section as a whole is intended to apply in other" + , "circumstances." + , "" + , "It is not the purpose of this section to induce you to infringe any" + , "patents or other property right claims or to contest validity of any" + , "such claims; this section has the sole purpose of protecting the" + , "integrity of the free software distribution system, which is" + , "implemented by public license practices. Many people have made" + , "generous contributions to the wide range of software distributed" + , "through that system in reliance on consistent application of that" + , "system; it is up to the author/donor to decide if he or she is willing" + , "to distribute software through any other system and a licensee cannot" + , "impose that choice." + , "" + , "This section is intended to make thoroughly clear what is believed to" + , "be a consequence of the rest of this License." + , "" + , " 8. If the distribution and/or use of the Program is restricted in" + , "certain countries either by patents or by copyrighted interfaces, the" + , "original copyright holder who places the Program under this License" + , "may add an explicit geographical distribution limitation excluding" + , "those countries, so that distribution is permitted only in or among" + , "countries not thus excluded. In such case, this License incorporates" + , "the limitation as if written in the body of this License." + , "" + , " 9. The Free Software Foundation may publish revised and/or new versions" + , "of the General Public License from time to time. Such new versions will" + , "be similar in spirit to the present version, but may differ in detail to" + , "address new problems or concerns." + , "" + , "Each version is given a distinguishing version number. If the Program" + , "specifies a version number of this License which applies to it and \"any" + , "later version\", you have the option of following the terms and conditions" + , "either of that version or of any later version published by the Free" + , "Software Foundation. If the Program does not specify a version number of" + , "this License, you may choose any version ever published by the Free Software" + , "Foundation." + , "" + , " 10. If you wish to incorporate parts of the Program into other free" + , "programs whose distribution conditions are different, write to the author" + , "to ask for permission. For software which is copyrighted by the Free" + , "Software Foundation, write to the Free Software Foundation; we sometimes" + , "make exceptions for this. Our decision will be guided by the two goals" + , "of preserving the free status of all derivatives of our free software and" + , "of promoting the sharing and reuse of software generally." + , "" + , " NO WARRANTY" + , "" + , " 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY" + , "FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN" + , "OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES" + , "PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED" + , "OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF" + , "MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS" + , "TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE" + , "PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING," + , "REPAIR OR CORRECTION." + , "" + , " 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING" + , "WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR" + , "REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES," + , "INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING" + , "OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED" + , "TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY" + , "YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER" + , "PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE" + , "POSSIBILITY OF SUCH DAMAGES." + , "" + , " END OF TERMS AND CONDITIONS" + , "" + , " How to Apply These Terms to Your New Programs" + , "" + , " If you develop a new program, and you want it to be of the greatest" + , "possible use to the public, the best way to achieve this is to make it" + , "free software which everyone can redistribute and change under these terms." + , "" + , " To do so, attach the following notices to the program. It is safest" + , "to attach them to the start of each source file to most effectively" + , "convey the exclusion of warranty; and each file should have at least" + , "the \"copyright\" line and a pointer to where the full notice is found." + , "" + , " " + , " Copyright (C) " + , "" + , " This program is free software; you can redistribute it and/or modify" + , " it under the terms of the GNU General Public License as published by" + , " the Free Software Foundation; either version 2 of the License, or" + , " (at your option) any later version." + , "" + , " This program is distributed in the hope that it will be useful," + , " but WITHOUT ANY WARRANTY; without even the implied warranty of" + , " MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the" + , " GNU General Public License for more details." + , "" + , " You should have received a copy of the GNU General Public License along" + , " with this program; if not, write to the Free Software Foundation, Inc.," + , " 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA." + , "" + , "Also add information on how to contact you by electronic and paper mail." + , "" + , "If the program is interactive, make it output a short notice like this" + , "when it starts in an interactive mode:" + , "" + , " Gnomovision version 69, Copyright (C) year name of author" + , " Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'." + , " This is free software, and you are welcome to redistribute it" + , " under certain conditions; type `show c' for details." + , "" + , "The hypothetical commands `show w' and `show c' should show the appropriate" + , "parts of the General Public License. Of course, the commands you use may" + , "be called something other than `show w' and `show c'; they could even be" + , "mouse-clicks or menu items--whatever suits your program." + , "" + , "You should also get your employer (if you work as a programmer) or your" + , "school, if any, to sign a \"copyright disclaimer\" for the program, if" + , "necessary. Here is a sample; alter the names:" + , "" + , " Yoyodyne, Inc., hereby disclaims all copyright interest in the program" + , " `Gnomovision' (which makes passes at compilers) written by James Hacker." + , "" + , " , 1 April 1989" + , " Ty Coon, President of Vice" + , "" + , "This General Public License does not permit incorporating your program into" + , "proprietary programs. If your program is a subroutine library, you may" + , "consider it more useful to permit linking proprietary applications with the" + , "library. If this is what you want to do, use the GNU Lesser General" + , "Public License instead of this License." + ] + +gplv3 :: License +gplv3 = unlines + [ " GNU GENERAL PUBLIC LICENSE" + , " Version 3, 29 June 2007" + , "" + , " Copyright (C) 2007 Free Software Foundation, Inc. " + , " Everyone is permitted to copy and distribute verbatim copies" + , " of this license document, but changing it is not allowed." + , "" + , " Preamble" + , "" + , " The GNU General Public License is a free, copyleft license for" + , "software and other kinds of works." + , "" + , " The licenses for most software and other practical works are designed" + , "to take away your freedom to share and change the works. By contrast," + , "the GNU General Public License is intended to guarantee your freedom to" + , "share and change all versions of a program--to make sure it remains free" + , "software for all its users. We, the Free Software Foundation, use the" + , "GNU General Public License for most of our software; it applies also to" + , "any other work released this way by its authors. You can apply it to" + , "your programs, too." + , "" + , " When we speak of free software, we are referring to freedom, not" + , "price. Our General Public Licenses are designed to make sure that you" + , "have the freedom to distribute copies of free software (and charge for" + , "them if you wish), that you receive source code or can get it if you" + , "want it, that you can change the software or use pieces of it in new" + , "free programs, and that you know you can do these things." + , "" + , " To protect your rights, we need to prevent others from denying you" + , "these rights or asking you to surrender the rights. Therefore, you have" + , "certain responsibilities if you distribute copies of the software, or if" + , "you modify it: responsibilities to respect the freedom of others." + , "" + , " For example, if you distribute copies of such a program, whether" + , "gratis or for a fee, you must pass on to the recipients the same" + , "freedoms that you received. You must make sure that they, too, receive" + , "or can get the source code. And you must show them these terms so they" + , "know their rights." + , "" + , " Developers that use the GNU GPL protect your rights with two steps:" + , "(1) assert copyright on the software, and (2) offer you this License" + , "giving you legal permission to copy, distribute and/or modify it." + , "" + , " For the developers' and authors' protection, the GPL clearly explains" + , "that there is no warranty for this free software. For both users' and" + , "authors' sake, the GPL requires that modified versions be marked as" + , "changed, so that their problems will not be attributed erroneously to" + , "authors of previous versions." + , "" + , " Some devices are designed to deny users access to install or run" + , "modified versions of the software inside them, although the manufacturer" + , "can do so. This is fundamentally incompatible with the aim of" + , "protecting users' freedom to change the software. The systematic" + , "pattern of such abuse occurs in the area of products for individuals to" + , "use, which is precisely where it is most unacceptable. Therefore, we" + , "have designed this version of the GPL to prohibit the practice for those" + , "products. If such problems arise substantially in other domains, we" + , "stand ready to extend this provision to those domains in future versions" + , "of the GPL, as needed to protect the freedom of users." + , "" + , " Finally, every program is threatened constantly by software patents." + , "States should not allow patents to restrict development and use of" + , "software on general-purpose computers, but in those that do, we wish to" + , "avoid the special danger that patents applied to a free program could" + , "make it effectively proprietary. To prevent this, the GPL assures that" + , "patents cannot be used to render the program non-free." + , "" + , " The precise terms and conditions for copying, distribution and" + , "modification follow." + , "" + , " TERMS AND CONDITIONS" + , "" + , " 0. Definitions." + , "" + , " \"This License\" refers to version 3 of the GNU General Public License." + , "" + , " \"Copyright\" also means copyright-like laws that apply to other kinds of" + , "works, such as semiconductor masks." + , " " + , " \"The Program\" refers to any copyrightable work licensed under this" + , "License. Each licensee is addressed as \"you\". \"Licensees\" and" + , "\"recipients\" may be individuals or organizations." + , "" + , " To \"modify\" a work means to copy from or adapt all or part of the work" + , "in a fashion requiring copyright permission, other than the making of an" + , "exact copy. The resulting work is called a \"modified version\" of the" + , "earlier work or a work \"based on\" the earlier work." + , "" + , " A \"covered work\" means either the unmodified Program or a work based" + , "on the Program." + , "" + , " To \"propagate\" a work means to do anything with it that, without" + , "permission, would make you directly or secondarily liable for" + , "infringement under applicable copyright law, except executing it on a" + , "computer or modifying a private copy. Propagation includes copying," + , "distribution (with or without modification), making available to the" + , "public, and in some countries other activities as well." + , "" + , " To \"convey\" a work means any kind of propagation that enables other" + , "parties to make or receive copies. Mere interaction with a user through" + , "a computer network, with no transfer of a copy, is not conveying." + , "" + , " An interactive user interface displays \"Appropriate Legal Notices\"" + , "to the extent that it includes a convenient and prominently visible" + , "feature that (1) displays an appropriate copyright notice, and (2)" + , "tells the user that there is no warranty for the work (except to the" + , "extent that warranties are provided), that licensees may convey the" + , "work under this License, and how to view a copy of this License. If" + , "the interface presents a list of user commands or options, such as a" + , "menu, a prominent item in the list meets this criterion." + , "" + , " 1. Source Code." + , "" + , " The \"source code\" for a work means the preferred form of the work" + , "for making modifications to it. \"Object code\" means any non-source" + , "form of a work." + , "" + , " A \"Standard Interface\" means an interface that either is an official" + , "standard defined by a recognized standards body, or, in the case of" + , "interfaces specified for a particular programming language, one that" + , "is widely used among developers working in that language." + , "" + , " The \"System Libraries\" of an executable work include anything, other" + , "than the work as a whole, that (a) is included in the normal form of" + , "packaging a Major Component, but which is not part of that Major" + , "Component, and (b) serves only to enable use of the work with that" + , "Major Component, or to implement a Standard Interface for which an" + , "implementation is available to the public in source code form. A" + , "\"Major Component\", in this context, means a major essential component" + , "(kernel, window system, and so on) of the specific operating system" + , "(if any) on which the executable work runs, or a compiler used to" + , "produce the work, or an object code interpreter used to run it." + , "" + , " The \"Corresponding Source\" for a work in object code form means all" + , "the source code needed to generate, install, and (for an executable" + , "work) run the object code and to modify the work, including scripts to" + , "control those activities. However, it does not include the work's" + , "System Libraries, or general-purpose tools or generally available free" + , "programs which are used unmodified in performing those activities but" + , "which are not part of the work. For example, Corresponding Source" + , "includes interface definition files associated with source files for" + , "the work, and the source code for shared libraries and dynamically" + , "linked subprograms that the work is specifically designed to require," + , "such as by intimate data communication or control flow between those" + , "subprograms and other parts of the work." + , "" + , " The Corresponding Source need not include anything that users" + , "can regenerate automatically from other parts of the Corresponding" + , "Source." + , "" + , " The Corresponding Source for a work in source code form is that" + , "same work." + , "" + , " 2. Basic Permissions." + , "" + , " All rights granted under this License are granted for the term of" + , "copyright on the Program, and are irrevocable provided the stated" + , "conditions are met. This License explicitly affirms your unlimited" + , "permission to run the unmodified Program. The output from running a" + , "covered work is covered by this License only if the output, given its" + , "content, constitutes a covered work. This License acknowledges your" + , "rights of fair use or other equivalent, as provided by copyright law." + , "" + , " You may make, run and propagate covered works that you do not" + , "convey, without conditions so long as your license otherwise remains" + , "in force. You may convey covered works to others for the sole purpose" + , "of having them make modifications exclusively for you, or provide you" + , "with facilities for running those works, provided that you comply with" + , "the terms of this License in conveying all material for which you do" + , "not control copyright. Those thus making or running the covered works" + , "for you must do so exclusively on your behalf, under your direction" + , "and control, on terms that prohibit them from making any copies of" + , "your copyrighted material outside their relationship with you." + , "" + , " Conveying under any other circumstances is permitted solely under" + , "the conditions stated below. Sublicensing is not allowed; section 10" + , "makes it unnecessary." + , "" + , " 3. Protecting Users' Legal Rights From Anti-Circumvention Law." + , "" + , " No covered work shall be deemed part of an effective technological" + , "measure under any applicable law fulfilling obligations under article" + , "11 of the WIPO copyright treaty adopted on 20 December 1996, or" + , "similar laws prohibiting or restricting circumvention of such" + , "measures." + , "" + , " When you convey a covered work, you waive any legal power to forbid" + , "circumvention of technological measures to the extent such circumvention" + , "is effected by exercising rights under this License with respect to" + , "the covered work, and you disclaim any intention to limit operation or" + , "modification of the work as a means of enforcing, against the work's" + , "users, your or third parties' legal rights to forbid circumvention of" + , "technological measures." + , "" + , " 4. Conveying Verbatim Copies." + , "" + , " You may convey verbatim copies of the Program's source code as you" + , "receive it, in any medium, provided that you conspicuously and" + , "appropriately publish on each copy an appropriate copyright notice;" + , "keep intact all notices stating that this License and any" + , "non-permissive terms added in accord with section 7 apply to the code;" + , "keep intact all notices of the absence of any warranty; and give all" + , "recipients a copy of this License along with the Program." + , "" + , " You may charge any price or no price for each copy that you convey," + , "and you may offer support or warranty protection for a fee." + , "" + , " 5. Conveying Modified Source Versions." + , "" + , " You may convey a work based on the Program, or the modifications to" + , "produce it from the Program, in the form of source code under the" + , "terms of section 4, provided that you also meet all of these conditions:" + , "" + , " a) The work must carry prominent notices stating that you modified" + , " it, and giving a relevant date." + , "" + , " b) The work must carry prominent notices stating that it is" + , " released under this License and any conditions added under section" + , " 7. This requirement modifies the requirement in section 4 to" + , " \"keep intact all notices\"." + , "" + , " c) You must license the entire work, as a whole, under this" + , " License to anyone who comes into possession of a copy. This" + , " License will therefore apply, along with any applicable section 7" + , " additional terms, to the whole of the work, and all its parts," + , " regardless of how they are packaged. This License gives no" + , " permission to license the work in any other way, but it does not" + , " invalidate such permission if you have separately received it." + , "" + , " d) If the work has interactive user interfaces, each must display" + , " Appropriate Legal Notices; however, if the Program has interactive" + , " interfaces that do not display Appropriate Legal Notices, your" + , " work need not make them do so." + , "" + , " A compilation of a covered work with other separate and independent" + , "works, which are not by their nature extensions of the covered work," + , "and which are not combined with it such as to form a larger program," + , "in or on a volume of a storage or distribution medium, is called an" + , "\"aggregate\" if the compilation and its resulting copyright are not" + , "used to limit the access or legal rights of the compilation's users" + , "beyond what the individual works permit. Inclusion of a covered work" + , "in an aggregate does not cause this License to apply to the other" + , "parts of the aggregate." + , "" + , " 6. Conveying Non-Source Forms." + , "" + , " You may convey a covered work in object code form under the terms" + , "of sections 4 and 5, provided that you also convey the" + , "machine-readable Corresponding Source under the terms of this License," + , "in one of these ways:" + , "" + , " a) Convey the object code in, or embodied in, a physical product" + , " (including a physical distribution medium), accompanied by the" + , " Corresponding Source fixed on a durable physical medium" + , " customarily used for software interchange." + , "" + , " b) Convey the object code in, or embodied in, a physical product" + , " (including a physical distribution medium), accompanied by a" + , " written offer, valid for at least three years and valid for as" + , " long as you offer spare parts or customer support for that product" + , " model, to give anyone who possesses the object code either (1) a" + , " copy of the Corresponding Source for all the software in the" + , " product that is covered by this License, on a durable physical" + , " medium customarily used for software interchange, for a price no" + , " more than your reasonable cost of physically performing this" + , " conveying of source, or (2) access to copy the" + , " Corresponding Source from a network server at no charge." + , "" + , " c) Convey individual copies of the object code with a copy of the" + , " written offer to provide the Corresponding Source. This" + , " alternative is allowed only occasionally and noncommercially, and" + , " only if you received the object code with such an offer, in accord" + , " with subsection 6b." + , "" + , " d) Convey the object code by offering access from a designated" + , " place (gratis or for a charge), and offer equivalent access to the" + , " Corresponding Source in the same way through the same place at no" + , " further charge. You need not require recipients to copy the" + , " Corresponding Source along with the object code. If the place to" + , " copy the object code is a network server, the Corresponding Source" + , " may be on a different server (operated by you or a third party)" + , " that supports equivalent copying facilities, provided you maintain" + , " clear directions next to the object code saying where to find the" + , " Corresponding Source. Regardless of what server hosts the" + , " Corresponding Source, you remain obligated to ensure that it is" + , " available for as long as needed to satisfy these requirements." + , "" + , " e) Convey the object code using peer-to-peer transmission, provided" + , " you inform other peers where the object code and Corresponding" + , " Source of the work are being offered to the general public at no" + , " charge under subsection 6d." + , "" + , " A separable portion of the object code, whose source code is excluded" + , "from the Corresponding Source as a System Library, need not be" + , "included in conveying the object code work." + , "" + , " A \"User Product\" is either (1) a \"consumer product\", which means any" + , "tangible personal property which is normally used for personal, family," + , "or household purposes, or (2) anything designed or sold for incorporation" + , "into a dwelling. In determining whether a product is a consumer product," + , "doubtful cases shall be resolved in favor of coverage. For a particular" + , "product received by a particular user, \"normally used\" refers to a" + , "typical or common use of that class of product, regardless of the status" + , "of the particular user or of the way in which the particular user" + , "actually uses, or expects or is expected to use, the product. A product" + , "is a consumer product regardless of whether the product has substantial" + , "commercial, industrial or non-consumer uses, unless such uses represent" + , "the only significant mode of use of the product." + , "" + , " \"Installation Information\" for a User Product means any methods," + , "procedures, authorization keys, or other information required to install" + , "and execute modified versions of a covered work in that User Product from" + , "a modified version of its Corresponding Source. The information must" + , "suffice to ensure that the continued functioning of the modified object" + , "code is in no case prevented or interfered with solely because" + , "modification has been made." + , "" + , " If you convey an object code work under this section in, or with, or" + , "specifically for use in, a User Product, and the conveying occurs as" + , "part of a transaction in which the right of possession and use of the" + , "User Product is transferred to the recipient in perpetuity or for a" + , "fixed term (regardless of how the transaction is characterized), the" + , "Corresponding Source conveyed under this section must be accompanied" + , "by the Installation Information. But this requirement does not apply" + , "if neither you nor any third party retains the ability to install" + , "modified object code on the User Product (for example, the work has" + , "been installed in ROM)." + , "" + , " The requirement to provide Installation Information does not include a" + , "requirement to continue to provide support service, warranty, or updates" + , "for a work that has been modified or installed by the recipient, or for" + , "the User Product in which it has been modified or installed. Access to a" + , "network may be denied when the modification itself materially and" + , "adversely affects the operation of the network or violates the rules and" + , "protocols for communication across the network." + , "" + , " Corresponding Source conveyed, and Installation Information provided," + , "in accord with this section must be in a format that is publicly" + , "documented (and with an implementation available to the public in" + , "source code form), and must require no special password or key for" + , "unpacking, reading or copying." + , "" + , " 7. Additional Terms." + , "" + , " \"Additional permissions\" are terms that supplement the terms of this" + , "License by making exceptions from one or more of its conditions." + , "Additional permissions that are applicable to the entire Program shall" + , "be treated as though they were included in this License, to the extent" + , "that they are valid under applicable law. If additional permissions" + , "apply only to part of the Program, that part may be used separately" + , "under those permissions, but the entire Program remains governed by" + , "this License without regard to the additional permissions." + , "" + , " When you convey a copy of a covered work, you may at your option" + , "remove any additional permissions from that copy, or from any part of" + , "it. (Additional permissions may be written to require their own" + , "removal in certain cases when you modify the work.) You may place" + , "additional permissions on material, added by you to a covered work," + , "for which you have or can give appropriate copyright permission." + , "" + , " Notwithstanding any other provision of this License, for material you" + , "add to a covered work, you may (if authorized by the copyright holders of" + , "that material) supplement the terms of this License with terms:" + , "" + , " a) Disclaiming warranty or limiting liability differently from the" + , " terms of sections 15 and 16 of this License; or" + , "" + , " b) Requiring preservation of specified reasonable legal notices or" + , " author attributions in that material or in the Appropriate Legal" + , " Notices displayed by works containing it; or" + , "" + , " c) Prohibiting misrepresentation of the origin of that material, or" + , " requiring that modified versions of such material be marked in" + , " reasonable ways as different from the original version; or" + , "" + , " d) Limiting the use for publicity purposes of names of licensors or" + , " authors of the material; or" + , "" + , " e) Declining to grant rights under trademark law for use of some" + , " trade names, trademarks, or service marks; or" + , "" + , " f) Requiring indemnification of licensors and authors of that" + , " material by anyone who conveys the material (or modified versions of" + , " it) with contractual assumptions of liability to the recipient, for" + , " any liability that these contractual assumptions directly impose on" + , " those licensors and authors." + , "" + , " All other non-permissive additional terms are considered \"further" + , "restrictions\" within the meaning of section 10. If the Program as you" + , "received it, or any part of it, contains a notice stating that it is" + , "governed by this License along with a term that is a further" + , "restriction, you may remove that term. If a license document contains" + , "a further restriction but permits relicensing or conveying under this" + , "License, you may add to a covered work material governed by the terms" + , "of that license document, provided that the further restriction does" + , "not survive such relicensing or conveying." + , "" + , " If you add terms to a covered work in accord with this section, you" + , "must place, in the relevant source files, a statement of the" + , "additional terms that apply to those files, or a notice indicating" + , "where to find the applicable terms." + , "" + , " Additional terms, permissive or non-permissive, may be stated in the" + , "form of a separately written license, or stated as exceptions;" + , "the above requirements apply either way." + , "" + , " 8. Termination." + , "" + , " You may not propagate or modify a covered work except as expressly" + , "provided under this License. Any attempt otherwise to propagate or" + , "modify it is void, and will automatically terminate your rights under" + , "this License (including any patent licenses granted under the third" + , "paragraph of section 11)." + , "" + , " However, if you cease all violation of this License, then your" + , "license from a particular copyright holder is reinstated (a)" + , "provisionally, unless and until the copyright holder explicitly and" + , "finally terminates your license, and (b) permanently, if the copyright" + , "holder fails to notify you of the violation by some reasonable means" + , "prior to 60 days after the cessation." + , "" + , " Moreover, your license from a particular copyright holder is" + , "reinstated permanently if the copyright holder notifies you of the" + , "violation by some reasonable means, this is the first time you have" + , "received notice of violation of this License (for any work) from that" + , "copyright holder, and you cure the violation prior to 30 days after" + , "your receipt of the notice." + , "" + , " Termination of your rights under this section does not terminate the" + , "licenses of parties who have received copies or rights from you under" + , "this License. If your rights have been terminated and not permanently" + , "reinstated, you do not qualify to receive new licenses for the same" + , "material under section 10." + , "" + , " 9. Acceptance Not Required for Having Copies." + , "" + , " You are not required to accept this License in order to receive or" + , "run a copy of the Program. Ancillary propagation of a covered work" + , "occurring solely as a consequence of using peer-to-peer transmission" + , "to receive a copy likewise does not require acceptance. However," + , "nothing other than this License grants you permission to propagate or" + , "modify any covered work. These actions infringe copyright if you do" + , "not accept this License. Therefore, by modifying or propagating a" + , "covered work, you indicate your acceptance of this License to do so." + , "" + , " 10. Automatic Licensing of Downstream Recipients." + , "" + , " Each time you convey a covered work, the recipient automatically" + , "receives a license from the original licensors, to run, modify and" + , "propagate that work, subject to this License. You are not responsible" + , "for enforcing compliance by third parties with this License." + , "" + , " An \"entity transaction\" is a transaction transferring control of an" + , "organization, or substantially all assets of one, or subdividing an" + , "organization, or merging organizations. If propagation of a covered" + , "work results from an entity transaction, each party to that" + , "transaction who receives a copy of the work also receives whatever" + , "licenses to the work the party's predecessor in interest had or could" + , "give under the previous paragraph, plus a right to possession of the" + , "Corresponding Source of the work from the predecessor in interest, if" + , "the predecessor has it or can get it with reasonable efforts." + , "" + , " You may not impose any further restrictions on the exercise of the" + , "rights granted or affirmed under this License. For example, you may" + , "not impose a license fee, royalty, or other charge for exercise of" + , "rights granted under this License, and you may not initiate litigation" + , "(including a cross-claim or counterclaim in a lawsuit) alleging that" + , "any patent claim is infringed by making, using, selling, offering for" + , "sale, or importing the Program or any portion of it." + , "" + , " 11. Patents." + , "" + , " A \"contributor\" is a copyright holder who authorizes use under this" + , "License of the Program or a work on which the Program is based. The" + , "work thus licensed is called the contributor's \"contributor version\"." + , "" + , " A contributor's \"essential patent claims\" are all patent claims" + , "owned or controlled by the contributor, whether already acquired or" + , "hereafter acquired, that would be infringed by some manner, permitted" + , "by this License, of making, using, or selling its contributor version," + , "but do not include claims that would be infringed only as a" + , "consequence of further modification of the contributor version. For" + , "purposes of this definition, \"control\" includes the right to grant" + , "patent sublicenses in a manner consistent with the requirements of" + , "this License." + , "" + , " Each contributor grants you a non-exclusive, worldwide, royalty-free" + , "patent license under the contributor's essential patent claims, to" + , "make, use, sell, offer for sale, import and otherwise run, modify and" + , "propagate the contents of its contributor version." + , "" + , " In the following three paragraphs, a \"patent license\" is any express" + , "agreement or commitment, however denominated, not to enforce a patent" + , "(such as an express permission to practice a patent or covenant not to" + , "sue for patent infringement). To \"grant\" such a patent license to a" + , "party means to make such an agreement or commitment not to enforce a" + , "patent against the party." + , "" + , " If you convey a covered work, knowingly relying on a patent license," + , "and the Corresponding Source of the work is not available for anyone" + , "to copy, free of charge and under the terms of this License, through a" + , "publicly available network server or other readily accessible means," + , "then you must either (1) cause the Corresponding Source to be so" + , "available, or (2) arrange to deprive yourself of the benefit of the" + , "patent license for this particular work, or (3) arrange, in a manner" + , "consistent with the requirements of this License, to extend the patent" + , "license to downstream recipients. \"Knowingly relying\" means you have" + , "actual knowledge that, but for the patent license, your conveying the" + , "covered work in a country, or your recipient's use of the covered work" + , "in a country, would infringe one or more identifiable patents in that" + , "country that you have reason to believe are valid." + , " " + , " If, pursuant to or in connection with a single transaction or" + , "arrangement, you convey, or propagate by procuring conveyance of, a" + , "covered work, and grant a patent license to some of the parties" + , "receiving the covered work authorizing them to use, propagate, modify" + , "or convey a specific copy of the covered work, then the patent license" + , "you grant is automatically extended to all recipients of the covered" + , "work and works based on it." + , "" + , " A patent license is \"discriminatory\" if it does not include within" + , "the scope of its coverage, prohibits the exercise of, or is" + , "conditioned on the non-exercise of one or more of the rights that are" + , "specifically granted under this License. You may not convey a covered" + , "work if you are a party to an arrangement with a third party that is" + , "in the business of distributing software, under which you make payment" + , "to the third party based on the extent of your activity of conveying" + , "the work, and under which the third party grants, to any of the" + , "parties who would receive the covered work from you, a discriminatory" + , "patent license (a) in connection with copies of the covered work" + , "conveyed by you (or copies made from those copies), or (b) primarily" + , "for and in connection with specific products or compilations that" + , "contain the covered work, unless you entered into that arrangement," + , "or that patent license was granted, prior to 28 March 2007." + , "" + , " Nothing in this License shall be construed as excluding or limiting" + , "any implied license or other defenses to infringement that may" + , "otherwise be available to you under applicable patent law." + , "" + , " 12. No Surrender of Others' Freedom." + , "" + , " If conditions are imposed on you (whether by court order, agreement or" + , "otherwise) that contradict the conditions of this License, they do not" + , "excuse you from the conditions of this License. If you cannot convey a" + , "covered work so as to satisfy simultaneously your obligations under this" + , "License and any other pertinent obligations, then as a consequence you may" + , "not convey it at all. For example, if you agree to terms that obligate you" + , "to collect a royalty for further conveying from those to whom you convey" + , "the Program, the only way you could satisfy both those terms and this" + , "License would be to refrain entirely from conveying the Program." + , "" + , " 13. Use with the GNU Affero General Public License." + , "" + , " Notwithstanding any other provision of this License, you have" + , "permission to link or combine any covered work with a work licensed" + , "under version 3 of the GNU Affero General Public License into a single" + , "combined work, and to convey the resulting work. The terms of this" + , "License will continue to apply to the part which is the covered work," + , "but the special requirements of the GNU Affero General Public License," + , "section 13, concerning interaction through a network will apply to the" + , "combination as such." + , "" + , " 14. Revised Versions of this License." + , "" + , " The Free Software Foundation may publish revised and/or new versions of" + , "the GNU General Public License from time to time. Such new versions will" + , "be similar in spirit to the present version, but may differ in detail to" + , "address new problems or concerns." + , "" + , " Each version is given a distinguishing version number. If the" + , "Program specifies that a certain numbered version of the GNU General" + , "Public License \"or any later version\" applies to it, you have the" + , "option of following the terms and conditions either of that numbered" + , "version or of any later version published by the Free Software" + , "Foundation. If the Program does not specify a version number of the" + , "GNU General Public License, you may choose any version ever published" + , "by the Free Software Foundation." + , "" + , " If the Program specifies that a proxy can decide which future" + , "versions of the GNU General Public License can be used, that proxy's" + , "public statement of acceptance of a version permanently authorizes you" + , "to choose that version for the Program." + , "" + , " Later license versions may give you additional or different" + , "permissions. However, no additional obligations are imposed on any" + , "author or copyright holder as a result of your choosing to follow a" + , "later version." + , "" + , " 15. Disclaimer of Warranty." + , "" + , " THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY" + , "APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT" + , "HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY" + , "OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO," + , "THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR" + , "PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM" + , "IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF" + , "ALL NECESSARY SERVICING, REPAIR OR CORRECTION." + , "" + , " 16. Limitation of Liability." + , "" + , " IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING" + , "WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS" + , "THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY" + , "GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE" + , "USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF" + , "DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD" + , "PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS)," + , "EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF" + , "SUCH DAMAGES." + , "" + , " 17. Interpretation of Sections 15 and 16." + , "" + , " If the disclaimer of warranty and limitation of liability provided" + , "above cannot be given local legal effect according to their terms," + , "reviewing courts shall apply local law that most closely approximates" + , "an absolute waiver of all civil liability in connection with the" + , "Program, unless a warranty or assumption of liability accompanies a" + , "copy of the Program in return for a fee." + , "" + , " END OF TERMS AND CONDITIONS" + , "" + , " How to Apply These Terms to Your New Programs" + , "" + , " If you develop a new program, and you want it to be of the greatest" + , "possible use to the public, the best way to achieve this is to make it" + , "free software which everyone can redistribute and change under these terms." + , "" + , " To do so, attach the following notices to the program. It is safest" + , "to attach them to the start of each source file to most effectively" + , "state the exclusion of warranty; and each file should have at least" + , "the \"copyright\" line and a pointer to where the full notice is found." + , "" + , " " + , " Copyright (C) " + , "" + , " This program is free software: you can redistribute it and/or modify" + , " it under the terms of the GNU General Public License as published by" + , " the Free Software Foundation, either version 3 of the License, or" + , " (at your option) any later version." + , "" + , " This program is distributed in the hope that it will be useful," + , " but WITHOUT ANY WARRANTY; without even the implied warranty of" + , " MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the" + , " GNU General Public License for more details." + , "" + , " You should have received a copy of the GNU General Public License" + , " along with this program. If not, see ." + , "" + , "Also add information on how to contact you by electronic and paper mail." + , "" + , " If the program does terminal interaction, make it output a short" + , "notice like this when it starts in an interactive mode:" + , "" + , " Copyright (C) " + , " This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'." + , " This is free software, and you are welcome to redistribute it" + , " under certain conditions; type `show c' for details." + , "" + , "The hypothetical commands `show w' and `show c' should show the appropriate" + , "parts of the General Public License. Of course, your program's commands" + , "might be different; for a GUI interface, you would use an \"about box\"." + , "" + , " You should also get your employer (if you work as a programmer) or school," + , "if any, to sign a \"copyright disclaimer\" for the program, if necessary." + , "For more information on this, and how to apply and follow the GNU GPL, see" + , "." + , "" + , " The GNU General Public License does not permit incorporating your program" + , "into proprietary programs. If your program is a subroutine library, you" + , "may consider it more useful to permit linking proprietary applications with" + , "the library. If this is what you want to do, use the GNU Lesser General" + , "Public License instead of this License. But first, please read" + , "." + , "" + ] + +lgpl2 :: License +lgpl2 = unlines + [ " GNU LIBRARY GENERAL PUBLIC LICENSE" + , " Version 2, June 1991" + , "" + , " Copyright (C) 1991 Free Software Foundation, Inc." + , " 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA" + , " Everyone is permitted to copy and distribute verbatim copies" + , " of this license document, but changing it is not allowed." + , "" + , "[This is the first released version of the library GPL. It is" + , " numbered 2 because it goes with version 2 of the ordinary GPL.]" + , "" + , " Preamble" + , "" + , " The licenses for most software are designed to take away your" + , "freedom to share and change it. By contrast, the GNU General Public" + , "Licenses are intended to guarantee your freedom to share and change" + , "free software--to make sure the software is free for all its users." + , "" + , " This license, the Library General Public License, applies to some" + , "specially designated Free Software Foundation software, and to any" + , "other libraries whose authors decide to use it. You can use it for" + , "your libraries, too." + , "" + , " When we speak of free software, we are referring to freedom, not" + , "price. Our General Public Licenses are designed to make sure that you" + , "have the freedom to distribute copies of free software (and charge for" + , "this service if you wish), that you receive source code or can get it" + , "if you want it, that you can change the software or use pieces of it" + , "in new free programs; and that you know you can do these things." + , "" + , " To protect your rights, we need to make restrictions that forbid" + , "anyone to deny you these rights or to ask you to surrender the rights." + , "These restrictions translate to certain responsibilities for you if" + , "you distribute copies of the library, or if you modify it." + , "" + , " For example, if you distribute copies of the library, whether gratis" + , "or for a fee, you must give the recipients all the rights that we gave" + , "you. You must make sure that they, too, receive or can get the source" + , "code. If you link a program with the library, you must provide" + , "complete object files to the recipients so that they can relink them" + , "with the library, after making changes to the library and recompiling" + , "it. And you must show them these terms so they know their rights." + , "" + , " Our method of protecting your rights has two steps: (1) copyright" + , "the library, and (2) offer you this license which gives you legal" + , "permission to copy, distribute and/or modify the library." + , "" + , " Also, for each distributor's protection, we want to make certain" + , "that everyone understands that there is no warranty for this free" + , "library. If the library is modified by someone else and passed on, we" + , "want its recipients to know that what they have is not the original" + , "version, so that any problems introduced by others will not reflect on" + , "the original authors' reputations." + , "" + , " Finally, any free program is threatened constantly by software" + , "patents. We wish to avoid the danger that companies distributing free" + , "software will individually obtain patent licenses, thus in effect" + , "transforming the program into proprietary software. To prevent this," + , "we have made it clear that any patent must be licensed for everyone's" + , "free use or not licensed at all." + , "" + , " Most GNU software, including some libraries, is covered by the ordinary" + , "GNU General Public License, which was designed for utility programs. This" + , "license, the GNU Library General Public License, applies to certain" + , "designated libraries. This license is quite different from the ordinary" + , "one; be sure to read it in full, and don't assume that anything in it is" + , "the same as in the ordinary license." + , "" + , " The reason we have a separate public license for some libraries is that" + , "they blur the distinction we usually make between modifying or adding to a" + , "program and simply using it. Linking a program with a library, without" + , "changing the library, is in some sense simply using the library, and is" + , "analogous to running a utility program or application program. However, in" + , "a textual and legal sense, the linked executable is a combined work, a" + , "derivative of the original library, and the ordinary General Public License" + , "treats it as such." + , "" + , " Because of this blurred distinction, using the ordinary General" + , "Public License for libraries did not effectively promote software" + , "sharing, because most developers did not use the libraries. We" + , "concluded that weaker conditions might promote sharing better." + , "" + , " However, unrestricted linking of non-free programs would deprive the" + , "users of those programs of all benefit from the free status of the" + , "libraries themselves. This Library General Public License is intended to" + , "permit developers of non-free programs to use free libraries, while" + , "preserving your freedom as a user of such programs to change the free" + , "libraries that are incorporated in them. (We have not seen how to achieve" + , "this as regards changes in header files, but we have achieved it as regards" + , "changes in the actual functions of the Library.) The hope is that this" + , "will lead to faster development of free libraries." + , "" + , " The precise terms and conditions for copying, distribution and" + , "modification follow. Pay close attention to the difference between a" + , "\"work based on the library\" and a \"work that uses the library\". The" + , "former contains code derived from the library, while the latter only" + , "works together with the library." + , "" + , " Note that it is possible for a library to be covered by the ordinary" + , "General Public License rather than by this special one." + , "" + , " GNU LIBRARY GENERAL PUBLIC LICENSE" + , " TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION" + , "" + , " 0. This License Agreement applies to any software library which" + , "contains a notice placed by the copyright holder or other authorized" + , "party saying it may be distributed under the terms of this Library" + , "General Public License (also called \"this License\"). Each licensee is" + , "addressed as \"you\"." + , "" + , " A \"library\" means a collection of software functions and/or data" + , "prepared so as to be conveniently linked with application programs" + , "(which use some of those functions and data) to form executables." + , "" + , " The \"Library\", below, refers to any such software library or work" + , "which has been distributed under these terms. A \"work based on the" + , "Library\" means either the Library or any derivative work under" + , "copyright law: that is to say, a work containing the Library or a" + , "portion of it, either verbatim or with modifications and/or translated" + , "straightforwardly into another language. (Hereinafter, translation is" + , "included without limitation in the term \"modification\".)" + , "" + , " \"Source code\" for a work means the preferred form of the work for" + , "making modifications to it. For a library, complete source code means" + , "all the source code for all modules it contains, plus any associated" + , "interface definition files, plus the scripts used to control compilation" + , "and installation of the library." + , "" + , " Activities other than copying, distribution and modification are not" + , "covered by this License; they are outside its scope. The act of" + , "running a program using the Library is not restricted, and output from" + , "such a program is covered only if its contents constitute a work based" + , "on the Library (independent of the use of the Library in a tool for" + , "writing it). Whether that is true depends on what the Library does" + , "and what the program that uses the Library does." + , " " + , " 1. You may copy and distribute verbatim copies of the Library's" + , "complete source code as you receive it, in any medium, provided that" + , "you conspicuously and appropriately publish on each copy an" + , "appropriate copyright notice and disclaimer of warranty; keep intact" + , "all the notices that refer to this License and to the absence of any" + , "warranty; and distribute a copy of this License along with the" + , "Library." + , "" + , " You may charge a fee for the physical act of transferring a copy," + , "and you may at your option offer warranty protection in exchange for a" + , "fee." + , "" + , " 2. You may modify your copy or copies of the Library or any portion" + , "of it, thus forming a work based on the Library, and copy and" + , "distribute such modifications or work under the terms of Section 1" + , "above, provided that you also meet all of these conditions:" + , "" + , " a) The modified work must itself be a software library." + , "" + , " b) You must cause the files modified to carry prominent notices" + , " stating that you changed the files and the date of any change." + , "" + , " c) You must cause the whole of the work to be licensed at no" + , " charge to all third parties under the terms of this License." + , "" + , " d) If a facility in the modified Library refers to a function or a" + , " table of data to be supplied by an application program that uses" + , " the facility, other than as an argument passed when the facility" + , " is invoked, then you must make a good faith effort to ensure that," + , " in the event an application does not supply such function or" + , " table, the facility still operates, and performs whatever part of" + , " its purpose remains meaningful." + , "" + , " (For example, a function in a library to compute square roots has" + , " a purpose that is entirely well-defined independent of the" + , " application. Therefore, Subsection 2d requires that any" + , " application-supplied function or table used by this function must" + , " be optional: if the application does not supply it, the square" + , " root function must still compute square roots.)" + , "" + , "These requirements apply to the modified work as a whole. If" + , "identifiable sections of that work are not derived from the Library," + , "and can be reasonably considered independent and separate works in" + , "themselves, then this License, and its terms, do not apply to those" + , "sections when you distribute them as separate works. But when you" + , "distribute the same sections as part of a whole which is a work based" + , "on the Library, the distribution of the whole must be on the terms of" + , "this License, whose permissions for other licensees extend to the" + , "entire whole, and thus to each and every part regardless of who wrote" + , "it." + , "" + , "Thus, it is not the intent of this section to claim rights or contest" + , "your rights to work written entirely by you; rather, the intent is to" + , "exercise the right to control the distribution of derivative or" + , "collective works based on the Library." + , "" + , "In addition, mere aggregation of another work not based on the Library" + , "with the Library (or with a work based on the Library) on a volume of" + , "a storage or distribution medium does not bring the other work under" + , "the scope of this License." + , "" + , " 3. You may opt to apply the terms of the ordinary GNU General Public" + , "License instead of this License to a given copy of the Library. To do" + , "this, you must alter all the notices that refer to this License, so" + , "that they refer to the ordinary GNU General Public License, version 2," + , "instead of to this License. (If a newer version than version 2 of the" + , "ordinary GNU General Public License has appeared, then you can specify" + , "that version instead if you wish.) Do not make any other change in" + , "these notices." + , "" + , " Once this change is made in a given copy, it is irreversible for" + , "that copy, so the ordinary GNU General Public License applies to all" + , "subsequent copies and derivative works made from that copy." + , "" + , " This option is useful when you wish to copy part of the code of" + , "the Library into a program that is not a library." + , "" + , " 4. You may copy and distribute the Library (or a portion or" + , "derivative of it, under Section 2) in object code or executable form" + , "under the terms of Sections 1 and 2 above provided that you accompany" + , "it with the complete corresponding machine-readable source code, which" + , "must be distributed under the terms of Sections 1 and 2 above on a" + , "medium customarily used for software interchange." + , "" + , " If distribution of object code is made by offering access to copy" + , "from a designated place, then offering equivalent access to copy the" + , "source code from the same place satisfies the requirement to" + , "distribute the source code, even though third parties are not" + , "compelled to copy the source along with the object code." + , "" + , " 5. A program that contains no derivative of any portion of the" + , "Library, but is designed to work with the Library by being compiled or" + , "linked with it, is called a \"work that uses the Library\". Such a" + , "work, in isolation, is not a derivative work of the Library, and" + , "therefore falls outside the scope of this License." + , "" + , " However, linking a \"work that uses the Library\" with the Library" + , "creates an executable that is a derivative of the Library (because it" + , "contains portions of the Library), rather than a \"work that uses the" + , "library\". The executable is therefore covered by this License." + , "Section 6 states terms for distribution of such executables." + , "" + , " When a \"work that uses the Library\" uses material from a header file" + , "that is part of the Library, the object code for the work may be a" + , "derivative work of the Library even though the source code is not." + , "Whether this is true is especially significant if the work can be" + , "linked without the Library, or if the work is itself a library. The" + , "threshold for this to be true is not precisely defined by law." + , "" + , " If such an object file uses only numerical parameters, data" + , "structure layouts and accessors, and small macros and small inline" + , "functions (ten lines or less in length), then the use of the object" + , "file is unrestricted, regardless of whether it is legally a derivative" + , "work. (Executables containing this object code plus portions of the" + , "Library will still fall under Section 6.)" + , "" + , " Otherwise, if the work is a derivative of the Library, you may" + , "distribute the object code for the work under the terms of Section 6." + , "Any executables containing that work also fall under Section 6," + , "whether or not they are linked directly with the Library itself." + , "" + , " 6. As an exception to the Sections above, you may also compile or" + , "link a \"work that uses the Library\" with the Library to produce a" + , "work containing portions of the Library, and distribute that work" + , "under terms of your choice, provided that the terms permit" + , "modification of the work for the customer's own use and reverse" + , "engineering for debugging such modifications." + , "" + , " You must give prominent notice with each copy of the work that the" + , "Library is used in it and that the Library and its use are covered by" + , "this License. You must supply a copy of this License. If the work" + , "during execution displays copyright notices, you must include the" + , "copyright notice for the Library among them, as well as a reference" + , "directing the user to the copy of this License. Also, you must do one" + , "of these things:" + , "" + , " a) Accompany the work with the complete corresponding" + , " machine-readable source code for the Library including whatever" + , " changes were used in the work (which must be distributed under" + , " Sections 1 and 2 above); and, if the work is an executable linked" + , " with the Library, with the complete machine-readable \"work that" + , " uses the Library\", as object code and/or source code, so that the" + , " user can modify the Library and then relink to produce a modified" + , " executable containing the modified Library. (It is understood" + , " that the user who changes the contents of definitions files in the" + , " Library will not necessarily be able to recompile the application" + , " to use the modified definitions.)" + , "" + , " b) Accompany the work with a written offer, valid for at" + , " least three years, to give the same user the materials" + , " specified in Subsection 6a, above, for a charge no more" + , " than the cost of performing this distribution." + , "" + , " c) If distribution of the work is made by offering access to copy" + , " from a designated place, offer equivalent access to copy the above" + , " specified materials from the same place." + , "" + , " d) Verify that the user has already received a copy of these" + , " materials or that you have already sent this user a copy." + , "" + , " For an executable, the required form of the \"work that uses the" + , "Library\" must include any data and utility programs needed for" + , "reproducing the executable from it. However, as a special exception," + , "the source code distributed need not include anything that is normally" + , "distributed (in either source or binary form) with the major" + , "components (compiler, kernel, and so on) of the operating system on" + , "which the executable runs, unless that component itself accompanies" + , "the executable." + , "" + , " It may happen that this requirement contradicts the license" + , "restrictions of other proprietary libraries that do not normally" + , "accompany the operating system. Such a contradiction means you cannot" + , "use both them and the Library together in an executable that you" + , "distribute." + , "" + , " 7. You may place library facilities that are a work based on the" + , "Library side-by-side in a single library together with other library" + , "facilities not covered by this License, and distribute such a combined" + , "library, provided that the separate distribution of the work based on" + , "the Library and of the other library facilities is otherwise" + , "permitted, and provided that you do these two things:" + , "" + , " a) Accompany the combined library with a copy of the same work" + , " based on the Library, uncombined with any other library" + , " facilities. This must be distributed under the terms of the" + , " Sections above." + , "" + , " b) Give prominent notice with the combined library of the fact" + , " that part of it is a work based on the Library, and explaining" + , " where to find the accompanying uncombined form of the same work." + , "" + , " 8. You may not copy, modify, sublicense, link with, or distribute" + , "the Library except as expressly provided under this License. Any" + , "attempt otherwise to copy, modify, sublicense, link with, or" + , "distribute the Library is void, and will automatically terminate your" + , "rights under this License. However, parties who have received copies," + , "or rights, from you under this License will not have their licenses" + , "terminated so long as such parties remain in full compliance." + , "" + , " 9. You are not required to accept this License, since you have not" + , "signed it. However, nothing else grants you permission to modify or" + , "distribute the Library or its derivative works. These actions are" + , "prohibited by law if you do not accept this License. Therefore, by" + , "modifying or distributing the Library (or any work based on the" + , "Library), you indicate your acceptance of this License to do so, and" + , "all its terms and conditions for copying, distributing or modifying" + , "the Library or works based on it." + , "" + , " 10. Each time you redistribute the Library (or any work based on the" + , "Library), the recipient automatically receives a license from the" + , "original licensor to copy, distribute, link with or modify the Library" + , "subject to these terms and conditions. You may not impose any further" + , "restrictions on the recipients' exercise of the rights granted herein." + , "You are not responsible for enforcing compliance by third parties to" + , "this License." + , "" + , " 11. If, as a consequence of a court judgment or allegation of patent" + , "infringement or for any other reason (not limited to patent issues)," + , "conditions are imposed on you (whether by court order, agreement or" + , "otherwise) that contradict the conditions of this License, they do not" + , "excuse you from the conditions of this License. If you cannot" + , "distribute so as to satisfy simultaneously your obligations under this" + , "License and any other pertinent obligations, then as a consequence you" + , "may not distribute the Library at all. For example, if a patent" + , "license would not permit royalty-free redistribution of the Library by" + , "all those who receive copies directly or indirectly through you, then" + , "the only way you could satisfy both it and this License would be to" + , "refrain entirely from distribution of the Library." + , "" + , "If any portion of this section is held invalid or unenforceable under any" + , "particular circumstance, the balance of the section is intended to apply," + , "and the section as a whole is intended to apply in other circumstances." + , "" + , "It is not the purpose of this section to induce you to infringe any" + , "patents or other property right claims or to contest validity of any" + , "such claims; this section has the sole purpose of protecting the" + , "integrity of the free software distribution system which is" + , "implemented by public license practices. Many people have made" + , "generous contributions to the wide range of software distributed" + , "through that system in reliance on consistent application of that" + , "system; it is up to the author/donor to decide if he or she is willing" + , "to distribute software through any other system and a licensee cannot" + , "impose that choice." + , "" + , "This section is intended to make thoroughly clear what is believed to" + , "be a consequence of the rest of this License." + , "" + , " 12. If the distribution and/or use of the Library is restricted in" + , "certain countries either by patents or by copyrighted interfaces, the" + , "original copyright holder who places the Library under this License may add" + , "an explicit geographical distribution limitation excluding those countries," + , "so that distribution is permitted only in or among countries not thus" + , "excluded. In such case, this License incorporates the limitation as if" + , "written in the body of this License." + , "" + , " 13. The Free Software Foundation may publish revised and/or new" + , "versions of the Library General Public License from time to time." + , "Such new versions will be similar in spirit to the present version," + , "but may differ in detail to address new problems or concerns." + , "" + , "Each version is given a distinguishing version number. If the Library" + , "specifies a version number of this License which applies to it and" + , "\"any later version\", you have the option of following the terms and" + , "conditions either of that version or of any later version published by" + , "the Free Software Foundation. If the Library does not specify a" + , "license version number, you may choose any version ever published by" + , "the Free Software Foundation." + , "" + , " 14. If you wish to incorporate parts of the Library into other free" + , "programs whose distribution conditions are incompatible with these," + , "write to the author to ask for permission. For software which is" + , "copyrighted by the Free Software Foundation, write to the Free" + , "Software Foundation; we sometimes make exceptions for this. Our" + , "decision will be guided by the two goals of preserving the free status" + , "of all derivatives of our free software and of promoting the sharing" + , "and reuse of software generally." + , "" + , " NO WARRANTY" + , "" + , " 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO" + , "WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW." + , "EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR" + , "OTHER PARTIES PROVIDE THE LIBRARY \"AS IS\" WITHOUT WARRANTY OF ANY" + , "KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE" + , "IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR" + , "PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE" + , "LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME" + , "THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION." + , "" + , " 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN" + , "WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY" + , "AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU" + , "FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR" + , "CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE" + , "LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING" + , "RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A" + , "FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF" + , "SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH" + , "DAMAGES." + , "" + , " END OF TERMS AND CONDITIONS" + , "" + , " How to Apply These Terms to Your New Libraries" + , "" + , " If you develop a new library, and you want it to be of the greatest" + , "possible use to the public, we recommend making it free software that" + , "everyone can redistribute and change. You can do so by permitting" + , "redistribution under these terms (or, alternatively, under the terms of the" + , "ordinary General Public License)." + , "" + , " To apply these terms, attach the following notices to the library. It is" + , "safest to attach them to the start of each source file to most effectively" + , "convey the exclusion of warranty; and each file should have at least the" + , "\"copyright\" line and a pointer to where the full notice is found." + , "" + , " " + , " Copyright (C) " + , "" + , " This library is free software; you can redistribute it and/or" + , " modify it under the terms of the GNU Library General Public" + , " License as published by the Free Software Foundation; either" + , " version 2 of the License, or (at your option) any later version." + , "" + , " This library is distributed in the hope that it will be useful," + , " but WITHOUT ANY WARRANTY; without even the implied warranty of" + , " MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU" + , " Library General Public License for more details." + , "" + , " You should have received a copy of the GNU Library General Public" + , " License along with this library; if not, write to the Free" + , " Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA" + , "" + , "Also add information on how to contact you by electronic and paper mail." + , "" + , "You should also get your employer (if you work as a programmer) or your" + , "school, if any, to sign a \"copyright disclaimer\" for the library, if" + , "necessary. Here is a sample; alter the names:" + , "" + , " Yoyodyne, Inc., hereby disclaims all copyright interest in the" + , " library `Frob' (a library for tweaking knobs) written by James Random Hacker." + , "" + , " , 1 April 1990" + , " Ty Coon, President of Vice" + , "" + , "That's all there is to it!" + ] + +lgpl3 :: License +lgpl3 = unlines + [ " GNU LESSER GENERAL PUBLIC LICENSE" + , " Version 3, 29 June 2007" + , "" + , " Copyright (C) 2007 Free Software Foundation, Inc. " + , " Everyone is permitted to copy and distribute verbatim copies" + , " of this license document, but changing it is not allowed." + , "" + , "" + , " This version of the GNU Lesser General Public License incorporates" + , "the terms and conditions of version 3 of the GNU General Public" + , "License, supplemented by the additional permissions listed below." + , "" + , " 0. Additional Definitions. " + , "" + , " As used herein, \"this License\" refers to version 3 of the GNU Lesser" + , "General Public License, and the \"GNU GPL\" refers to version 3 of the GNU" + , "General Public License." + , "" + , " \"The Library\" refers to a covered work governed by this License," + , "other than an Application or a Combined Work as defined below." + , "" + , " An \"Application\" is any work that makes use of an interface provided" + , "by the Library, but which is not otherwise based on the Library." + , "Defining a subclass of a class defined by the Library is deemed a mode" + , "of using an interface provided by the Library." + , "" + , " A \"Combined Work\" is a work produced by combining or linking an" + , "Application with the Library. The particular version of the Library" + , "with which the Combined Work was made is also called the \"Linked" + , "Version\"." + , "" + , " The \"Minimal Corresponding Source\" for a Combined Work means the" + , "Corresponding Source for the Combined Work, excluding any source code" + , "for portions of the Combined Work that, considered in isolation, are" + , "based on the Application, and not on the Linked Version." + , "" + , " The \"Corresponding Application Code\" for a Combined Work means the" + , "object code and/or source code for the Application, including any data" + , "and utility programs needed for reproducing the Combined Work from the" + , "Application, but excluding the System Libraries of the Combined Work." + , "" + , " 1. Exception to Section 3 of the GNU GPL." + , "" + , " You may convey a covered work under sections 3 and 4 of this License" + , "without being bound by section 3 of the GNU GPL." + , "" + , " 2. Conveying Modified Versions." + , "" + , " If you modify a copy of the Library, and, in your modifications, a" + , "facility refers to a function or data to be supplied by an Application" + , "that uses the facility (other than as an argument passed when the" + , "facility is invoked), then you may convey a copy of the modified" + , "version:" + , "" + , " a) under this License, provided that you make a good faith effort to" + , " ensure that, in the event an Application does not supply the" + , " function or data, the facility still operates, and performs" + , " whatever part of its purpose remains meaningful, or" + , "" + , " b) under the GNU GPL, with none of the additional permissions of" + , " this License applicable to that copy." + , "" + , " 3. Object Code Incorporating Material from Library Header Files." + , "" + , " The object code form of an Application may incorporate material from" + , "a header file that is part of the Library. You may convey such object" + , "code under terms of your choice, provided that, if the incorporated" + , "material is not limited to numerical parameters, data structure" + , "layouts and accessors, or small macros, inline functions and templates" + , "(ten or fewer lines in length), you do both of the following:" + , "" + , " a) Give prominent notice with each copy of the object code that the" + , " Library is used in it and that the Library and its use are" + , " covered by this License." + , "" + , " b) Accompany the object code with a copy of the GNU GPL and this license" + , " document." + , "" + , " 4. Combined Works." + , "" + , " You may convey a Combined Work under terms of your choice that," + , "taken together, effectively do not restrict modification of the" + , "portions of the Library contained in the Combined Work and reverse" + , "engineering for debugging such modifications, if you also do each of" + , "the following:" + , "" + , " a) Give prominent notice with each copy of the Combined Work that" + , " the Library is used in it and that the Library and its use are" + , " covered by this License." + , "" + , " b) Accompany the Combined Work with a copy of the GNU GPL and this license" + , " document." + , "" + , " c) For a Combined Work that displays copyright notices during" + , " execution, include the copyright notice for the Library among" + , " these notices, as well as a reference directing the user to the" + , " copies of the GNU GPL and this license document." + , "" + , " d) Do one of the following:" + , "" + , " 0) Convey the Minimal Corresponding Source under the terms of this" + , " License, and the Corresponding Application Code in a form" + , " suitable for, and under terms that permit, the user to" + , " recombine or relink the Application with a modified version of" + , " the Linked Version to produce a modified Combined Work, in the" + , " manner specified by section 6 of the GNU GPL for conveying" + , " Corresponding Source." + , "" + , " 1) Use a suitable shared library mechanism for linking with the" + , " Library. A suitable mechanism is one that (a) uses at run time" + , " a copy of the Library already present on the user's computer" + , " system, and (b) will operate properly with a modified version" + , " of the Library that is interface-compatible with the Linked" + , " Version. " + , "" + , " e) Provide Installation Information, but only if you would otherwise" + , " be required to provide such information under section 6 of the" + , " GNU GPL, and only to the extent that such information is" + , " necessary to install and execute a modified version of the" + , " Combined Work produced by recombining or relinking the" + , " Application with a modified version of the Linked Version. (If" + , " you use option 4d0, the Installation Information must accompany" + , " the Minimal Corresponding Source and Corresponding Application" + , " Code. If you use option 4d1, you must provide the Installation" + , " Information in the manner specified by section 6 of the GNU GPL" + , " for conveying Corresponding Source.)" + , "" + , " 5. Combined Libraries." + , "" + , " You may place library facilities that are a work based on the" + , "Library side by side in a single library together with other library" + , "facilities that are not Applications and are not covered by this" + , "License, and convey such a combined library under terms of your" + , "choice, if you do both of the following:" + , "" + , " a) Accompany the combined library with a copy of the same work based" + , " on the Library, uncombined with any other library facilities," + , " conveyed under the terms of this License." + , "" + , " b) Give prominent notice with the combined library that part of it" + , " is a work based on the Library, and explaining where to find the" + , " accompanying uncombined form of the same work." + , "" + , " 6. Revised Versions of the GNU Lesser General Public License." + , "" + , " The Free Software Foundation may publish revised and/or new versions" + , "of the GNU Lesser General Public License from time to time. Such new" + , "versions will be similar in spirit to the present version, but may" + , "differ in detail to address new problems or concerns." + , "" + , " Each version is given a distinguishing version number. If the" + , "Library as you received it specifies that a certain numbered version" + , "of the GNU Lesser General Public License \"or any later version\"" + , "applies to it, you have the option of following the terms and" + , "conditions either of that published version or of any later version" + , "published by the Free Software Foundation. If the Library as you" + , "received it does not specify a version number of the GNU Lesser" + , "General Public License, you may choose any version of the GNU Lesser" + , "General Public License ever published by the Free Software Foundation." + , "" + , " If the Library as you received it specifies that a proxy can decide" + , "whether future versions of the GNU Lesser General Public License shall" + , "apply, that proxy's public statement of acceptance of any version is" + , "permanent authorization for you to choose that version for the" + , "Library." + ] + diff --git a/Distribution/Client/Init/Types.hs b/Distribution/Client/Init/Types.hs new file mode 100644 --- /dev/null +++ b/Distribution/Client/Init/Types.hs @@ -0,0 +1,167 @@ +{-# LANGUAGE CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Client.Init.Types +-- Copyright : (c) Brent Yorgey, Benedikt Huber 2009 +-- License : BSD-like +-- +-- Maintainer : cabal-devel@haskell.org +-- Stability : provisional +-- Portability : portable +-- +-- Some types used by the 'cabal init' command. +-- +----------------------------------------------------------------------------- +module Distribution.Client.Init.Types where + +import Distribution.Simple.Setup + ( Flag(..) ) + +import Distribution.Version +import qualified Distribution.Package as P +import Distribution.License +import Distribution.ModuleName + +import qualified Text.PrettyPrint as Disp +import qualified Distribution.Compat.ReadP as Parse +import Distribution.Text + +import Data.Monoid + +-- | InitFlags is really just a simple type to represent certain +-- portions of a .cabal file. Rather than have a flag for EVERY +-- possible field, we just have one for each field that the user is +-- likely to want and/or that we are likely to be able to +-- intelligently guess. +data InitFlags = + InitFlags { nonInteractive :: Flag Bool + , quiet :: Flag Bool + , packageDir :: Flag FilePath + , noComments :: Flag Bool + , minimal :: Flag Bool + + , packageName :: Flag String + , version :: Flag Version + , cabalVersion :: Flag VersionRange + , license :: Flag License + , author :: Flag String + , email :: Flag String + , stability :: Flag (Either String Stability) + , homepage :: Flag String + + , synopsis :: Flag String + , category :: Flag (Either String Category) + + , packageType :: Flag PackageType + + , exposedModules :: Maybe [ModuleName] + , otherModules :: Maybe [ModuleName] + + , dependencies :: Maybe [P.Dependency] + , sourceDirs :: Maybe [String] + , buildTools :: Maybe [String] + } + deriving (Show) + +data PackageType = Library | Executable + deriving (Show, Read, Eq) + +instance Text PackageType where + disp = Disp.text . show + parse = Parse.choice $ map (fmap read . Parse.string . show) [Library, Executable] + +instance Monoid InitFlags where + mempty = InitFlags + { nonInteractive = mempty + , quiet = mempty + , packageDir = mempty + , noComments = mempty + , minimal = mempty + , packageName = mempty + , version = mempty + , cabalVersion = mempty + , license = mempty + , author = mempty + , email = mempty + , stability = mempty + , homepage = mempty + , synopsis = mempty + , category = mempty + , packageType = mempty + , exposedModules = mempty + , otherModules = mempty + , dependencies = mempty + , sourceDirs = mempty + , buildTools = mempty + } + mappend a b = InitFlags + { nonInteractive = combine nonInteractive + , quiet = combine quiet + , packageDir = combine packageDir + , noComments = combine noComments + , minimal = combine minimal + , packageName = combine packageName + , version = combine version + , cabalVersion = combine cabalVersion + , license = combine license + , author = combine author + , email = combine email + , stability = combine stability + , homepage = combine homepage + , synopsis = combine synopsis + , category = combine category + , packageType = combine packageType + , exposedModules = combine exposedModules + , otherModules = combine otherModules + , dependencies = combine dependencies + , sourceDirs = combine sourceDirs + , buildTools = combine buildTools + } + where combine field = field a `mappend` field b + +-- | Some common package categories. +data Category + = Codec + | Concurrency + | Control + | Data + | Database + | Development + | Distribution + | Game + | Graphics + | Language + | Math + | Network + | Sound + | System + | Testing + | Text + | Web + deriving (Read, Show, Eq, Ord, Bounded, Enum) + +instance Text Category where + disp = Disp.text . show + parse = Parse.choice $ map (fmap read . Parse.string . show) [Codec .. ] + +-- | Some common package stability indicators. +data Stability + = Stable + | Provisional + | Experimental + | Alpha + deriving (Read, Show, Eq, Ord, Bounded, Enum) + +instance Text Stability where + disp = Disp.text . show + parse = Parse.choice $ map (fmap read . Parse.string . show) [Stable .. ] + +#if MIN_VERSION_base(3,0,0) +#else +-- Compat instance for ghc-6.6 era +instance Monoid a => Monoid (Maybe a) where + mempty = Nothing + Nothing `mappend` m = m + m `mappend` Nothing = m + Just m1 `mappend` Just m2 = Just (m1 `mappend` m2) +#endif diff --git a/Distribution/Client/Install.hs b/Distribution/Client/Install.hs --- a/Distribution/Client/Install.hs +++ b/Distribution/Client/Install.hs @@ -21,7 +21,18 @@ ( isJust, fromMaybe ) import qualified Data.Map as Map import Control.Exception as Exception - ( handle, handleJust, Exception(IOException) ) + ( handleJust ) +#if MIN_VERSION_base(4,0,0) +import Control.Exception as Exception + ( Exception(toException), catches, Handler(Handler), IOException ) +import System.Exit + ( ExitCode ) +#else +import Control.Exception as Exception + ( Exception(IOException, ExitException) ) +#endif +import Distribution.Compat.Exception + ( SomeException, catchIO, catchExit ) import Control.Monad ( when, unless ) import System.Directory @@ -41,9 +52,11 @@ , upgradableDependencies , Progress(..), foldProgress, ) import Distribution.Client.Fetch (fetchPackage) +import qualified Distribution.Client.Haddock as Haddock (regenerateHaddockIndex) -- import qualified Distribution.Client.Info as Info import Distribution.Client.IndexUtils as IndexUtils - ( getAvailablePackages, disambiguateDependencies ) + ( getAvailablePackages, disambiguateDependencies + , getInstalledPackages ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.InstallPlan (InstallPlan) import Distribution.Client.Setup @@ -57,7 +70,8 @@ , AvailablePackageSource(..), AvailablePackageDb(..) , Repo(..), ConfiguredPackage(..) , BuildResult, BuildFailure(..), BuildSuccess(..) - , DocsResult(..), TestsResult(..), RemoteRepo(..) ) + , DocsResult(..), TestsResult(..), RemoteRepo(..) + , InstalledPackage ) import Distribution.Client.BuildReports.Types ( ReportLevel(..) ) import Distribution.Client.SetupWrapper @@ -71,12 +85,12 @@ import Paths_cabal_install (getBinDir) import Distribution.Simple.Compiler - ( CompilerId(..), Compiler(compilerId), PackageDB(..) ) + ( CompilerId(..), Compiler(compilerId), compilerFlavor + , PackageDB(..), PackageDBStack ) import Distribution.Simple.Program (ProgramConfiguration, defaultProgramConfiguration) -import Distribution.Simple.Configure (getInstalledPackages) import qualified Distribution.Simple.InstallDirs as InstallDirs -import qualified Distribution.Simple.PackageIndex as PackageIndex -import Distribution.Simple.PackageIndex (PackageIndex) +import qualified Distribution.Client.PackageIndex as PackageIndex +import Distribution.Client.PackageIndex (PackageIndex) import Distribution.Simple.Setup ( haddockCommand, HaddockFlags(..), emptyHaddockFlags , buildCommand, BuildFlags(..), emptyBuildFlags @@ -85,9 +99,9 @@ ( installCommand, InstallFlags(..), emptyInstallFlags ) import Distribution.Simple.Utils ( defaultPackageDesc, rawSystemExit, comparing ) -import Distribution.Simple.InstallDirs - ( PathTemplate, fromPathTemplate, toPathTemplate - , initialPathTemplateEnv, substPathTemplate ) +import Distribution.Simple.InstallDirs as InstallDirs + ( PathTemplate, fromPathTemplate, toPathTemplate, substPathTemplate + , initialPathTemplateEnv, compilerTemplateEnv, installDirsTemplateEnv ) import Distribution.Package ( PackageName, PackageIdentifier, packageName, packageVersion , Package(..), PackageFixedDeps(..) @@ -99,16 +113,14 @@ ( readPackageDescription ) import Distribution.PackageDescription.Configuration ( finalizePackageDescription ) -import Distribution.InstalledPackageInfo - ( InstalledPackageInfo ) import Distribution.Version - ( Version, VersionRange(AnyVersion, ThisVersion) ) + ( Version, VersionRange, anyVersion, thisVersion ) import Distribution.Simple.Utils as Utils - ( notice, info, warn, die, intercalate ) + ( notice, info, warn, die, intercalate, withTempDirectory ) import Distribution.Client.Utils - ( inDir, mergeBy, MergeResult(..), withTempDirectory ) + ( inDir, mergeBy, MergeResult(..) ) import Distribution.System - ( Platform(Platform), buildPlatform, OS(Windows), buildOS ) + ( Platform, buildPlatform, OS(Windows), buildOS ) import Distribution.Text ( display ) import Distribution.Verbosity as Verbosity @@ -123,7 +135,7 @@ -- |Installs the packages needed to satisfy a list of dependencies. install, upgrade :: Verbosity - -> PackageDB + -> PackageDBStack -> [Repo] -> Compiler -> ProgramConfiguration @@ -158,7 +170,7 @@ | otherwise = planRepoPackages PreferAllLatest comp configFlags configExFlags installFlags deps -type Planner = Maybe (PackageIndex InstalledPackageInfo) +type Planner = Maybe (PackageIndex InstalledPackage) -> AvailablePackageDb -> IO (Progress String String InstallPlan) @@ -166,7 +178,7 @@ installWithPlanner :: Planner -> Verbosity - -> PackageDB + -> PackageDBStack -> [Repo] -> Compiler -> ProgramConfiguration @@ -174,10 +186,10 @@ -> ConfigExFlags -> InstallFlags -> IO () -installWithPlanner planner verbosity packageDB repos comp conf +installWithPlanner planner verbosity packageDBs repos comp conf configFlags configExFlags installFlags = do - installed <- getInstalledPackages verbosity comp packageDB conf + installed <- getInstalledPackages verbosity comp packageDBs conf available <- getAvailablePackages verbosity repos progress <- planner installed available @@ -218,23 +230,27 @@ 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), + 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. - -- TODO: if we specify a specific db then we do not look in the user - -- package db but we probably should ie [global, user, specific] - usePackageDB = if packageDB == GlobalPackageDB then UserPackageDB - else packageDB, - usePackageIndex = if packageDB == GlobalPackageDB then Nothing - else index, + 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) @@ -242,7 +258,7 @@ useLoggingHandle = Nothing, useWorkingDir = Nothing } - reportingLevel = fromFlagOrDefault NoReports (installBuildReports installFlags) + reportingLevel = fromFlag (installBuildReports installFlags) useLogFile :: FilePath -> Maybe (PackageIdentifier -> FilePath) useLogFile logsDir = fmap substLogFileName logFileTemplate where @@ -256,7 +272,7 @@ . substPathTemplate env $ template where env = initialPathTemplateEnv (packageId pkg) (compilerId comp) - dryRun = fromFlagOrDefault False (installDryRun installFlags) + dryRun = fromFlag (installDryRun installFlags) miscOptions = InstallMisc { rootCmd = if fromFlag (configUserInstall configFlags) then Nothing -- ignore --root-cmd if --user. @@ -292,10 +308,75 @@ 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) + + -- | Make an 'InstallPlan' for the unpacked package in the current directory, -- and all its dependencies. -- @@ -317,7 +398,7 @@ } targets = [packageName pkg] constraints = [PackageVersionConstraint (packageName pkg) - (ThisVersion (packageVersion pkg)) + (thisVersion (packageVersion pkg)) ,PackageFlagsConstraint (packageName pkg) (configConfigurationsFlags configFlags)] ++ [ PackageVersionConstraint name ver @@ -338,7 +419,7 @@ deps' <- IndexUtils.disambiguateDependencies available deps let installed' - | fromFlagOrDefault False (installReinstall installFlags) + | fromFlag (installReinstall installFlags) = fmap (hideGivenDeps deps') installed | otherwise = installed targets = dependencyTargets deps' @@ -396,7 +477,7 @@ ++ [ PackageVersionPreference name ver | Dependency name ver <- configPreferences configExFlags ] -printDryRun :: Verbosity -> Maybe (PackageIndex InstalledPackageInfo) +printDryRun :: Verbosity -> Maybe (PackageIndex InstalledPackage) -> InstallPlan -> IO () printDryRun verbosity minstalled plan = case unfoldr next plan of [] -> return () @@ -520,7 +601,7 @@ -> (ConfigFlags -> AvailablePackageSource -> PackageDescription -> a) -> a -installConfiguredPackage (Platform arch os) comp configFlags +installConfiguredPackage platform comp configFlags (ConfiguredPackage (AvailablePackage _ gpkg source) flags deps) installPkg = installPkg configFlags { configConfigurationsFlags = flags, @@ -528,8 +609,8 @@ } source pkg where pkg = case finalizePackageDescription flags - (Nothing :: Maybe (PackageIndex PackageDescription)) - os arch comp [] gpkg of + (const True) + platform comp [] gpkg of Left _ -> error "finalizePackageDescription ConfiguredPackage failed" Right (desc, _) -> desc @@ -545,7 +626,7 @@ pkgPath <- fetchPackage verbosity repo pkgid onFailure UnpackFailed $ do tmp <- getTemporaryDirectory - withTempDirectory tmp (display pkgid) $ \tmpDirPath -> do + withTempDirectory verbosity tmp (display pkgid) $ \tmpDirPath -> do info verbosity $ "Extracting " ++ pkgPath ++ " to " ++ tmpDirPath ++ "..." let relUnpackedPath = display pkgid @@ -582,9 +663,10 @@ -- Doc generation phase docsResult <- if shouldHaddock - then Exception.handle (\_ -> return DocsFailed) $ do - setup haddockCommand haddockFlags - return DocsOk + then (do setup haddockCommand haddockFlags + return DocsOk) + `catchIO` (\_ -> return DocsFailed) + `catchExit` (\_ -> return DocsFailed) else return DocsNotTried -- Tests phase @@ -607,8 +689,7 @@ buildDistPref = configDistPref configFlags, buildVerbosity = toFlag verbosity' } - shouldHaddock = fromFlagOrDefault False - (installDocumentation installConfigFlags) + shouldHaddock = fromFlag (installDocumentation installConfigFlags) haddockFlags _ = emptyHaddockFlags { haddockDistPref = configDistPref configFlags, haddockVerbosity = toFlag verbosity' @@ -648,9 +729,21 @@ else die $ "Unable to find cabal executable at: " ++ self -- helper -onFailure :: (Exception -> BuildFailure) -> IO BuildResult -> IO BuildResult -onFailure result = Exception.handle (return . Left . result) - +onFailure :: (SomeException -> BuildFailure) -> IO BuildResult -> IO BuildResult +onFailure result action = +#if MIN_VERSION_base(4,0,0) + action `catches` + [ Handler $ \ioe -> handler (ioe :: IOException) + , Handler $ \exit -> handler (exit :: ExitCode) + ] + where + handler :: Exception e => e -> IO BuildResult + handler = return . Left . result . toException +#else + action + `catchIO` (return . Left . result . IOException) + `catchExit` (return . Left . result . ExitException) +#endif withWin32SelfUpgrade :: Verbosity -> ConfigFlags @@ -661,7 +754,7 @@ withWin32SelfUpgrade verbosity configFlags compid pkg action = do defaultDirs <- InstallDirs.defaultInstallDirs - compilerFlavor + compFlavor (fromFlag (configUserInstall configFlags)) (PackageDescription.hasLibs pkg) @@ -670,7 +763,7 @@ where pkgid = packageId pkg - (CompilerId compilerFlavor _) = compid + (CompilerId compFlavor _) = compid exeInstallPaths defaultDirs = [ InstallDirs.bindir absoluteDirs exeName <.> exeExtension diff --git a/Distribution/Client/InstallPlan.hs b/Distribution/Client/InstallPlan.hs --- a/Distribution/Client/InstallPlan.hs +++ b/Distribution/Client/InstallPlan.hs @@ -45,27 +45,26 @@ import Distribution.Client.Types ( AvailablePackage(packageDescription), ConfiguredPackage(..) + , InstalledPackage , BuildFailure, BuildSuccess ) import Distribution.Package ( PackageIdentifier(..), PackageName(..), Package(..), packageName , PackageFixedDeps(..), Dependency(..) ) import Distribution.Version ( Version, withinRange ) -import Distribution.InstalledPackageInfo - ( InstalledPackageInfo ) import Distribution.PackageDescription ( GenericPackageDescription(genPackageFlags) , PackageDescription(buildDepends) , Flag(flagName), FlagName(..) ) import Distribution.PackageDescription.Configuration ( finalizePackageDescription ) -import Distribution.Simple.PackageIndex +import Distribution.Client.PackageIndex ( PackageIndex ) -import qualified Distribution.Simple.PackageIndex as PackageIndex +import qualified Distribution.Client.PackageIndex as PackageIndex import Distribution.Text ( display ) import Distribution.System - ( Platform(Platform) ) + ( Platform ) import Distribution.Compiler ( CompilerId(..) ) import Distribution.Client.Utils @@ -124,7 +123,7 @@ -- have problems with inconsistent dependencies. -- On the other hand it is true that every closed sub plan is valid. -data PlanPackage = PreExisting InstalledPackageInfo +data PlanPackage = PreExisting InstalledPackage | Configured ConfiguredPackage | Installed ConfiguredPackage BuildSuccess | Failed ConfiguredPackage BuildFailure @@ -455,7 +454,7 @@ configuredPackageProblems :: Platform -> CompilerId -> ConfiguredPackage -> [PackageProblem] -configuredPackageProblems (Platform arch os) comp +configuredPackageProblems platform comp (ConfiguredPackage pkg specifiedFlags specifiedDeps) = [ DuplicateFlag flag | ((flag,_):_) <- duplicates specifiedFlags ] ++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ] @@ -487,7 +486,9 @@ requiredDeps = --TODO: use something lower level than finalizePackageDescription case finalizePackageDescription specifiedFlags - (Nothing :: Maybe (PackageIndex PackageIdentifier)) os arch comp [] + (const True) + platform comp + [] (packageDescription pkg) of Right (resolvedPkg, _) -> buildDepends resolvedPkg Left _ -> error "configuredPackageInvalidDeps internal error" diff --git a/Distribution/Client/InstallSymlink.hs b/Distribution/Client/InstallSymlink.hs --- a/Distribution/Client/InstallSymlink.hs +++ b/Distribution/Client/InstallSymlink.hs @@ -58,9 +58,6 @@ import Distribution.Simple.Setup ( ConfigFlags(..), fromFlag, fromFlagOrDefault, flagToMaybe ) import qualified Distribution.Simple.InstallDirs as InstallDirs -import Distribution.Simple.PackageIndex (PackageIndex) -import Distribution.System - ( Platform(Platform) ) import System.Posix.Files ( getSymbolicLinkStatus, isSymbolicLink, createSymbolicLink @@ -135,8 +132,8 @@ pkgDescription :: ConfiguredPackage -> PackageDescription pkgDescription (ConfiguredPackage (AvailablePackage _ pkg _) flags _) = case finalizePackageDescription flags - (Nothing :: Maybe (PackageIndex PackageDescription)) - os arch compilerId [] pkg of + (const True) + platform compilerId [] pkg of Left _ -> error "finalizePackageDescription ConfiguredPackage failed" Right (desc, _) -> desc @@ -162,7 +159,7 @@ fromFlagTemplate = fromFlagOrDefault (InstallDirs.toPathTemplate "") prefixTemplate = fromFlagTemplate (configProgPrefix configFlags) suffixTemplate = fromFlagTemplate (configProgSuffix configFlags) - (Platform arch os) = InstallPlan.planPlatform plan + platform = InstallPlan.planPlatform plan compilerId@(CompilerId compilerFlavor _) = InstallPlan.planCompiler plan symlinkBinary :: FilePath -- ^ The canonical path of the public bin dir diff --git a/Distribution/Client/List.hs b/Distribution/Client/List.hs --- a/Distribution/Client/List.hs +++ b/Distribution/Client/List.hs @@ -15,10 +15,9 @@ import Distribution.Package ( PackageName(..), packageName, packageVersion - , Dependency(..), thisPackageVersion ) + , Dependency(..), thisPackageVersion, depends ) import Distribution.ModuleName (ModuleName) import Distribution.License (License) -import Distribution.InstalledPackageInfo (InstalledPackageInfo) import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.PackageDescription as Available import Distribution.PackageDescription @@ -26,12 +25,12 @@ import Distribution.PackageDescription.Configuration ( flattenPackageDescription ) -import Distribution.Simple.Configure (getInstalledPackages) -import Distribution.Simple.Compiler (Compiler,PackageDB) +import Distribution.Simple.Compiler + ( Compiler, PackageDBStack ) import Distribution.Simple.Program (ProgramConfiguration) import Distribution.Simple.Utils (equating, comparing, notice) import Distribution.Simple.Setup (fromFlag) -import qualified Distribution.Simple.PackageIndex as PackageIndex +import qualified Distribution.Client.PackageIndex as PackageIndex import Distribution.Version (Version) import Distribution.Verbosity (Verbosity) import Distribution.Text @@ -39,13 +38,14 @@ import Distribution.Client.Types ( AvailablePackage(..), Repo, AvailablePackageDb(..) - , UnresolvedDependency(..) ) + , UnresolvedDependency(..), InstalledPackage(..) ) import Distribution.Client.Setup ( ListFlags(..), InfoFlags(..) ) import Distribution.Client.Utils ( mergeBy, MergeResult(..) ) import Distribution.Client.IndexUtils as IndexUtils - ( getAvailablePackages, disambiguateDependencies ) + ( getAvailablePackages, disambiguateDependencies + , getInstalledPackages ) import Distribution.Client.Fetch ( isFetched ) @@ -64,15 +64,15 @@ -- |Show information about packages list :: Verbosity - -> PackageDB + -> PackageDBStack -> [Repo] -> Compiler -> ProgramConfiguration -> ListFlags -> [String] -> IO () -list verbosity packageDB repos comp conf listFlags pats = do - Just installed <- getInstalledPackages verbosity comp packageDB conf +list verbosity packageDBs repos comp conf listFlags pats = do + Just installed <- getInstalledPackages verbosity comp packageDBs conf AvailablePackageDb available _ <- getAvailablePackages verbosity repos let pkgs | null pats = (PackageIndex.allPackages installed ,PackageIndex.allPackages available) @@ -103,17 +103,17 @@ simpleOutput = fromFlag (listSimpleOutput listFlags) info :: Verbosity - -> PackageDB + -> PackageDBStack -> [Repo] -> Compiler -> ProgramConfiguration -> InfoFlags -> [UnresolvedDependency] --FIXME: just package names? or actually use the constraint -> IO () -info verbosity packageDB repos comp conf _listFlags deps = do +info verbosity packageDBs repos comp conf _listFlags deps = do AvailablePackageDb available _ <- getAvailablePackages verbosity repos deps' <- IndexUtils.disambiguateDependencies available deps - Just installed <- getInstalledPackages verbosity comp packageDB conf + Just 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'') @@ -128,9 +128,9 @@ -- data PackageDisplayInfo = PackageDisplayInfo { pkgname :: PackageName, - allInstalled :: [InstalledPackageInfo], + allInstalled :: [InstalledPackage], allAvailable :: [AvailablePackage], - latestInstalled :: Maybe InstalledPackageInfo, + latestInstalled :: Maybe InstalledPackage, latestAvailable :: Maybe AvailablePackage, homepage :: String, bugReports :: String, @@ -270,7 +270,7 @@ -- the input package info records are all supposed to refer to the same -- package name. -- -mergePackageInfo :: [InstalledPackageInfo] +mergePackageInfo :: [InstalledPackage] -> [AvailablePackage] -> PackageDisplayInfo mergePackageInfo installedPkgs availablePkgs = @@ -313,8 +313,7 @@ (maybe [] Available.exposedModules . Available.library) available, dependencies = combine Available.buildDepends available - (map thisPackageVersion - . Installed.depends) installed, + (map thisPackageVersion . depends) installed', haddockHtml = fromMaybe "" . join . fmap (listToMaybe . Installed.haddockHTMLs) $ installed, @@ -322,7 +321,8 @@ } where combine f x g y = fromJust (fmap f x `mplus` fmap g y) - installed = latest installedPkgs + installed' = latest installedPkgs + installed = fmap (\(InstalledPackage p _) -> p) installed' availableGeneric = fmap packageDescription (latest availablePkgs) available = fmap flattenPackageDescription availableGeneric latest [] = Nothing @@ -349,8 +349,8 @@ -- same package by name. In the result pairs, the lists are guaranteed to not -- both be empty. -- -mergePackages :: [InstalledPackageInfo] -> [AvailablePackage] - -> [([InstalledPackageInfo], [AvailablePackage])] +mergePackages :: [InstalledPackage] -> [AvailablePackage] + -> [([InstalledPackage], [AvailablePackage])] mergePackages installed available = map collect $ mergeBy (\i a -> fst i `compare` fst a) diff --git a/Distribution/Client/PackageIndex.hs b/Distribution/Client/PackageIndex.hs new file mode 100644 --- /dev/null +++ b/Distribution/Client/PackageIndex.hs @@ -0,0 +1,479 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Client.PackageIndex +-- Copyright : (c) David Himmelstrup 2005, +-- Bjorn Bringert 2007, +-- Duncan Coutts 2008 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- An index of packages. +-- +module Distribution.Client.PackageIndex ( + -- * Package index data type + PackageIndex, + + -- * Creating an index + fromList, + + -- * Updates + merge, + insert, + deletePackageName, + deletePackageId, + deleteDependency, + + -- * Queries + + -- ** Precise lookups + lookupPackageName, + lookupPackageId, + lookupDependency, + + -- ** Case-insensitive searches + searchByName, + SearchResult(..), + searchByNameSubstring, + + -- ** Bulk queries + allPackages, + allPackagesByName, + + -- ** Special queries + brokenPackages, + dependencyClosure, + reverseDependencyClosure, + topologicalOrder, + reverseTopologicalOrder, + dependencyInconsistencies, + dependencyCycles, + dependencyGraph, + ) where + +import Prelude hiding (lookup) +import Control.Exception (assert) +import qualified Data.Map as Map +import Data.Map (Map) +import qualified Data.Tree as Tree +import qualified Data.Graph as Graph +import qualified Data.Array as Array +import Data.Array ((!)) +import Data.List (groupBy, sortBy, nub, find, isInfixOf) +import Data.Monoid (Monoid(..)) +import Data.Maybe (isNothing, fromMaybe) + +import Distribution.Package + ( PackageName(..), PackageIdentifier(..) + , Package(..), packageName, packageVersion + , Dependency(Dependency), PackageFixedDeps(..) ) +import Distribution.Version + ( Version, withinRange ) +import Distribution.Simple.Utils (lowercase, equating, comparing) + + +-- | The collection of information about packages from one or more 'PackageDB's. +-- +-- It can be searched effeciently by package name and version. +-- +newtype Package pkg => PackageIndex pkg = PackageIndex + -- This index package names to all the package records matching that package + -- name case-sensitively. It includes all versions. + -- + -- This allows us to find all versions satisfying a dependency. + -- Most queries are a map lookup followed by a linear scan of the bucket. + -- + (Map PackageName [pkg]) + + deriving (Show, Read) + +instance Package pkg => Monoid (PackageIndex pkg) where + mempty = PackageIndex (Map.empty) + mappend = merge + --save one mappend with empty in the common case: + mconcat [] = mempty + mconcat xs = foldr1 mappend xs + +invariant :: Package pkg => PackageIndex pkg -> Bool +invariant (PackageIndex m) = all (uncurry goodBucket) (Map.toList m) + where + goodBucket _ [] = False + goodBucket name (pkg0:pkgs0) = check (packageId pkg0) pkgs0 + where + check pkgid [] = packageName pkgid == name + check pkgid (pkg':pkgs) = packageName pkgid == name + && pkgid < pkgid' + && check pkgid' pkgs + where pkgid' = packageId pkg' + +-- +-- * Internal helpers +-- + +mkPackageIndex :: Package pkg => Map PackageName [pkg] -> PackageIndex pkg +mkPackageIndex index = assert (invariant (PackageIndex index)) + (PackageIndex index) + +internalError :: String -> a +internalError name = error ("PackageIndex." ++ name ++ ": internal error") + +-- | Lookup a name in the index to get all packages that match that name +-- case-sensitively. +-- +lookup :: Package pkg => PackageIndex pkg -> PackageName -> [pkg] +lookup (PackageIndex m) name = fromMaybe [] $ Map.lookup name m + +-- +-- * Construction +-- + +-- | Build an index out of a bunch of packages. +-- +-- If there are duplicates, later ones mask earlier ones. +-- +fromList :: Package pkg => [pkg] -> PackageIndex pkg +fromList pkgs = mkPackageIndex + . Map.map fixBucket + . Map.fromListWith (++) + $ [ (packageName pkg, [pkg]) + | pkg <- pkgs ] + where + fixBucket = -- out of groups of duplicates, later ones mask earlier ones + -- but Map.fromListWith (++) constructs groups in reverse order + map head + -- Eq instance for PackageIdentifier is wrong, so use Ord: + . groupBy (\a b -> EQ == comparing packageId a b) + -- relies on sortBy being a stable sort so we + -- can pick consistently among duplicates + . sortBy (comparing packageId) + +-- +-- * Updates +-- + +-- | Merge two indexes. +-- +-- Packages from the second mask packages of the same exact name +-- (case-sensitively) from the first. +-- +merge :: Package pkg => PackageIndex pkg -> PackageIndex pkg -> PackageIndex pkg +merge i1@(PackageIndex m1) i2@(PackageIndex m2) = + assert (invariant i1 && invariant i2) $ + mkPackageIndex (Map.unionWith mergeBuckets m1 m2) + +-- | Elements in the second list mask those in the first. +mergeBuckets :: Package pkg => [pkg] -> [pkg] -> [pkg] +mergeBuckets [] ys = ys +mergeBuckets xs [] = xs +mergeBuckets xs@(x:xs') ys@(y:ys') = + case packageId x `compare` packageId y of + GT -> y : mergeBuckets xs ys' + EQ -> y : mergeBuckets xs' ys' + LT -> x : mergeBuckets xs' ys + +-- | Inserts a single package into the index. +-- +-- This is equivalent to (but slightly quicker than) using 'mappend' or +-- 'merge' with a singleton index. +-- +insert :: Package pkg => pkg -> PackageIndex pkg -> PackageIndex pkg +insert pkg (PackageIndex index) = mkPackageIndex $ + Map.insertWith (\_ -> insertNoDup) (packageName pkg) [pkg] index + where + pkgid = packageId pkg + insertNoDup [] = [pkg] + insertNoDup pkgs@(pkg':pkgs') = case compare pkgid (packageId pkg') of + LT -> pkg : pkgs + EQ -> pkg : pkgs' + GT -> pkg' : insertNoDup pkgs' + +-- | Internal delete helper. +-- +delete :: Package pkg => PackageName -> (pkg -> Bool) -> PackageIndex pkg -> PackageIndex pkg +delete name p (PackageIndex index) = mkPackageIndex $ + Map.update filterBucket name index + where + filterBucket = deleteEmptyBucket + . filter (not . p) + deleteEmptyBucket [] = Nothing + deleteEmptyBucket remaining = Just remaining + +-- | Removes a single package from the index. +-- +deletePackageId :: Package pkg => PackageIdentifier -> PackageIndex pkg -> PackageIndex pkg +deletePackageId pkgid = + delete (packageName pkgid) (\pkg -> packageId pkg == pkgid) + +-- | Removes all packages with this (case-sensitive) name from the index. +-- +deletePackageName :: Package pkg => PackageName -> PackageIndex pkg -> PackageIndex pkg +deletePackageName name = + delete name (\pkg -> packageName pkg == name) + +-- | Removes all packages satisfying this dependency from the index. +-- +deleteDependency :: Package pkg => Dependency -> PackageIndex pkg -> PackageIndex pkg +deleteDependency (Dependency name verstionRange) = + delete name (\pkg -> packageVersion pkg `withinRange` verstionRange) + +-- +-- * Bulk queries +-- + +-- | Get all the packages from the index. +-- +allPackages :: Package pkg => PackageIndex pkg -> [pkg] +allPackages (PackageIndex m) = concat (Map.elems m) + +-- | Get all the packages from the index. +-- +-- They are grouped by package name, case-sensitively. +-- +allPackagesByName :: Package pkg => PackageIndex pkg -> [[pkg]] +allPackagesByName (PackageIndex m) = Map.elems m + +-- +-- * Lookups +-- + +-- | Does a lookup by package id (name & version). +-- +-- Since multiple package DBs mask each other case-sensitively by package name, +-- then we get back at most one package. +-- +lookupPackageId :: Package pkg => PackageIndex pkg -> PackageIdentifier -> Maybe pkg +lookupPackageId index pkgid = + case [ pkg | pkg <- lookup index (packageName pkgid) + , packageId pkg == pkgid ] of + [] -> Nothing + [pkg] -> Just pkg + _ -> internalError "lookupPackageIdentifier" + +-- | Does a case-sensitive search by package name. +-- +lookupPackageName :: Package pkg => PackageIndex pkg -> PackageName -> [pkg] +lookupPackageName index name = + [ pkg | pkg <- lookup index name + , packageName pkg == name ] + +-- | Does a case-sensitive search by package name and a range of versions. +-- +-- We get back any number of versions of the specified package name, all +-- satisfying the version range constraint. +-- +lookupDependency :: Package pkg => PackageIndex pkg -> Dependency -> [pkg] +lookupDependency index (Dependency name versionRange) = + [ pkg | pkg <- lookup index name + , packageName pkg == name + , packageVersion pkg `withinRange` versionRange ] + +-- +-- * Case insensitive name lookups +-- + +-- | Does a case-insensitive search by package name. +-- +-- If there is only one package that compares case-insentiviely to this name +-- then the search is unambiguous and we get back all versions of that package. +-- If several match case-insentiviely but one matches exactly then it is also +-- unambiguous. +-- +-- If however several match case-insentiviely and none match exactly then we +-- have an ambiguous result, and we get back all the versions of all the +-- packages. The list of ambiguous results is split by exact package name. So +-- it is a non-empty list of non-empty lists. +-- +searchByName :: Package pkg => PackageIndex pkg -> String -> SearchResult [pkg] +searchByName (PackageIndex m) name = + case [ pkgs | pkgs@(PackageName name',_) <- Map.toList m + , lowercase name' == lname ] of + [] -> None + [(_,pkgs)] -> Unambiguous pkgs + pkgss -> case find ((PackageName name==) . fst) pkgss of + Just (_,pkgs) -> Unambiguous pkgs + Nothing -> Ambiguous (map snd pkgss) + where lname = lowercase name + +data SearchResult a = None | Unambiguous a | Ambiguous [a] + +-- | Does a case-insensitive substring search by package name. +-- +-- That is, all packages that contain the given string in their name. +-- +searchByNameSubstring :: Package pkg => PackageIndex pkg -> String -> [pkg] +searchByNameSubstring (PackageIndex m) searchterm = + [ pkg + | (PackageName name, pkgs) <- Map.toList m + , lsearchterm `isInfixOf` lowercase name + , pkg <- pkgs ] + where lsearchterm = lowercase searchterm + +-- +-- * Special queries +-- + +-- | All packages that have dependencies that are not in the index. +-- +-- Returns such packages along with the dependencies that they're missing. +-- +brokenPackages :: PackageFixedDeps pkg + => PackageIndex pkg + -> [(pkg, [PackageIdentifier])] +brokenPackages index = + [ (pkg, missing) + | pkg <- allPackages index + , let missing = [ pkg' | pkg' <- depends pkg + , isNothing (lookupPackageId index pkg') ] + , not (null missing) ] + +-- | Tries to take the transative closure of the package dependencies. +-- +-- If the transative closure is complete then it returns that subset of the +-- index. Otherwise it returns the broken packages as in 'brokenPackages'. +-- +-- * Note that if the result is @Right []@ it is because at least one of +-- the original given 'PackageIdentifier's do not occur in the index. +-- +dependencyClosure :: PackageFixedDeps pkg + => PackageIndex pkg + -> [PackageIdentifier] + -> Either (PackageIndex pkg) + [(pkg, [PackageIdentifier])] +dependencyClosure index pkgids0 = case closure mempty [] pkgids0 of + (completed, []) -> Left completed + (completed, _) -> Right (brokenPackages completed) + where + closure completed failed [] = (completed, failed) + closure completed failed (pkgid:pkgids) = case lookupPackageId index pkgid of + Nothing -> closure completed (pkgid:failed) pkgids + Just pkg -> case lookupPackageId completed (packageId pkg) of + Just _ -> closure completed failed pkgids + Nothing -> closure completed' failed pkgids' + where completed' = insert pkg completed + pkgids' = depends pkg ++ pkgids + +-- | Takes the transative closure of the packages reverse dependencies. +-- +-- * The given 'PackageIdentifier's must be in the index. +-- +reverseDependencyClosure :: PackageFixedDeps pkg + => PackageIndex pkg + -> [PackageIdentifier] + -> [pkg] +reverseDependencyClosure index = + map vertexToPkg + . concatMap Tree.flatten + . Graph.dfs reverseDepGraph + . map (fromMaybe noSuchPkgId . pkgIdToVertex) + + where + (depGraph, vertexToPkg, pkgIdToVertex) = dependencyGraph index + reverseDepGraph = Graph.transposeG depGraph + noSuchPkgId = error "reverseDependencyClosure: package is not in the graph" + +topologicalOrder :: PackageFixedDeps pkg => PackageIndex pkg -> [pkg] +topologicalOrder index = map toPkgId + . Graph.topSort + $ graph + where (graph, toPkgId, _) = dependencyGraph index + +reverseTopologicalOrder :: PackageFixedDeps pkg => PackageIndex pkg -> [pkg] +reverseTopologicalOrder index = map toPkgId + . Graph.topSort + . Graph.transposeG + $ graph + where (graph, toPkgId, _) = dependencyGraph index + +-- | Given a package index where we assume we want to use all the packages +-- (use 'dependencyClosure' if you need to get such a index subset) find out +-- if the dependencies within it use consistent versions of each package. +-- Return all cases where multiple packages depend on different versions of +-- some other package. +-- +-- Each element in the result is a package name along with the packages that +-- depend on it and the versions they require. These are guaranteed to be +-- distinct. +-- +dependencyInconsistencies :: PackageFixedDeps pkg + => PackageIndex pkg + -> [(PackageName, [(PackageIdentifier, Version)])] +dependencyInconsistencies index = + [ (name, inconsistencies) + | (name, uses) <- Map.toList inverseIndex + , let inconsistencies = duplicatesBy uses + versions = map snd inconsistencies + , reallyIsInconsistent name (nub versions) ] + + where inverseIndex = Map.fromListWith (++) + [ (packageName dep, [(packageId pkg, packageVersion dep)]) + | pkg <- allPackages index + , dep <- depends pkg ] + + duplicatesBy = (\groups -> if length groups == 1 + then [] + else concat groups) + . groupBy (equating snd) + . sortBy (comparing snd) + + reallyIsInconsistent :: PackageName -> [Version] -> Bool + reallyIsInconsistent _ [] = False + reallyIsInconsistent name [v1, v2] = + case (mpkg1, mpkg2) of + (Just pkg1, Just pkg2) -> pkgid1 `notElem` depends pkg2 + && pkgid2 `notElem` depends pkg1 + _ -> True + where + pkgid1 = PackageIdentifier name v1 + pkgid2 = PackageIdentifier name v2 + mpkg1 = lookupPackageId index pkgid1 + mpkg2 = lookupPackageId index pkgid2 + + reallyIsInconsistent _ _ = True + +-- | Find if there are any cycles in the dependency graph. If there are no +-- cycles the result is @[]@. +-- +-- This actually computes the strongly connected components. So it gives us a +-- list of groups of packages where within each group they all depend on each +-- other, directly or indirectly. +-- +dependencyCycles :: PackageFixedDeps pkg + => PackageIndex pkg + -> [[pkg]] +dependencyCycles index = + [ vs | Graph.CyclicSCC vs <- Graph.stronglyConnComp adjacencyList ] + where + adjacencyList = [ (pkg, packageId pkg, depends pkg) + | pkg <- allPackages index ] + +-- | Builds a graph of the package dependencies. +-- +-- Dependencies on other packages that are not in the index are discarded. +-- You can check if there are any such dependencies with 'brokenPackages'. +-- +dependencyGraph :: PackageFixedDeps pkg + => PackageIndex pkg + -> (Graph.Graph, + Graph.Vertex -> pkg, + PackageIdentifier -> Maybe Graph.Vertex) +dependencyGraph index = (graph, vertexToPkg, pkgIdToVertex) + where + graph = Array.listArray bounds + [ [ v | Just v <- map pkgIdToVertex (depends pkg) ] + | pkg <- pkgs ] + vertexToPkg vertex = pkgTable ! vertex + pkgIdToVertex = binarySearch 0 topBound + + pkgTable = Array.listArray bounds pkgs + pkgIdTable = Array.listArray bounds (map packageId pkgs) + pkgs = sortBy (comparing packageId) (allPackages index) + topBound = length pkgs - 1 + bounds = (0, topBound) + + binarySearch a b key + | a > b = Nothing + | otherwise = case compare key (pkgIdTable ! mid) of + LT -> binarySearch a (mid-1) key + EQ -> Just mid + GT -> binarySearch (mid+1) b key + where mid = (a + b) `div` 2 diff --git a/Distribution/Client/Setup.hs b/Distribution/Client/Setup.hs --- a/Distribution/Client/Setup.hs +++ b/Distribution/Client/Setup.hs @@ -12,7 +12,7 @@ ----------------------------------------------------------------------------- module Distribution.Client.Setup ( globalCommand, GlobalFlags(..), globalRepos - , configureCommand, ConfigFlags(..), filterConfigureFlags, configPackageDB' + , configureCommand, ConfigFlags(..), filterConfigureFlags , configureExCommand, ConfigExFlags(..), defaultConfigExFlags , configureExOptions , installCommand, InstallFlags(..), installOptions, defaultInstallFlags @@ -25,6 +25,7 @@ , uploadCommand, UploadFlags(..) , reportCommand , unpackCommand, UnpackFlags(..) + , initCommand, IT.InitFlags(..) , parsePackageArgs --TODO: stop exporting these: @@ -36,6 +37,8 @@ ( Username(..), Password(..), Repo(..), RemoteRepo(..), LocalRepo(..) ) import Distribution.Client.BuildReports.Types ( ReportLevel(..) ) +import qualified Distribution.Client.Init.Types as IT + ( InitFlags(..), PackageType(..) ) import Distribution.Simple.Program ( defaultProgramConfiguration ) @@ -46,14 +49,12 @@ import Distribution.Simple.Setup ( ConfigFlags(..) ) import Distribution.Simple.Setup - ( Flag(..), toFlag, fromFlag, flagToList, flagToMaybe, fromFlagOrDefault + ( Flag(..), toFlag, fromFlag, flagToList, flagToMaybe , optionVerbosity, trueArg ) -import Distribution.Simple.Compiler - ( PackageDB(..) ) import Distribution.Simple.InstallDirs ( PathTemplate, toPathTemplate, fromPathTemplate ) import Distribution.Version - ( Version(Version), VersionRange(..) ) + ( Version(Version), anyVersion, thisVersion ) import Distribution.Package ( PackageIdentifier, packageName, packageVersion, Dependency(..) ) import Distribution.Text @@ -68,7 +69,7 @@ import Data.Char ( isSpace, isAlphaNum ) import Data.Maybe - ( listToMaybe, maybeToList ) + ( listToMaybe, maybeToList, fromMaybe ) import Data.Monoid ( Monoid(..) ) import Control.Monad @@ -195,15 +196,6 @@ configureOptions :: ShowOrParseArgs -> [OptionField ConfigFlags] configureOptions = commandOptions configureCommand -configPackageDB' :: ConfigFlags -> PackageDB -configPackageDB' config = - fromFlagOrDefault defaultDB (configPackageDB config) - where - defaultDB = case configUserInstall config of - NoFlag -> UserPackageDB - Flag True -> UserPackageDB - Flag False -> GlobalPackageDB - filterConfigureFlags :: ConfigFlags -> Version -> ConfigFlags filterConfigureFlags flags cabalLibVersion | cabalLibVersion >= Version [1,3,10] [] = flags @@ -459,6 +451,7 @@ -- data InstallFlags = InstallFlags { installDocumentation:: Flag Bool, + installHaddockIndex :: Flag PathTemplate, installDryRun :: Flag Bool, installReinstall :: Flag Bool, installOnly :: Flag Bool, @@ -472,6 +465,7 @@ defaultInstallFlags :: InstallFlags defaultInstallFlags = InstallFlags { installDocumentation= Flag False, + installHaddockIndex = Flag docIndexFile, installDryRun = Flag False, installReinstall = Flag False, installOnly = Flag False, @@ -481,6 +475,8 @@ installBuildReports = Flag NoReports, installSymlinkBinDir= mempty } + where + docIndexFile = toPathTemplate ("$datadir" "doc" "index.html") installCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags) installCommand = CommandUI { @@ -519,6 +515,12 @@ installDocumentation (\v flags -> flags { installDocumentation = v }) (boolOpt [] []) + , option [] ["doc-index-file"] + "A central index of haddock API documentation (template cannot use $pkgid)" + installHaddockIndex (\v flags -> flags { installHaddockIndex = v }) + (reqArg' "TEMPLATE" (toFlag.toPathTemplate) + (flagToList . fmap fromPathTemplate)) + , option [] ["dry-run"] "Do not install anything, only print what would be installed." installDryRun (\v flags -> flags { installDryRun = v }) @@ -570,6 +572,7 @@ instance Monoid InstallFlags where mempty = InstallFlags { installDocumentation= mempty, + installHaddockIndex = mempty, installDryRun = mempty, installReinstall = mempty, installOnly = mempty, @@ -581,6 +584,7 @@ } mappend a b = InstallFlags { installDocumentation= combine installDocumentation, + installHaddockIndex = combine installHaddockIndex, installDryRun = combine installDryRun, installReinstall = combine installReinstall, installOnly = combine installOnly, @@ -659,6 +663,164 @@ where combine field = field a `mappend` field b -- ------------------------------------------------------------ +-- * Init flags +-- ------------------------------------------------------------ + +emptyInitFlags :: IT.InitFlags +emptyInitFlags = mempty + +defaultInitFlags :: IT.InitFlags +defaultInitFlags = emptyInitFlags + +initCommand :: CommandUI IT.InitFlags +initCommand = CommandUI { + commandName = "init", + commandSynopsis = "Interactively create a .cabal file.", + commandUsage = \pname -> unlines + [ "Usage: " ++ pname ++ " init [FLAGS]" + , "" + , "Cabalise a project by creating a .cabal, Setup.lhs, and" + , "optionally a LICENSE file." + , "" + , "Calling init with no arguments (recommended) uses an" + , "interactive mode, which will try to guess as much as" + , "possible and prompt you for the rest. Command-line" + , "arguments are provided for scripting purposes." + , "If you don't want interactive mode, be sure to pass" + , "the -n flag." + , "" + , "Flags for init:" + ], + commandDescription = Nothing, + commandDefaultFlags = defaultInitFlags, + commandOptions = \_ -> + [ option ['n'] ["nonInteractive"] + "Non-interactive mode." + IT.nonInteractive (\v flags -> flags { IT.nonInteractive = v }) + trueArg + + , option ['q'] ["quiet"] + "Do not generate log messages to stdout." + IT.quiet (\v flags -> flags { IT.quiet = v }) + trueArg + + , option [] ["noComments"] + "Do not generate explanatory comments in the .cabal file." + IT.noComments (\v flags -> flags { IT.noComments = v }) + trueArg + + , option ['m'] ["minimal"] + "Generate a minimal .cabal file, that is, do not include extra empty fields. Also implies --noComments." + IT.minimal (\v flags -> flags { IT.minimal = v }) + trueArg + + , option [] ["packageDir"] + "Root directory of the package (default = current directory)." + IT.packageDir (\v flags -> flags { IT.packageDir = v }) + (reqArgFlag "DIRECTORY") + + , option ['p'] ["packageName"] + "Name of the Cabal package to create." + IT.packageName (\v flags -> flags { IT.packageName = v }) + (reqArgFlag "PACKAGE") + + , option [] ["version"] + "Initial version of the package." + IT.version (\v flags -> flags { IT.version = v }) + (reqArg "VERSION" (readP_to_E ("Cannot parse package version: "++) + (toFlag `fmap` parse)) + (flagToList . fmap display)) + + , option [] ["cabalVersion"] + "Required version of the Cabal library." + IT.cabalVersion (\v flags -> flags { IT.cabalVersion = v }) + (reqArg "VERSION_RANGE" (readP_to_E ("Cannot parse Cabal version range: "++) + (toFlag `fmap` parse)) + (flagToList . fmap display)) + + , option ['l'] ["license"] + "Project license." + IT.license (\v flags -> flags { IT.license = v }) + (reqArg "LICENSE" (readP_to_E ("Cannot parse license: "++) + (toFlag `fmap` parse)) + (flagToList . fmap display)) + + , option ['a'] ["author"] + "Name of the project's author." + IT.author (\v flags -> flags { IT.author = v }) + (reqArgFlag "NAME") + + , option ['e'] ["email"] + "Email address of the maintainer." + IT.email (\v flags -> flags { IT.email = v }) + (reqArgFlag "EMAIL") + + , option [] ["stability"] + "Package stability." + IT.stability (\v flags -> flags { IT.stability = v }) + (reqArg' "STABILITY" (\s -> toFlag $ maybe (Left s) Right (readMaybe s)) + (flagToList . fmap (either id show))) + + , option ['u'] ["homepage"] + "Project homepage and/or repository." + IT.homepage (\v flags -> flags { IT.homepage = v }) + (reqArgFlag "URL") + + , option ['s'] ["synopsis"] + "Short project synopsis." + IT.synopsis (\v flags -> flags { IT.synopsis = v }) + (reqArgFlag "TEXT") + + , option ['c'] ["category"] + "Project category." + IT.category (\v flags -> flags { IT.category = v }) + (reqArg' "CATEGORY" (\s -> toFlag $ maybe (Left s) Right (readMaybe s)) + (flagToList . fmap (either id show))) + + , option [] ["isLibrary"] + "Build a library." + IT.packageType (\v flags -> flags { IT.packageType = v }) + (noArg (Flag IT.Library)) + + , option [] ["isExecutable"] + "Build an executable." + IT.packageType + (\v flags -> flags { IT.packageType = v }) + (noArg (Flag IT.Executable)) + + , option ['o'] ["exposeModule"] + "Export a module from the package." + IT.exposedModules + (\v flags -> flags { IT.exposedModules = v }) + (reqArg "MODULE" (readP_to_E ("Cannot parse module name: "++) + ((Just . (:[])) `fmap` parse)) + (fromMaybe [] . fmap (fmap display))) + + , option ['d'] ["dependency"] + "Package dependency." + IT.dependencies (\v flags -> flags { IT.dependencies = v }) + (reqArg "PACKAGE" (readP_to_E ("Cannot parse dependency: "++) + ((Just . (:[])) `fmap` parse)) + (fromMaybe [] . fmap (fmap display))) + + , option [] ["sourceDir"] + "Directory containing package source." + IT.sourceDirs (\v flags -> flags { IT.sourceDirs = v }) + (reqArg' "DIR" (Just . (:[])) + (fromMaybe [])) + + , option [] ["buildTool"] + "Required external build tool." + IT.buildTools (\v flags -> flags { IT.buildTools = v }) + (reqArg' "TOOL" (Just . (:[])) + (fromMaybe [])) + ] + } + where readMaybe s = case reads s of + [(x,"")] -> Just x + _ -> Nothing + +-- ------------------------------------------------------------ -- * GetOpt Utils -- ------------------------------------------------------------ @@ -700,8 +862,8 @@ where pkgidToDependency :: PackageIdentifier -> Dependency pkgidToDependency p = case packageVersion p of - Version [] _ -> Dependency (packageName p) AnyVersion - version -> Dependency (packageName p) (ThisVersion version) + Version [] _ -> Dependency (packageName p) anyVersion + version -> Dependency (packageName p) (thisVersion version) showRepo :: RemoteRepo -> String showRepo repo = remoteRepoName repo ++ ":" diff --git a/Distribution/Client/SetupWrapper.hs b/Distribution/Client/SetupWrapper.hs --- a/Distribution/Client/SetupWrapper.hs +++ b/Distribution/Client/SetupWrapper.hs @@ -20,10 +20,14 @@ defaultSetupScriptOptions, ) where +import Distribution.Client.Types + ( InstalledPackage ) + import qualified Distribution.Make as Make import qualified Distribution.Simple as Simple import Distribution.Version - ( Version(..), VersionRange(..), withinRange ) + ( Version(..), VersionRange, anyVersion, intersectVersionRanges + , withinRange ) import Distribution.Package ( PackageIdentifier(..), PackageName(..), Package(..), packageName , packageVersion, Dependency(..) ) @@ -32,12 +36,10 @@ , PackageDescription(..), BuildType(..) ) import Distribution.PackageDescription.Parse ( readPackageDescription ) -import Distribution.InstalledPackageInfo - ( InstalledPackageInfo ) import Distribution.Simple.Configure - ( configCompiler, getInstalledPackages ) + ( configCompiler ) import Distribution.Simple.Compiler - ( CompilerFlavor(GHC), Compiler, PackageDB(..) ) + ( CompilerFlavor(GHC), Compiler, PackageDB(..), PackageDBStack ) import Distribution.Simple.Program ( ProgramConfiguration, emptyProgramConfiguration , rawSystemProgramConf, ghcProgram ) @@ -47,13 +49,15 @@ ( CommandUI(..), commandShowOptions ) import Distribution.Simple.GHC ( ghcVerbosityOptions ) -import qualified Distribution.Simple.PackageIndex as PackageIndex -import Distribution.Simple.PackageIndex (PackageIndex) +import qualified Distribution.Client.PackageIndex as PackageIndex +import Distribution.Client.PackageIndex (PackageIndex) +import Distribution.Client.IndexUtils + ( getInstalledPackages ) import Distribution.Simple.Utils ( die, debug, info, cabalVersion, findPackageDesc, comparing - , createDirectoryIfMissingVerbose ) + , createDirectoryIfMissingVerbose, rewriteFile ) import Distribution.Client.Utils - ( moreRecentFile, rewriteFile, inDir ) + ( moreRecentFile, inDir ) import Distribution.Text ( display ) import Distribution.Verbosity @@ -73,8 +77,8 @@ data SetupScriptOptions = SetupScriptOptions { useCabalVersion :: VersionRange, useCompiler :: Maybe Compiler, - usePackageDB :: PackageDB, - usePackageIndex :: Maybe (PackageIndex InstalledPackageInfo), + usePackageDB :: PackageDBStack, + usePackageIndex :: Maybe (PackageIndex InstalledPackage), useProgramConfig :: ProgramConfiguration, useDistPref :: FilePath, useLoggingHandle :: Maybe Handle, @@ -83,9 +87,9 @@ defaultSetupScriptOptions :: SetupScriptOptions defaultSetupScriptOptions = SetupScriptOptions { - useCabalVersion = AnyVersion, + useCabalVersion = anyVersion, useCompiler = Nothing, - usePackageDB = UserPackageDB, + usePackageDB = [GlobalPackageDB, UserPackageDB], usePackageIndex = Nothing, useProgramConfig = emptyProgramConfiguration, useDistPref = defaultDistPref, @@ -104,7 +108,7 @@ pkg <- maybe getPkg return mpkg let setupMethod = determineSetupMethod options' buildType' options' = options { - useCabalVersion = IntersectVersionRanges + useCabalVersion = intersectVersionRanges (useCabalVersion options) (descCabalVersion pkg) } @@ -277,20 +281,30 @@ when outOfDate $ do debug verbosity "Setup script is out of date, compiling..." (_, conf, _) <- configureCompiler options' + --TODO: get Cabal's GHC module to export a GhcOptions type and render func rawSystemProgramConf verbosity ghcProgram conf $ ghcVerbosityOptions verbosity ++ ["--make", setupHsFile, "-o", setupProgFile ,"-odir", setupDir, "-hidir", setupDir ,"-i", "-i" ++ workingDir ] - ++ (case usePackageDB options' of - GlobalPackageDB -> ["-no-user-package-conf"] - UserPackageDB -> [] - SpecificPackageDB db -> ["-no-user-package-conf" - ,"-package-conf", db]) + ++ ghcPackageDbOptions (usePackageDB options') ++ if packageName pkg == PackageName "Cabal" then [] else ["-package", display cabalPkgid] - where cabalPkgid = PackageIdentifier (PackageName "Cabal") cabalLibVersion + where + cabalPkgid = PackageIdentifier (PackageName "Cabal") cabalLibVersion + + ghcPackageDbOptions :: PackageDBStack -> [String] + ghcPackageDbOptions dbstack = case dbstack of + (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs + (GlobalPackageDB:dbs) -> "-no-user-package-conf" + : concatMap specific dbs + _ -> ierror + where + specific (SpecificPackageDB db) = [ "-package-conf", db ] + specific _ = ierror + ierror = error "internal error: unexpected package db stack" + invokeSetupScript :: [String] -> IO () invokeSetupScript args = do diff --git a/Distribution/Client/SrcDist.hs b/Distribution/Client/SrcDist.hs --- a/Distribution/Client/SrcDist.hs +++ b/Distribution/Client/SrcDist.hs @@ -17,9 +17,7 @@ ( readPackageDescription ) import Distribution.Simple.Utils ( defaultPackageDesc, warn, notice, setupMessage - , createDirectoryIfMissingVerbose ) -import Distribution.Client.Utils - ( withTempDirectory ) + , createDirectoryIfMissingVerbose, withTempDirectory ) import Distribution.Simple.Setup (SDistFlags(..), fromFlag) import Distribution.Verbosity (Verbosity) import Distribution.Simple.PreProcess (knownSuffixHandlers) @@ -50,7 +48,7 @@ warn verbosity "Cannot run preprocessors. Run 'configure' command first." createDirectoryIfMissingVerbose verbosity True tmpTargetDir - withTempDirectory tmpTargetDir "sdist." $ \tmpDir -> do + withTempDirectory verbosity tmpTargetDir "sdist." $ \tmpDir -> do date <- toCalendarTime =<< getClockTime let pkg' | snapshot = snapshotPackage date pkg diff --git a/Distribution/Client/Types.hs b/Distribution/Client/Types.hs --- a/Distribution/Client/Types.hs +++ b/Distribution/Client/Types.hs @@ -13,19 +13,21 @@ module Distribution.Client.Types where import Distribution.Package - ( PackageName, PackageIdentifier(..), Package(..) + ( PackageName, PackageId, Package(..) , PackageFixedDeps(..), Dependency ) +import Distribution.InstalledPackageInfo + ( InstalledPackageInfo ) import Distribution.PackageDescription ( GenericPackageDescription, FlagAssignment ) -import Distribution.Simple.PackageIndex +import Distribution.Client.PackageIndex ( PackageIndex ) import Distribution.Version ( VersionRange ) import Data.Map (Map) import Network.URI (URI) -import Control.Exception - ( Exception ) +import Distribution.Compat.Exception + ( SomeException ) newtype Username = Username { unUsername :: String } newtype Password = Password { unPassword :: String } @@ -37,6 +39,29 @@ packagePreferences :: Map PackageName VersionRange } +-- | TODO: This is a hack to help us transition from Cabal-1.6 to 1.8. +-- What is new in 1.8 is that installed packages and dependencies between +-- installed packages are now identified by an opaque InstalledPackageId +-- rather than a source PackageId. +-- +-- We should use simply an 'InstalledPackageInfo' here but to ease the +-- transition we are temporarily using this variant where we pretend that +-- installed packages still specify their deps in terms of PackageIds. +-- +-- Crucially this means that 'InstalledPackage' can be an instance of +-- 'PackageFixedDeps' where as 'InstalledPackageInfo' is no longer an instance +-- of that class. This means we can make 'PackageIndex'es of InstalledPackage +-- where as the InstalledPackageInfo now has its own monomorphic index type. +-- +data InstalledPackage = InstalledPackage + InstalledPackageInfo + [PackageId] + +instance Package InstalledPackage where + packageId (InstalledPackage pkg _) = packageId pkg +instance PackageFixedDeps InstalledPackage where + depends (InstalledPackage _ deps) = deps + -- | A 'ConfiguredPackage' is a not-yet-installed package along with the -- total configuration information. The configuration information is total in -- the sense that it provides all the configuration information and so the @@ -45,7 +70,7 @@ data ConfiguredPackage = ConfiguredPackage AvailablePackage -- package info, including repo FlagAssignment -- complete flag assignment for the package - [PackageIdentifier] -- set of exact dependencies. These must be + [PackageId] -- set of exact dependencies. These must be -- consistent with the 'buildDepends' in the -- 'PackageDescrption' that you'd get by applying -- the flag assignment. @@ -61,7 +86,7 @@ -- | We re-use @GenericPackageDescription@ and use the @package-url@ -- field to store the tarball URI. data AvailablePackage = AvailablePackage { - packageInfoId :: PackageIdentifier, + packageInfoId :: PackageId, packageDescription :: GenericPackageDescription, packageSource :: AvailablePackageSource } @@ -111,12 +136,12 @@ deriving (Show) type BuildResult = Either BuildFailure BuildSuccess -data BuildFailure = DependentFailed PackageIdentifier - | DownloadFailed Exception - | UnpackFailed Exception - | ConfigureFailed Exception - | BuildFailed Exception - | InstallFailed Exception +data BuildFailure = DependentFailed PackageId + | DownloadFailed SomeException + | UnpackFailed SomeException + | ConfigureFailed SomeException + | BuildFailed SomeException + | InstallFailed SomeException data BuildSuccess = BuildOk DocsResult TestsResult data DocsResult = DocsNotTried | DocsFailed | DocsOk diff --git a/Distribution/Client/Unpack.hs b/Distribution/Client/Unpack.hs --- a/Distribution/Client/Unpack.hs +++ b/Distribution/Client/Unpack.hs @@ -17,12 +17,17 @@ ) where -import Distribution.Package ( packageId, Dependency(..) ) -import Distribution.Simple.PackageIndex as PackageIndex (lookupDependency) +import Distribution.Package + ( PackageId, packageId, Dependency(..) ) +import Distribution.Client.PackageIndex as PackageIndex (lookupDependency) import Distribution.Simple.Setup(fromFlag, fromFlagOrDefault) -import Distribution.Simple.Utils(info, notice, die) +import Distribution.Simple.Utils + ( notice, die ) +import Distribution.Verbosity + ( Verbosity ) import Distribution.Text(display) -import Distribution.Version (VersionRange(..)) +import Distribution.Version + ( anyVersion, intersectVersionRanges ) import Distribution.Client.Setup(UnpackFlags(unpackVerbosity, unpackDestDir)) @@ -35,11 +40,14 @@ import Distribution.Client.IndexUtils as IndexUtils (getAvailablePackages, disambiguateDependencies) -import System.Directory(createDirectoryIfMissing) -import Control.Monad(unless) +import System.Directory + ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist ) +import Control.Monad + ( unless, when ) import Data.Ord (comparing) import Data.List(null, maximumBy) -import System.FilePath(()) +import System.FilePath + ( (), addTrailingPathSeparator ) import qualified Data.Map as Map unpack :: UnpackFlags -> [Repo] -> [Dependency] -> IO () @@ -66,12 +74,8 @@ ++ " that satisfies " ++ display ver Right (AvailablePackage pkgid _ (RepoTarballPackage repo)) -> do - pkgPath <- fetchPackage verbosity repo pkgid - let pkgdir = display pkgid - notice verbosity $ "Unpacking " ++ pkgdir ++ "..." - info verbosity $ "Extracting " ++ pkgPath - ++ " to " ++ prefix pkgdir ++ "..." - Tar.extractTarGzFile prefix pkgdir pkgPath + pkgPath <- fetchPackage verbosity repo pkgid + unpackPackage verbosity prefix pkgid pkgPath Right (AvailablePackage _ _ LocalUnpackedPackage) -> error "Distribution.Client.Unpack.unpack: the impossible happened." @@ -80,6 +84,20 @@ prefix = fromFlagOrDefault "" (unpackDestDir flags) toUnresolved d = UnresolvedDependency d [] +unpackPackage :: Verbosity -> FilePath -> PackageId -> FilePath -> IO () +unpackPackage verbosity prefix pkgid pkgPath = do + let pkgdirname = display pkgid + pkgdir = prefix pkgdirname + pkgdir' = addTrailingPathSeparator pkgdir + existsDir <- doesDirectoryExist pkgdir + when existsDir $ die $ + "The directory \"" ++ pkgdir' ++ "\" already exists, not unpacking." + existsFile <- doesFileExist pkgdir + when existsFile $ die $ + "A file \"" ++ pkgdir ++ "\" is in the way, not unpacking." + notice verbosity $ "Unpacking to " ++ pkgdir' + Tar.extractTarGzFile prefix pkgdirname pkgPath + resolvePackages :: AvailablePackageDb -> [Dependency] -> [Either Dependency AvailablePackage] @@ -89,8 +107,8 @@ candidates dep@(Dependency name ver) = let [x,y] = map (PackageIndex.lookupDependency available) [ Dependency name - (maybe AnyVersion id (Map.lookup name prefs) - `IntersectVersionRanges` ver) + (maybe anyVersion id (Map.lookup name prefs) + `intersectVersionRanges` ver) , dep ] in if null x then y else x best d [] = Left d diff --git a/Distribution/Client/Update.hs b/Distribution/Client/Update.hs --- a/Distribution/Client/Update.hs +++ b/Distribution/Client/Update.hs @@ -18,9 +18,7 @@ ( Repo(..), RemoteRepo(..), LocalRepo(..), AvailablePackageDb(..) ) import Distribution.Client.Fetch ( downloadIndex ) -import qualified Distribution.Client.Utils as BS - ( writeFileAtomic ) -import qualified Distribution.Simple.PackageIndex as PackageIndex +import qualified Distribution.Client.PackageIndex as PackageIndex import Distribution.Client.IndexUtils ( getAvailablePackages ) import qualified Paths_cabal_install @@ -29,13 +27,13 @@ import Distribution.Package ( PackageName(..), packageVersion ) import Distribution.Version - ( VersionRange(AnyVersion), withinRange ) + ( anyVersion, withinRange ) import Distribution.Simple.Utils - ( warn, notice ) + ( warn, notice, writeFileAtomic ) import Distribution.Verbosity ( Verbosity ) -import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Char8 as BS import qualified Codec.Compression.GZip as GZip (decompress) import qualified Data.Map as Map import System.FilePath (dropExtension) @@ -58,15 +56,16 @@ notice verbosity $ "Downloading the latest package list from " ++ remoteRepoName remoteRepo indexPath <- downloadIndex verbosity remoteRepo (repoLocalDir repo) - BS.writeFileAtomic (dropExtension indexPath) . GZip.decompress - =<< BS.readFile indexPath + writeFileAtomic (dropExtension indexPath) . BS.unpack + . GZip.decompress + =<< BS.readFile indexPath checkForSelfUpgrade :: Verbosity -> [Repo] -> IO () checkForSelfUpgrade verbosity repos = do AvailablePackageDb available prefs <- getAvailablePackages verbosity repos let self = PackageName "cabal-install" - preferredVersionRange = fromMaybe AnyVersion (Map.lookup self prefs) + preferredVersionRange = fromMaybe anyVersion (Map.lookup self prefs) currentVersion = Paths_cabal_install.version laterPreferredVersions = [ packageVersion pkg diff --git a/Distribution/Client/Utils.hs b/Distribution/Client/Utils.hs --- a/Distribution/Client/Utils.hs +++ b/Distribution/Client/Utils.hs @@ -2,22 +2,11 @@ import Data.List ( sortBy, groupBy ) -import qualified Data.ByteString.Lazy as BS -import System.FilePath - ( (<.>), splitFileName ) -import Control.Monad - ( unless ) -import System.IO - ( openBinaryTempFile, hClose ) -import System.IO.Error - ( isDoesNotExistError ) import System.Directory - ( removeFile, renameFile, doesFileExist, getModificationTime - , getCurrentDirectory, setCurrentDirectory, removeDirectoryRecursive ) -import Distribution.Compat.TempFile - ( createTempDirectory ) + ( doesFileExist, getModificationTime + , getCurrentDirectory, setCurrentDirectory ) import qualified Control.Exception as Exception - ( handle, throwIO, evaluate, finally, bracket ) + ( finally ) -- | Generic merging utility. For sorted input lists this is a full outer join. -- @@ -48,23 +37,6 @@ moreThanOne (_:_:_) = True moreThanOne _ = False -writeFileAtomic :: FilePath -> BS.ByteString -> IO () -writeFileAtomic targetFile content = do - (tmpFile, tmpHandle) <- openBinaryTempFile targetDir template - Exception.handle (\err -> do hClose tmpHandle - removeFile tmpFile - Exception.throwIO err) $ do - BS.hPut tmpHandle content - hClose tmpHandle - renameFile tmpFile targetFile - where - template = targetName <.> "tmp" - targetDir | null targetDir_ = "." - | otherwise = targetDir_ - --TODO: remove this when takeDirectory/splitFileName is fixed - -- to always return a valid dir - (targetDir_,targetName) = splitFileName targetFile - -- | Compare the modification times of two files to see if the first is newer -- than the second. The first file must exist but the second need not. -- The expected use case is when the second file is generated using the first. @@ -78,28 +50,6 @@ else do tb <- getModificationTime b ta <- getModificationTime a return (ta > tb) - --- | Write a file but only if it would have new content. If we would be writing --- the same as the existing content then leave the file as is so that we do not --- update the file's modification time. --- -rewriteFile :: FilePath -> String -> IO () -rewriteFile path newContent = - flip catch mightNotExist $ do - existingContent <- readFile path - Exception.evaluate (length existingContent) - unless (existingContent == newContent) $ - writeFile path newContent - where - mightNotExist e | isDoesNotExistError e = writeFile path newContent - | otherwise = ioError e - ---TODO: replace with function from Cabal utils in next version -withTempDirectory :: FilePath -> String -> (FilePath -> IO a) -> IO a -withTempDirectory targetDir template = - Exception.bracket - (createTempDirectory targetDir template) - (removeDirectoryRecursive) -- | Executes the action in the specified directory. inDir :: Maybe FilePath -> IO () -> IO () diff --git a/Distribution/Compat/Exception.hs b/Distribution/Compat/Exception.hs new file mode 100644 --- /dev/null +++ b/Distribution/Compat/Exception.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -cpp #-} +{-# OPTIONS_NHC98 -cpp #-} +{-# OPTIONS_JHC -fcpp #-} +-- #hide +module Distribution.Compat.Exception ( + SomeException, + onException, + catchIO, + handleIO, + catchExit, + throwIOIO + ) where + +import System.Exit +import qualified Control.Exception as Exception +#if MIN_VERSION_base(4,0,0) +import Control.Exception (SomeException) +#else +import Control.Exception (Exception) +type SomeException = Exception +#endif + +onException :: IO a -> IO b -> IO a +#if MIN_VERSION_base(4,0,0) +onException = Exception.onException +#else +onException io what = io `Exception.catch` \e -> do what + Exception.throw e +#endif + +throwIOIO :: Exception.IOException -> IO a +#if MIN_VERSION_base(4,0,0) +throwIOIO = Exception.throwIO +#else +throwIOIO = Exception.throwIO . Exception.IOException +#endif + +catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a +#if MIN_VERSION_base(4,0,0) +catchIO = Exception.catch +#else +catchIO = Exception.catchJust Exception.ioErrors +#endif + +handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a +handleIO = flip catchIO + +catchExit :: IO a -> (ExitCode -> IO a) -> IO a +#if MIN_VERSION_base(4,0,0) +catchExit = Exception.catch +#else +catchExit = Exception.catchJust exitExceptions + where exitExceptions (Exception.ExitException ee) = Just ee + exitExceptions _ = Nothing +#endif diff --git a/Distribution/Compat/TempFile.hs b/Distribution/Compat/TempFile.hs --- a/Distribution/Compat/TempFile.hs +++ b/Distribution/Compat/TempFile.hs @@ -8,9 +8,20 @@ ) where import System.FilePath (()) -import System.Posix.Internals (mkdir, c_getpid) -import Foreign.C (withCString, getErrno, eEXIST, errnoToIOError) +#ifdef mingw32_HOST_OS +import System.Directory (createDirectory) +#else +import System.Posix.Directory (createDirectory) +#endif +import System.IO.Error (try, isAlreadyExistsError) +#if __NHC__ +import System.Posix.Types (CPid(..)) +foreign import ccall unsafe "getpid" c_getpid :: IO CPid +#else +import System.Posix.Internals (c_getpid) +#endif + createTempDirectory :: FilePath -> String -> IO FilePath createTempDirectory dir template = do pid <- c_getpid @@ -18,11 +29,15 @@ where findTempName x = do let dirpath = dir template ++ show x - res <- withCString dirpath $ \s -> mkdir s 0o700 - if res == 0 - then return dirpath - else do - errno <- getErrno - if errno == eEXIST - then findTempName (x+1) - else ioError (errnoToIOError "createTempDirectory" errno Nothing (Just dir)) + r <- try $ mkPrivateDir dirpath + case r of + Right _ -> return dirpath + Left e | isAlreadyExistsError e -> findTempName (x+1) + | otherwise -> ioError e + +mkPrivateDir :: String -> IO () +#ifdef mingw32_HOST_OS +mkPrivateDir s = System.Directory.createDirectory s +#else +mkPrivateDir s = System.Posix.Directory.createDirectory s 0o700 +#endif diff --git a/Distribution/Compat/Version.hs b/Distribution/Compat/Version.hs deleted file mode 100644 --- a/Distribution/Compat/Version.hs +++ /dev/null @@ -1,385 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Distribution.Compat.Version --- Copyright : Isaac Jones, Simon Marlow 2003-2004 --- Duncan Coutts 2008 --- --- Maintainer : cabal-devel@haskell.org --- Portability : portable --- - -{- Copyright (c) 2003-2004, Isaac Jones -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Isaac Jones nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} - -module Distribution.Compat.Version ( - - simplifyVersionRange, - - -- * Version intervals view - asVersionIntervals, - VersionInterval, - LowerBound(..), - UpperBound(..), - Bound(..), - - -- ** 'VersionIntervals' abstract type - -- | The 'VersionIntervals' type and the accompanying functions are exposed - -- primarily for completeness and testing purposes. In practice - -- 'asVersionIntervals' is the main function to use to - -- view a 'VersionRange' as a bunch of 'VersionInterval's. - -- - VersionIntervals, - toVersionIntervals, - fromVersionIntervals, - withinIntervals, - versionIntervals, - mkVersionIntervals, - unionVersionIntervals, - intersectVersionIntervals, - - ) where - -import Distribution.Version - -import Control.Exception (assert) - --- | The empty version range, that is a version range containing no versions. --- --- This can be constructed using any unsatisfiable version range expression, --- for example @> 1 && < 1@. --- --- > withinRange v anyVersion = False --- -noVersion :: VersionRange -noVersion = IntersectVersionRanges (LaterVersion v) (EarlierVersion v) - where v = Version [1] [] - --- | Fold over the syntactic structure of a 'VersionRange'. --- --- This provides a syntacic view of the expression defining the version range. --- For a semantic view use 'asVersionIntervals'. --- -foldVersionRange :: a -> (Version -> a) -> (Version -> a) -> (Version -> a) - -> (Version -> Version -> a) - -> (a -> a -> a) -> (a -> a -> a) - -> VersionRange -> a -foldVersionRange anyv this later earlier _wildcard union intersect = fold - where - fold AnyVersion = anyv - fold (ThisVersion v) = this v - fold (LaterVersion v) = later v - fold (EarlierVersion v) = earlier v - fold (UnionVersionRanges v1 v2) = union (fold v1) (fold v2) - fold (IntersectVersionRanges v1 v2) = intersect (fold v1) (fold v2) - --- | View a 'VersionRange' as a union of intervals. --- --- This provides a canonical view of the semantics of a 'VersionRange' as --- opposed to the syntax of the expression used to define it. For the syntactic --- view use 'foldVersionRange'. --- --- Each interval is non-empty. The sequence is in increasing order and no --- intervals overlap or touch. Therefore only the first and last can be --- unbounded. The sequence can be empty if the range is empty --- (e.g. a range expression like @< 1 && > 2@). --- --- Other checks are trivial to implement using this view. For example: --- --- > isNoVersion vr | [] <- asVersionIntervals vr = True --- > | otherwise = False --- --- > isSpecificVersion vr --- > | [(LowerBound v InclusiveBound --- > ,UpperBound v' InclusiveBound)] <- asVersionIntervals vr --- > , v == v' = Just v --- > | otherwise = Nothing --- -asVersionIntervals :: VersionRange -> [VersionInterval] -asVersionIntervals = versionIntervals . toVersionIntervals - --- | Simplify a 'VersionRange' expression into a canonical form. --- --- It just uses @fromVersionIntervals . toVersionIntervals@ --- --- It satisfies the following properties: --- --- > withinRange v (simplifyVersionRange r) = withinRange v r --- --- > withinRange v r = withinRange v r' --- > ==> simplifyVersionRange r = simplifyVersionRange r' --- -simplifyVersionRange :: VersionRange -> VersionRange -simplifyVersionRange = fromVersionIntervals . toVersionIntervals - ------------------- --- Intervals view --- - --- | A complementary representation of a 'VersionRange'. Instead of a boolean --- version predicate it uses an increasing sequence of non-overlapping, --- non-empty intervals. --- --- The key point is that this representation gives a canonical representation --- for the semantics of 'VersionRange's. This makes it easier to check things --- like whether a version range is empty, covers all versions, or requires a --- certain minimum or maximum version. It also makes it easy to check equality --- or containment. It also makes it easier to identify \'simple\' version --- predicates for translation into foreign packaging systems that do not --- support complex version range expressions. --- -newtype VersionIntervals = VersionIntervals [VersionInterval] - deriving (Eq, Show) - --- | Inspect the list of version intervals. --- -versionIntervals :: VersionIntervals -> [VersionInterval] -versionIntervals (VersionIntervals is) = is - -type VersionInterval = (LowerBound, UpperBound) -data LowerBound = LowerBound Version !Bound deriving (Eq, Show) -data UpperBound = NoUpperBound | UpperBound Version !Bound deriving (Eq, Show) -data Bound = ExclusiveBound | InclusiveBound deriving (Eq, Show) - -minLowerBound :: LowerBound -minLowerBound = LowerBound (Version [0] []) InclusiveBound - -isVersion0 :: Version -> Bool -isVersion0 (Version [0] _) = True -isVersion0 _ = False - -instance Ord LowerBound where - LowerBound ver bound <= LowerBound ver' bound' = case compare ver ver' of - LT -> True - EQ -> not (bound == ExclusiveBound && bound' == InclusiveBound) - GT -> False - -instance Ord UpperBound where - _ <= NoUpperBound = True - NoUpperBound <= UpperBound _ _ = False - UpperBound ver bound <= UpperBound ver' bound' = case compare ver ver' of - LT -> True - EQ -> not (bound == InclusiveBound && bound' == ExclusiveBound) - GT -> False - -invariant :: VersionIntervals -> Bool -invariant (VersionIntervals intervals) = all validInterval intervals - && all doesNotTouch' adjacentIntervals - where - doesNotTouch' :: (VersionInterval, VersionInterval) -> Bool - doesNotTouch' ((_,u), (l',_)) = doesNotTouch u l' - - adjacentIntervals :: [(VersionInterval, VersionInterval)] - adjacentIntervals - | null intervals = [] - | otherwise = zip intervals (tail intervals) - -checkInvariant :: VersionIntervals -> VersionIntervals -checkInvariant is = assert (invariant is) is - --- | Directly construct a 'VersionIntervals' from a list of intervals. --- --- Each interval must be non-empty. The sequence must be in increasing order --- and no invervals may overlap or touch. If any of these conditions are not --- satisfied the function returns @Nothing@. --- -mkVersionIntervals :: [VersionInterval] -> Maybe VersionIntervals -mkVersionIntervals intervals - | invariant (VersionIntervals intervals) = Just (VersionIntervals intervals) - | otherwise = Nothing - -validVersion :: Version -> Bool -validVersion (Version [] _) = False -validVersion (Version vs _) = all (>=0) vs - -validInterval :: (LowerBound, UpperBound) -> Bool -validInterval i@(l, u) = validLower l && validUpper u && nonEmpty i - where - validLower (LowerBound v _) = validVersion v - validUpper NoUpperBound = True - validUpper (UpperBound v _) = validVersion v - --- Check an interval is non-empty --- -nonEmpty :: VersionInterval -> Bool -nonEmpty (_, NoUpperBound ) = True -nonEmpty (LowerBound l lb, UpperBound u ub) = - (l < u) || (l == u && lb == InclusiveBound && ub == InclusiveBound) - --- Check an upper bound does not intersect, or even touch a lower bound: --- --- ---| or ---) but not ---] or ---) or ---] --- |--- (--- (--- [--- [--- --- -doesNotTouch :: UpperBound -> LowerBound -> Bool -doesNotTouch NoUpperBound _ = False -doesNotTouch (UpperBound u ub) (LowerBound l lb) = - u < l - || (u == l && ub == ExclusiveBound && lb == ExclusiveBound) - --- | Check an upper bound does not intersect a lower bound: --- --- ---| or ---) or ---] or ---) but not ---] --- |--- (--- (--- [--- [--- --- -doesNotIntersect :: UpperBound -> LowerBound -> Bool -doesNotIntersect NoUpperBound _ = False -doesNotIntersect (UpperBound u ub) (LowerBound l lb) = - u < l - || (u == l && not (ub == InclusiveBound && lb == InclusiveBound)) - --- | Test if a version falls within the version intervals. --- --- It exists mostly for completeness and testing. It satisfies the following --- properties: --- --- > withinIntervals v (toVersionIntervals vr) = withinRange v vr --- > withinIntervals v ivs = withinRange v (fromVersionIntervals ivs) --- -withinIntervals :: Version -> VersionIntervals -> Bool -withinIntervals v (VersionIntervals intervals) = any withinInterval intervals - where - withinInterval (lowerBound, upperBound) = withinLower lowerBound - && withinUpper upperBound - withinLower (LowerBound v' ExclusiveBound) = v' < v - withinLower (LowerBound v' InclusiveBound) = v' <= v - - withinUpper NoUpperBound = True - withinUpper (UpperBound v' ExclusiveBound) = v' > v - withinUpper (UpperBound v' InclusiveBound) = v' >= v - --- | Convert a 'VersionRange' to a sequence of version intervals. --- -toVersionIntervals :: VersionRange -> VersionIntervals -toVersionIntervals = foldVersionRange - ( chkIvl (minLowerBound, NoUpperBound)) - (\v -> chkIvl (LowerBound v InclusiveBound, UpperBound v InclusiveBound)) - (\v -> chkIvl (LowerBound v ExclusiveBound, NoUpperBound)) - (\v -> if isVersion0 v then VersionIntervals [] else - chkIvl (minLowerBound, UpperBound v ExclusiveBound)) - (\v v' -> chkIvl (LowerBound v InclusiveBound, UpperBound v' ExclusiveBound)) - unionVersionIntervals - intersectVersionIntervals - where - chkIvl interval = checkInvariant (VersionIntervals [interval]) - --- | Convert a 'VersionIntervals' value back into a 'VersionRange' expression --- representing the version intervals. --- -fromVersionIntervals :: VersionIntervals -> VersionRange -fromVersionIntervals (VersionIntervals []) = noVersion -fromVersionIntervals (VersionIntervals intervals) = - foldr1 UnionVersionRanges [ interval l u | (l, u) <- intervals ] - - where - interval (LowerBound v InclusiveBound) - (UpperBound v' InclusiveBound) | v == v' - = ThisVersion v - interval l u = lowerBound l `intersectVersionRanges'` upperBound u - - lowerBound (LowerBound v InclusiveBound) - | isVersion0 v = AnyVersion - | otherwise = orLaterVersion v - lowerBound (LowerBound v ExclusiveBound) = LaterVersion v - - upperBound NoUpperBound = AnyVersion - upperBound (UpperBound v InclusiveBound) = orEarlierVersion v - upperBound (UpperBound v ExclusiveBound) = EarlierVersion v - - intersectVersionRanges' vr AnyVersion = vr - intersectVersionRanges' AnyVersion vr = vr - intersectVersionRanges' vr vr' = IntersectVersionRanges vr vr' - -unionVersionIntervals :: VersionIntervals -> VersionIntervals - -> VersionIntervals -unionVersionIntervals (VersionIntervals is0) (VersionIntervals is'0) = - checkInvariant (VersionIntervals (union is0 is'0)) - where - union is [] = is - union [] is' = is' - union (i:is) (i':is') = case unionInterval i i' of - Left Nothing -> i : union is (i' :is') - Left (Just i'') -> union is (i'':is') - Right Nothing -> i' : union (i :is) is' - Right (Just i'') -> union (i'':is) is' - -unionInterval :: VersionInterval -> VersionInterval - -> Either (Maybe VersionInterval) (Maybe VersionInterval) -unionInterval (lower , upper ) (lower', upper') - - -- Non-intersecting intervals with the left interval ending first - | upper `doesNotTouch` lower' = Left Nothing - - -- Non-intersecting intervals with the right interval first - | upper' `doesNotTouch` lower = Right Nothing - - -- Complete or partial overlap, with the left interval ending first - | upper <= upper' = lowerBound `seq` - Left (Just (lowerBound, upper')) - - -- Complete or partial overlap, with the left interval ending first - | otherwise = lowerBound `seq` - Right (Just (lowerBound, upper)) - where - lowerBound = min lower lower' - -intersectVersionIntervals :: VersionIntervals -> VersionIntervals - -> VersionIntervals -intersectVersionIntervals (VersionIntervals is0) (VersionIntervals is'0) = - checkInvariant (VersionIntervals (intersect is0 is'0)) - where - intersect _ [] = [] - intersect [] _ = [] - intersect (i:is) (i':is') = case intersectInterval i i' of - Left Nothing -> intersect is (i':is') - Left (Just i'') -> i'' : intersect is (i':is') - Right Nothing -> intersect (i:is) is' - Right (Just i'') -> i'' : intersect (i:is) is' - -intersectInterval :: VersionInterval -> VersionInterval - -> Either (Maybe VersionInterval) (Maybe VersionInterval) -intersectInterval (lower , upper ) (lower', upper') - - -- Non-intersecting intervals with the left interval ending first - | upper `doesNotIntersect` lower' = Left Nothing - - -- Non-intersecting intervals with the right interval first - | upper' `doesNotIntersect` lower = Right Nothing - - -- Complete or partial overlap, with the left interval ending first - | upper <= upper' = lowerBound `seq` - Left (Just (lowerBound, upper)) - - -- Complete or partial overlap, with the right interval ending first - | otherwise = lowerBound `seq` - Right (Just (lowerBound, upper')) - where - lowerBound = max lower lower' - diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -17,15 +17,17 @@ ( GlobalFlags(..), globalCommand, globalRepos , ConfigFlags(..) , ConfigExFlags(..), configureExCommand - , InstallFlags(..), installCommand, upgradeCommand + , InstallFlags(..), defaultInstallFlags + , installCommand, upgradeCommand , fetchCommand, checkCommand , updateCommand , ListFlags(..), listCommand , InfoFlags(..), infoCommand , UploadFlags(..), uploadCommand + , InitFlags, initCommand , reportCommand , unpackCommand, UnpackFlags(..) - , parsePackageArgs, configPackageDB' ) + , parsePackageArgs ) import Distribution.Simple.Setup ( BuildFlags(..), buildCommand , HaddockFlags(..), haddockCommand @@ -53,16 +55,16 @@ 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.Compiler - ( Compiler, CompilerFlavor(GHC), compilerFlavor, compilerVersion ) -import Distribution.Version - ( Version(Version) ) -import Distribution.Simple.Utils (cabalVersion, die, intercalate) +import Distribution.Simple.Utils + ( cabalVersion, die, topHandler, intercalate ) import Distribution.Text ( display ) import Distribution.Verbosity as Verbosity @@ -76,7 +78,7 @@ import Data.List (intersperse) import Data.Maybe (fromMaybe) import Data.Monoid (Monoid(..)) -import Control.Monad (unless, when) +import Control.Monad (unless) -- | Entry point -- @@ -85,7 +87,7 @@ mainWorker :: [String] -> IO () mainWorker ("win32selfupgrade":args) = win32SelfUpgradeAction args -mainWorker args = +mainWorker args = topHandler $ case commandsRun globalCommand commands args of CommandHelp help -> printGlobalHelp help CommandList opts -> printOptionsList opts @@ -133,6 +135,7 @@ ,sdistCommand `commandAddAction` sdistAction ,reportCommand `commandAddAction` reportAction ,unpackCommand `commandAddAction` unpackAction + ,initCommand `commandAddAction` initAction ,wrapperAction (buildCommand defaultProgramConfiguration) buildVerbosity buildDistPref ,wrapperAction copyCommand @@ -176,7 +179,6 @@ configExFlags' = savedConfigureExFlags config `mappend` configExFlags globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, conf) <- configCompilerAux configFlags' - compVersionCheck comp configure verbosity (configPackageDB' configFlags') (globalRepos globalFlags') comp conf configFlags' configExFlags' extraArgs @@ -197,10 +199,10 @@ (configUserInstall configFlags) let configFlags' = savedConfigureFlags config `mappend` configFlags configExFlags' = savedConfigureExFlags config `mappend` configExFlags - installFlags' = savedInstallFlags config `mappend` installFlags + installFlags' = defaultInstallFlags `mappend` + savedInstallFlags config `mappend` installFlags globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, conf) <- configCompilerAux configFlags' - compVersionCheck comp install verbosity (configPackageDB' configFlags') (globalRepos globalFlags') comp conf configFlags' configExFlags' installFlags' @@ -214,7 +216,6 @@ let configFlags = savedConfigureFlags config globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, conf) <- configCompilerAux configFlags - compVersionCheck comp list verbosity (configPackageDB' configFlags) (globalRepos globalFlags') @@ -231,7 +232,6 @@ let configFlags = savedConfigureFlags config globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, conf) <- configCompilerAux configFlags - compVersionCheck comp info verbosity (configPackageDB' configFlags) (globalRepos globalFlags') @@ -262,7 +262,6 @@ installFlags' = savedInstallFlags config `mappend` installFlags globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, conf) <- configCompilerAux configFlags' - compVersionCheck comp upgrade verbosity (configPackageDB' configFlags') (globalRepos globalFlags') comp conf configFlags' configExFlags' installFlags' @@ -277,7 +276,6 @@ let configFlags = savedConfigureFlags config globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, conf) <- configCompilerAux configFlags - compVersionCheck comp fetch verbosity (configPackageDB' configFlags) (globalRepos globalFlags') comp conf @@ -348,6 +346,10 @@ config <- loadConfig verbosity (globalConfigFile globalFlags) mempty unpack flags (globalRepos (savedGlobalFlags config)) pkgs +initAction :: InitFlags -> [String] -> GlobalFlags -> IO () +initAction flags _extraArgs _globalFlags = do + initCabal flags + win32SelfUpgradeAction :: [String] -> IO () win32SelfUpgradeAction (pid:path:rest) = Win32SelfUpgrade.deleteOldExeFile verbosity (read pid) path @@ -358,15 +360,27 @@ _ -> Verbosity.normal win32SelfUpgradeAction _ = return () -compVersionCheck :: Compiler -> IO () -compVersionCheck comp = - when (compilerFlavor comp == GHC - && compilerVersion comp > Version [6,11] []) $ - die upgradeMessage - where - upgradeMessage = "This version of the cabal program is too old to work " - ++ "with ghc-6.12+. You will need to install the " - ++ "'cabal-install' package version 0.8 or higher.\nIf you " - ++ "still have an older ghc installed (eg 6.10.4), run:\n" - ++ "$ cabal install -w ghc-6.10.4 'cabal-install >= 0.8'" +-- +-- 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/README b/README --- a/README +++ b/README @@ -17,9 +17,9 @@ is sometimes packaged separately by Linux distributions, for example on debian or ubuntu it is in "libghc6-network-dev". -It requires three other Haskell packages that are not always installed: +It requires a few other Haskell packages that are not always installed: - * Cabal (version 1.6 or later) + * Cabal (version 1.8 or later) * HTTP (version 4000 or later) * zlib (version 0.4 or later) @@ -30,10 +30,11 @@ 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. -In future, cabal-install will be part of the Haskell Platform so will not need -to be installed separately. In the mean time however you have to install it -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: +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 diff --git a/bootstrap.sh b/bootstrap.sh --- a/bootstrap.sh +++ b/bootstrap.sh @@ -45,10 +45,12 @@ # Versions of the packages to install. # The version regex says what existing installed versions are ok. -CABAL_VER="1.6.0.2"; CABAL_VER_REGEXP="1\.6\." # == 1.6.* -HTTP_VER="4000.0.4"; HTTP_VER_REGEXP="4000\.0\.[3456789]" - # >= 4000.0.3 && < 4000.0.10 -ZLIB_VER="0.5.0.0"; ZLIB_VER_REGEXP="0\.[45]\." # >= 0.4 && < 0.6 +PARSEC_VER="2.1.0.1"; PARSEC_VER_REGEXP="2\." # == 2.* +NETWORK_VER="2.2.1.5"; NETWORK_VER_REGEXP="2\." # == 2.* +CABAL_VER="1.8.0.2"; CABAL_VER_REGEXP="1\.8\." # == 1.8.* +MTL_VER="1.1.0.2"; MTL_VER_REGEXP="1\.1\." # == 1.1.* +HTTP_VER="4000.0.8"; HTTP_VER_REGEXP="4000\.0" # == 4000.0.* +ZLIB_VER="0.5.2.0"; ZLIB_VER_REGEXP="0\.[45]\." # == 0.5.* HACKAGE_URL="http://hackage.haskell.org/packages/archive" @@ -192,15 +194,19 @@ # Actually do something! -dep_pkg "network" "[12]\." - -info_pkg "Cabal" ${CABAL_VER} ${CABAL_VER_REGEXP} -info_pkg "HTTP" ${HTTP_VER} ${HTTP_VER_REGEXP} -info_pkg "zlib" ${ZLIB_VER} ${ZLIB_VER_REGEXP} +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 "HTTP" ${HTTP_VER} ${HTTP_VER_REGEXP} +info_pkg "zlib" ${ZLIB_VER} ${ZLIB_VER_REGEXP} -do_pkg "Cabal" ${CABAL_VER} ${CABAL_VER_REGEXP} -do_pkg "HTTP" ${HTTP_VER} ${HTTP_VER_REGEXP} -do_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 "HTTP" ${HTTP_VER} ${HTTP_VER_REGEXP} +do_pkg "zlib" ${ZLIB_VER} ${ZLIB_VER_REGEXP} install_pkg "cabal-install" diff --git a/cabal-install.cabal b/cabal-install.cabal --- a/cabal-install.cabal +++ b/cabal-install.cabal @@ -1,5 +1,5 @@ Name: cabal-install -Version: 0.6.4 +Version: 0.8.0 Synopsis: The command-line interface for Cabal and Hackage. Description: The \'cabal\' command-line program simplifies the process of managing @@ -20,12 +20,21 @@ 2007 Bjorn Bringert 2007 Isaac Potoczny-Jones 2008-2009 Duncan Coutts -Stability: Experimental 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.0 + flag old-base description: Old, monolithic base default: False @@ -54,12 +63,18 @@ Distribution.Client.Dependency.TopDown.Types Distribution.Client.Dependency.Types Distribution.Client.Fetch + Distribution.Client.Haddock Distribution.Client.HttpUtils Distribution.Client.IndexUtils + Distribution.Client.Init + Distribution.Client.Init.Heuristics + Distribution.Client.Init.Licenses + Distribution.Client.Init.Types Distribution.Client.Install Distribution.Client.InstallPlan Distribution.Client.InstallSymlink Distribution.Client.List + Distribution.Client.PackageIndex Distribution.Client.Setup Distribution.Client.SetupWrapper Distribution.Client.SrcDist @@ -70,16 +85,17 @@ Distribution.Client.Upload Distribution.Client.Utils Distribution.Client.Win32SelfUpgrade + Distribution.Compat.Exception Distribution.Compat.TempFile - Distribution.Compat.Version Paths_cabal_install - build-depends: base >= 2 && < 4, - Cabal >= 1.6 && < 1.7, + build-depends: base >= 2 && < 5, + Cabal >= 1.8 && < 1.9, filepath >= 1.0, - network >= 1 && < 3, - HTTP >= 4000.0.2 && < 4001, - zlib >= 0.4 && < 0.6 + network >= 1 && < 3, + HTTP >= 4000.0.2 && < 4001, + zlib >= 0.4 && < 0.6, + time >= 1.1 && < 1.2 if flag(old-base) build-depends: base < 3 @@ -89,8 +105,8 @@ directory >= 1 && < 1.1, pretty >= 1 && < 1.1, random >= 1 && < 1.1, - containers >= 0.1 && < 0.3, - array >= 0.1 && < 0.3, + containers >= 0.1 && < 0.4, + array >= 0.1 && < 0.4, old-time >= 1 && < 1.1 if flag(bytestring-in-base) @@ -102,5 +118,5 @@ build-depends: Win32 >= 2 && < 3 cpp-options: -DWIN32 else - build-depends: unix >= 1.0 && < 2.4 + build-depends: unix >= 1.0 && < 2.5 extensions: CPP