packages feed

cabal-install 0.6.4 → 0.8.0

raw patch · 34 files changed

+4022/−783 lines, 34 filesdep +timedep ~Cabaldep ~arraydep ~base

Dependencies added: time

Dependency ranges changed: Cabal, array, base, containers, network, unix

Files

Distribution/Client/Configure.hs view
@@ -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
Distribution/Client/Dependency.hs view
@@ -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 =
Distribution/Client/Dependency/Bogus.hs view
@@ -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 ] 
Distribution/Client/Dependency/TopDown.hs view
@@ -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 
Distribution/Client/Dependency/TopDown/Constraints.hs view
@@ -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
Distribution/Client/Dependency/TopDown/Types.hs view
@@ -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
Distribution/Client/Dependency/Types.hs view
@@ -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]
Distribution/Client/Fetch.hs view
@@ -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"]   }
+ Distribution/Client/Haddock.hs view
@@ -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)
Distribution/Client/HttpUtils.hs view
@@ -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
Distribution/Client/IndexUtils.hs view
@@ -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'
+ Distribution/Client/Init.hs view
@@ -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
+ Distribution/Client/Init/Heuristics.hs view
@@ -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
+ Distribution/Client/Init/Licenses.hs view
@@ -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."+    , ""+    , "    <one line to give the program's name and a brief idea of what it does.>"+    , "    Copyright (C) <year>  <name of author>"+    , ""+    , "    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."+    , ""+    , "  <signature of Ty Coon>, 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. <http://fsf.org/>"+    , " 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."+    , ""+    , "    <one line to give the program's name and a brief idea of what it does.>"+    , "    Copyright (C) <year>  <name of author>"+    , ""+    , "    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 <http://www.gnu.org/licenses/>."+    , ""+    , "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:"+    , ""+    , "    <program>  Copyright (C) <year>  <name of author>"+    , "    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"+    , "<http://www.gnu.org/licenses/>."+    , ""+    , "  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"+    , "<http://www.gnu.org/philosophy/why-not-lgpl.html>."+    , ""+    ]++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."+    , ""+    , "    <one line to give the library's name and a brief idea of what it does.>"+    , "    Copyright (C) <year>  <name of author>"+    , ""+    , "    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."+    , ""+    , "  <signature of Ty Coon>, 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. <http://fsf.org/>"+    , " 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."+    ]+
+ Distribution/Client/Init/Types.hs view
@@ -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
Distribution/Client/Install.hs view
@@ -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
Distribution/Client/InstallPlan.hs view
@@ -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"
Distribution/Client/InstallSymlink.hs view
@@ -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
Distribution/Client/List.hs view
@@ -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)
+ Distribution/Client/PackageIndex.hs view
@@ -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
Distribution/Client/Setup.hs view
@@ -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 ++ ":"
Distribution/Client/SetupWrapper.hs view
@@ -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
Distribution/Client/SrcDist.hs view
@@ -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
Distribution/Client/Types.hs view
@@ -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
Distribution/Client/Unpack.hs view
@@ -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
Distribution/Client/Update.hs view
@@ -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
Distribution/Client/Utils.hs view
@@ -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 ()
+ Distribution/Compat/Exception.hs view
@@ -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
Distribution/Compat/TempFile.hs view
@@ -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
− Distribution/Compat/Version.hs
@@ -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'-
Main.hs view
@@ -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)
README view
@@ -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
bootstrap.sh view
@@ -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" 
cabal-install.cabal view
@@ -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 <bjorn@bringert.net>                     2007 Isaac Potoczny-Jones <ijones@syntaxpolice.org>                     2008-2009 Duncan Coutts <duncan@haskell.org>-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