cabal-install-ghc72 (empty) → 0.10.3

raw patch · 56 files changed

+14424/−0 lines, 56 filesdep +Cabaldep +HTTPdep +Win32setup-changedbinary-added

Dependencies added: Cabal, HTTP, Win32, array, base, bytestring, containers, directory, filepath, network, old-time, pretty, process, random, time, unix, zlib

Files

• ._Main.hs binary
• ._bootstrap.sh binary
• ._cabal-install-ghc72.cabal binary
• Distribution/Client/._HttpUtils.hs binary
• Distribution/Client/._Install.hs binary
• Distribution/Client/._Update.hs binary
• Distribution/Client/BuildReports/._Anonymous.hs binary
• Distribution/Client/BuildReports/Anonymous.hs +311/−0
• Distribution/Client/BuildReports/Storage.hs +127/−0
• Distribution/Client/BuildReports/Types.hs +44/−0
• Distribution/Client/BuildReports/Upload.hs +74/−0
• Distribution/Client/Check.hs +85/−0
• Distribution/Client/Config.hs +532/−0
• Distribution/Client/Configure.hs +191/−0
• Distribution/Client/Dependency.hs +441/−0
• Distribution/Client/Dependency/TopDown.hs +776/−0
• Distribution/Client/Dependency/TopDown/Constraints.hs +316/−0
• Distribution/Client/Dependency/TopDown/Types.hs +93/−0
• Distribution/Client/Dependency/Types.hs +115/−0
• Distribution/Client/Fetch.hs +171/−0
• Distribution/Client/FetchUtils.hs +193/−0
• Distribution/Client/GZipUtils.hs +44/−0
• Distribution/Client/Haddock.hs +105/−0
• Distribution/Client/HttpUtils.hs +197/−0
• Distribution/Client/IndexUtils.hs +265/−0
• Distribution/Client/Init.hs +556/−0
• Distribution/Client/Init/Heuristics.hs +191/−0
• Distribution/Client/Init/Licenses.hs +1722/−0
• Distribution/Client/Init/Types.hs +152/−0
• Distribution/Client/Install.hs +875/−0
• Distribution/Client/InstallPlan.hs +511/−0
• Distribution/Client/InstallSymlink.hs +238/−0
• Distribution/Client/List.hs +528/−0
• Distribution/Client/PackageIndex.hs +478/−0
• Distribution/Client/PackageUtils.hs +34/−0
• Distribution/Client/Setup.hs +1009/−0
• Distribution/Client/SetupWrapper.hs +320/−0
• Distribution/Client/SrcDist.hs +80/−0
• Distribution/Client/Tar.hs +903/−0
• Distribution/Client/Targets.hs +657/−0
• Distribution/Client/Types.hs +163/−0
• Distribution/Client/Unpack.hs +121/−0
• Distribution/Client/Update.hs +82/−0
• Distribution/Client/Upload.hs +190/−0
• Distribution/Client/Utils.hs +60/−0
• Distribution/Client/Win32SelfUpgrade.hs +222/−0
• Distribution/Client/World.hs +173/−0
• Distribution/Compat/Exception.hs +56/−0
• Distribution/Compat/FilePerms.hs +40/−0
• LICENSE +34/−0
• Main.hs +403/−0
• README +153/−0
• Setup.hs +2/−0
• bash-completion/cabal +24/−0
• bootstrap.sh +232/−0
• cabal-install-ghc72.cabal +135/−0

binary file changed (absent → 171 bytes)

binary file changed (absent → 171 bytes)

binary file changed (absent → 171 bytes)

binary file changed (absent → 171 bytes)

binary file changed (absent → 171 bytes)

binary file changed (absent → 171 bytes)

binary file changed (absent → 171 bytes)

@@ -0,0 +1,311 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.Reporting+-- Copyright   :  (c) David Waern 2008+-- License     :  BSD-like+--+-- Maintainer  :  david.waern@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Anonymous build report data structure, printing and parsing+--+-----------------------------------------------------------------------------+module Distribution.Client.BuildReports.Anonymous (+    BuildReport(..),+    InstallOutcome(..),+    Outcome(..),++    -- * Constructing and writing reports+    new,++    -- * parsing and pretty printing+    parse,+    parseList,+    show,+--    showList,+  ) where++import Distribution.Client.Types+         ( ConfiguredPackage(..) )+import qualified Distribution.Client.Types as BR+         ( BuildResult, BuildFailure(..), BuildSuccess(..)+         , DocsResult(..), TestsResult(..) )+import Distribution.Client.Utils+         ( mergeBy, MergeResult(..) )+import qualified Paths_cabal_install_ghc72 (version)++import Distribution.Package+         ( PackageIdentifier(..), PackageName(..), Package(packageId) )+import Distribution.PackageDescription+         ( FlagName(..), FlagAssignment )+--import Distribution.Version+--         ( Version )+import Distribution.System+         ( OS, Arch )+import Distribution.Compiler+         ( CompilerId )+import qualified Distribution.Text as Text+         ( Text(disp, parse) )+import Distribution.ParseUtils+         ( FieldDescr(..), ParseResult(..), Field(..)+         , simpleField, listField, ppFields, readFields+         , syntaxError, locatedErrorMsg )+import Distribution.Simple.Utils+         ( comparing )++import qualified Distribution.Compat.ReadP as Parse+         ( ReadP, pfail, munch1, skipSpaces )+import qualified Text.PrettyPrint.HughesPJ as Disp+         ( Doc, render, char, text )+import Text.PrettyPrint.HughesPJ+         ( (<+>), (<>) )++import Data.List+         ( unfoldr, sortBy )+import Data.Char as Char+         ( isAlpha, isAlphaNum )++import Prelude hiding (show)++data BuildReport+   = BuildReport {+    -- | The package this build report is about+    package         :: PackageIdentifier,++    -- | The OS and Arch the package was built on+    os              :: OS,+    arch            :: Arch,++    -- | The Haskell compiler (and hopefully version) used+    compiler        :: CompilerId,++    -- | The uploading client, ie cabal-install-x.y.z+    client          :: PackageIdentifier,++    -- | Which configurations flags we used+    flagAssignment  :: FlagAssignment,++    -- | Which dependent packages we were using exactly+    dependencies    :: [PackageIdentifier],++    -- | Did installing work ok?+    installOutcome  :: InstallOutcome,++    --   Which version of the Cabal library was used to compile the Setup.hs+--    cabalVersion    :: Version,++    --   Which build tools we were using (with versions)+--    tools      :: [PackageIdentifier],++    -- | Configure outcome, did configure work ok?+    docsOutcome     :: Outcome,++    -- | Configure outcome, did configure work ok?+    testsOutcome    :: Outcome+  }++data InstallOutcome+   = DependencyFailed PackageIdentifier+   | DownloadFailed+   | UnpackFailed+   | SetupFailed+   | ConfigureFailed+   | BuildFailed+   | InstallFailed+   | InstallOk+  deriving Eq++data Outcome = NotTried | Failed | Ok+  deriving Eq++new :: OS -> Arch -> CompilerId -- -> Version+    -> ConfiguredPackage -> BR.BuildResult+    -> BuildReport+new os' arch' comp (ConfiguredPackage pkg flags deps) result =+  BuildReport {+    package               = packageId pkg,+    os                    = os',+    arch                  = arch',+    compiler              = comp,+    client                = cabalInstallID,+    flagAssignment        = flags,+    dependencies          = deps,+    installOutcome        = convertInstallOutcome,+--    cabalVersion          = undefined+    docsOutcome           = convertDocsOutcome,+    testsOutcome          = convertTestsOutcome+  }+  where+    convertInstallOutcome = case result of+      Left  (BR.DependentFailed p) -> DependencyFailed p+      Left  (BR.DownloadFailed  _) -> DownloadFailed+      Left  (BR.UnpackFailed    _) -> UnpackFailed+      Left  (BR.ConfigureFailed _) -> ConfigureFailed+      Left  (BR.BuildFailed     _) -> BuildFailed+      Left  (BR.InstallFailed   _) -> InstallFailed+      Right (BR.BuildOk       _ _) -> InstallOk+    convertDocsOutcome = case result of+      Left _                                -> NotTried+      Right (BR.BuildOk BR.DocsNotTried _)  -> NotTried+      Right (BR.BuildOk BR.DocsFailed _)    -> Failed+      Right (BR.BuildOk BR.DocsOk _)        -> Ok+    convertTestsOutcome = case result of+      Left _                                -> NotTried+      Right (BR.BuildOk _ BR.TestsNotTried) -> NotTried+      Right (BR.BuildOk _ BR.TestsFailed)   -> Failed+      Right (BR.BuildOk _ BR.TestsOk)       -> Ok++cabalInstallID :: PackageIdentifier+cabalInstallID =+  PackageIdentifier (PackageName "cabal-install") Paths_cabal_install_ghc72.version++-- ------------------------------------------------------------+-- * External format+-- ------------------------------------------------------------++initialBuildReport :: BuildReport+initialBuildReport = BuildReport {+    package         = requiredField "package",+    os              = requiredField "os",+    arch            = requiredField "arch",+    compiler        = requiredField "compiler",+    client          = requiredField "client",+    flagAssignment  = [],+    dependencies    = [],+    installOutcome  = requiredField "install-outcome",+--    cabalVersion  = Nothing,+--    tools         = [],+    docsOutcome     = NotTried,+    testsOutcome    = NotTried+  }+  where+    requiredField fname = error ("required field: " ++ fname)++-- -----------------------------------------------------------------------------+-- Parsing++parse :: String -> Either String BuildReport+parse s = case parseFields s of+  ParseFailed perror -> Left  msg where (_, msg) = locatedErrorMsg perror+  ParseOk   _ report -> Right report++--FIXME: this does not allow for optional or repeated fields+parseFields :: String -> ParseResult BuildReport+parseFields input = do+  fields <- mapM extractField =<< readFields input+  let merged = mergeBy (\desc (_,name,_) -> compare (fieldName desc) name)+                       sortedFieldDescrs+                       (sortBy (comparing (\(_,name,_) -> name)) fields)+  checkMerged initialBuildReport merged++  where+    extractField :: Field -> ParseResult (Int, String, String)+    extractField (F line name value)  = return (line, name, value)+    extractField (Section line _ _ _) = syntaxError line "Unrecognized stanza"+    extractField (IfBlock line _ _ _) = syntaxError line "Unrecognized stanza"++    checkMerged report [] = return report+    checkMerged report (merged:remaining) = case merged of+      InBoth fieldDescr (line, _name, value) -> do+        report' <- fieldSet fieldDescr line value report+        checkMerged report' remaining+      OnlyInRight (line, name, _) ->+        syntaxError line ("Unrecognized field " ++ name)+      OnlyInLeft  fieldDescr ->+        fail ("Missing field " ++ fieldName fieldDescr)++parseList :: String -> [BuildReport]+parseList str =+  [ report | Right report <- map parse (split str) ]++  where+    split :: String -> [String]+    split = filter (not . null) . unfoldr chunk . lines+    chunk [] = Nothing+    chunk ls = case break null ls of+                 (r, rs) -> Just (unlines r, dropWhile null rs)++-- -----------------------------------------------------------------------------+-- Pretty-printing++show :: BuildReport -> String+show = Disp.render . ppFields fieldDescrs++-- -----------------------------------------------------------------------------+-- Description of the fields, for parsing/printing++fieldDescrs :: [FieldDescr BuildReport]+fieldDescrs =+ [ simpleField "package"         Text.disp      Text.parse+                                 package        (\v r -> r { package = v })+ , simpleField "os"              Text.disp      Text.parse+                                 os             (\v r -> r { os = v })+ , simpleField "arch"            Text.disp      Text.parse+                                 arch           (\v r -> r { arch = v })+ , simpleField "compiler"        Text.disp      Text.parse+                                 compiler       (\v r -> r { compiler = v })+ , simpleField "client"          Text.disp      Text.parse+                                 client         (\v r -> r { client = v })+ , listField   "flags"           dispFlag       parseFlag+                                 flagAssignment (\v r -> r { flagAssignment = v })+ , listField   "dependencies"    Text.disp      Text.parse+                                 dependencies   (\v r -> r { dependencies = v })+ , simpleField "install-outcome" Text.disp      Text.parse+                                 installOutcome (\v r -> r { installOutcome = v })+ , simpleField "docs-outcome"    Text.disp      Text.parse+                                 docsOutcome    (\v r -> r { docsOutcome = v })+ , simpleField "tests-outcome"   Text.disp      Text.parse+                                 testsOutcome   (\v r -> r { testsOutcome = v })+ ]++sortedFieldDescrs :: [FieldDescr BuildReport]+sortedFieldDescrs = sortBy (comparing fieldName) fieldDescrs++dispFlag :: (FlagName, Bool) -> Disp.Doc+dispFlag (FlagName name, True)  =                  Disp.text name+dispFlag (FlagName name, False) = Disp.char '-' <> Disp.text name++parseFlag :: Parse.ReadP r (FlagName, Bool)+parseFlag = do+  name <- Parse.munch1 (\c -> Char.isAlphaNum c || c == '_' || c == '-')+  case name of+    ('-':flag) -> return (FlagName flag, False)+    flag       -> return (FlagName flag, True)++instance Text.Text InstallOutcome where+  disp (DependencyFailed pkgid) = Disp.text "DependencyFailed" <+> Text.disp pkgid+  disp DownloadFailed  = Disp.text "DownloadFailed"+  disp UnpackFailed    = Disp.text "UnpackFailed"+  disp SetupFailed     = Disp.text "SetupFailed"+  disp ConfigureFailed = Disp.text "ConfigureFailed"+  disp BuildFailed     = Disp.text "BuildFailed"+  disp InstallFailed   = Disp.text "InstallFailed"+  disp InstallOk       = Disp.text "InstallOk"++  parse = do+    name <- Parse.munch1 Char.isAlphaNum+    case name of+      "DependencyFailed" -> do Parse.skipSpaces+                               pkgid <- Text.parse+                               return (DependencyFailed pkgid)+      "DownloadFailed"   -> return DownloadFailed+      "UnpackFailed"     -> return UnpackFailed+      "SetupFailed"      -> return SetupFailed+      "ConfigureFailed"  -> return ConfigureFailed+      "BuildFailed"      -> return BuildFailed+      "InstallFailed"    -> return InstallFailed+      "InstallOk"        -> return InstallOk+      _                  -> Parse.pfail++instance Text.Text Outcome where+  disp NotTried = Disp.text "NotTried"+  disp Failed   = Disp.text "Failed"+  disp Ok       = Disp.text "Ok"+  parse = do+    name <- Parse.munch1 Char.isAlpha+    case name of+      "NotTried" -> return NotTried+      "Failed"   -> return Failed+      "Ok"       -> return Ok+      _          -> Parse.pfail

@@ -0,0 +1,127 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.Reporting+-- Copyright   :  (c) David Waern 2008+-- License     :  BSD-like+--+-- Maintainer  :  david.waern@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Anonymous build report data structure, printing and parsing+--+-----------------------------------------------------------------------------+module Distribution.Client.BuildReports.Storage (++    -- * Storing and retrieving build reports+    storeAnonymous,+    storeLocal,+--    retrieve,++    -- * 'InstallPlan' support+    fromInstallPlan,+  ) where++import qualified Distribution.Client.BuildReports.Anonymous as BuildReport+import Distribution.Client.BuildReports.Anonymous (BuildReport)++import Distribution.Client.Types+import qualified Distribution.Client.InstallPlan as InstallPlan+import Distribution.Client.InstallPlan+         ( InstallPlan )++import Distribution.Simple.InstallDirs+         ( PathTemplate, fromPathTemplate+         , initialPathTemplateEnv, substPathTemplate )+import Distribution.System+         ( Platform(Platform) )+import Distribution.Compiler+         ( CompilerId )+import Distribution.Simple.Utils+         ( comparing, equating )++import Data.List+         ( groupBy, sortBy )+import Data.Maybe+         ( catMaybes )+import System.FilePath+         ( (</>), takeDirectory )+import System.Directory+         ( createDirectoryIfMissing )++storeAnonymous :: [(BuildReport, Repo)] -> IO ()+storeAnonymous reports = sequence_+  [ appendFile file (concatMap format reports')+  | (repo, reports') <- separate reports+  , let file = repoLocalDir repo </> "build-reports.log" ]+  --TODO: make this concurrency safe, either lock the report file or make sure+  -- the writes for each report are atomic (under 4k and flush at boundaries)++  where+    format r = '\n' : BuildReport.show r ++ "\n"+    separate :: [(BuildReport, Repo)]+             -> [(Repo, [BuildReport])]+    separate = map (\rs@((_,repo,_):_) -> (repo, [ r | (r,_,_) <- rs ]))+             . map concat+             . groupBy (equating (repoName . head))+             . sortBy (comparing (repoName . head))+             . groupBy (equating repoName)+             . onlyRemote+    repoName (_,_,rrepo) = remoteRepoName rrepo++    onlyRemote :: [(BuildReport, Repo)] -> [(BuildReport, Repo, RemoteRepo)]+    onlyRemote rs =+      [ (report, repo, remoteRepo)+      | (report, repo@Repo { repoKind = Left remoteRepo }) <- rs ]++storeLocal :: [PathTemplate] -> [(BuildReport, Repo)] -> IO ()+storeLocal templates reports = sequence_+  [ do createDirectoryIfMissing True (takeDirectory file)+       appendFile file output+       --TODO: make this concurrency safe, either lock the report file or make+       --      sure the writes for each report are atomic+  | (file, reports') <- groupByFileName+                          [ (reportFileName template report, report)+                          | template <- templates+                          , (report, _repo) <- reports ]+  , let output = concatMap format reports'+  ]+  where+    format r = '\n' : BuildReport.show r ++ "\n"++    reportFileName template report =+        fromPathTemplate (substPathTemplate env template)+      where env = initialPathTemplateEnv+                    (BuildReport.package  report)+                    (BuildReport.compiler report)++    groupByFileName = map (\grp@((filename,_):_) -> (filename, map snd grp))+                    . groupBy (equating  fst)+                    . sortBy  (comparing fst)++-- ------------------------------------------------------------+-- * InstallPlan support+-- ------------------------------------------------------------++fromInstallPlan :: InstallPlan -> [(BuildReport, Repo)]+fromInstallPlan plan = catMaybes+                     . map (fromPlanPackage platform comp)+                     . InstallPlan.toList+                     $ plan+  where platform = InstallPlan.planPlatform plan+        comp     = InstallPlan.planCompiler plan++fromPlanPackage :: Platform -> CompilerId+                -> InstallPlan.PlanPackage+                -> Maybe (BuildReport, Repo)+fromPlanPackage (Platform arch os) comp planPackage = case planPackage of++  InstallPlan.Installed pkg@(ConfiguredPackage (AvailablePackage {+                          packageSource = RepoTarballPackage repo _ _ }) _ _) result+    -> Just $ (BuildReport.new os arch comp pkg (Right result), repo)++  InstallPlan.Failed pkg@(ConfiguredPackage (AvailablePackage {+                       packageSource = RepoTarballPackage repo _ _ }) _ _) result+    -> Just $ (BuildReport.new os arch comp pkg (Left result), repo)++  _ -> Nothing

@@ -0,0 +1,44 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.BuildReports.Types+-- Copyright   :  (c) Duncan Coutts 2009+-- License     :  BSD-like+--+-- Maintainer  :  cabal-devel@haskell.org+-- Portability :  portable+--+-- Types related to build reporting+--+-----------------------------------------------------------------------------+module Distribution.Client.BuildReports.Types (+    ReportLevel(..),+  ) where++import qualified Distribution.Text as Text+         ( Text(..) )++import qualified Distribution.Compat.ReadP as Parse+         ( pfail, munch1 )+import qualified Text.PrettyPrint.HughesPJ as Disp+         ( text )++import Data.Char as Char+         ( isAlpha, toLower )++data ReportLevel = NoReports | AnonymousReports | DetailedReports+  deriving (Eq, Ord, Show)++instance Text.Text ReportLevel where+  disp NoReports        = Disp.text "none"+  disp AnonymousReports = Disp.text "anonymous"+  disp DetailedReports  = Disp.text "detailed"+  parse = do+    name <- Parse.munch1 Char.isAlpha+    case lowercase name of+      "none"       -> return NoReports+      "anonymous"  -> return AnonymousReports+      "detailed"   -> return DetailedReports+      _            -> Parse.pfail++lowercase :: String -> String+lowercase = map Char.toLower

@@ -0,0 +1,74 @@+{-# LANGUAGE PatternGuards #-}+-- This is a quick hack for uploading build reports to Hackage.++module Distribution.Client.BuildReports.Upload+    ( BuildLog+    , BuildReportId+    , uploadReports+    , postBuildReport+    , putBuildLog+    ) where++import Network.Browser+         ( BrowserAction, request, setAllowRedirects )+import Network.HTTP+         ( Header(..), HeaderName(..)+         , Request(..), RequestMethod(..), Response(..) )+import Network.TCP (HandleStream)+import Network.URI (URI, uriPath, parseRelativeReference, relativeTo)++import Control.Monad+         ( forM_ )+import System.FilePath.Posix+         ( (</>) )+import qualified Distribution.Client.BuildReports.Anonymous as BuildReport+import Distribution.Client.BuildReports.Anonymous (BuildReport)+import Distribution.Text (display)++type BuildReportId = URI+type BuildLog = String++uploadReports :: URI -> [(BuildReport, Maybe BuildLog)]+              -> BrowserAction (HandleStream String) ()+              ->  BrowserAction (HandleStream BuildLog) ()+uploadReports uri reports auth = do+  auth+  forM_ reports $ \(report, mbBuildLog) -> do+     buildId <- postBuildReport uri report+     case mbBuildLog of+       Just buildLog -> putBuildLog buildId buildLog+       Nothing       -> return ()++postBuildReport :: URI -> BuildReport+                -> BrowserAction (HandleStream BuildLog) BuildReportId+postBuildReport uri buildReport = do+  setAllowRedirects False+  (_, response) <- request Request {+    rqURI     = uri { uriPath = "/package" </> display (BuildReport.package buildReport) </> "reports" },+    rqMethod  = POST,+    rqHeaders = [Header HdrContentType   ("text/plain"),+                 Header HdrContentLength (show (length body)),+                 Header HdrAccept        ("text/plain")],+    rqBody    = body+  }+  case rspCode response of+    (3,0,3) | [Just buildId] <- [ do rel <- parseRelativeReference location+                                     relativeTo rel uri+                                  | Header HdrLocation location <- rspHeaders response ]+              -> return $ buildId+    _         -> error "Unrecognised response from server."+  where body  = BuildReport.show buildReport++putBuildLog :: BuildReportId -> BuildLog+            -> BrowserAction (HandleStream BuildLog) ()+putBuildLog reportId buildLog = do+  --FIXME: do something if the request fails+  (_, response) <- request Request {+      rqURI     = reportId{uriPath = uriPath reportId </> "log"},+      rqMethod  = PUT,+      rqHeaders = [Header HdrContentType   ("text/plain"),+                   Header HdrContentLength (show (length buildLog)),+                   Header HdrAccept        ("text/plain")],+      rqBody    = buildLog+    }+  return ()

@@ -0,0 +1,85 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.Check+-- Copyright   :  (c) Lennart Kolmodin 2008+-- License     :  BSD-like+--+-- Maintainer  :  kolmodin@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- Check a package for common mistakes+--+-----------------------------------------------------------------------------+module Distribution.Client.Check (+    check+  ) where++import Control.Monad ( when, unless )++import Distribution.PackageDescription.Parse+         ( readPackageDescription )+import Distribution.PackageDescription.Check+import Distribution.PackageDescription.Configuration+         ( flattenPackageDescription )+import Distribution.Verbosity+         ( Verbosity )+import Distribution.Simple.Utils+         ( defaultPackageDesc, toUTF8, wrapText )++check :: Verbosity -> IO Bool+check verbosity = do+    pdfile <- defaultPackageDesc verbosity+    ppd <- readPackageDescription verbosity pdfile+    -- flatten the generic package description into a regular package+    -- description+    -- TODO: this may give more warnings than it should give;+    --       consider two branches of a condition, one saying+    --          ghc-options: -Wall+    --       and the other+    --          ghc-options: -Werror+    --      joined into+    --          ghc-options: -Wall -Werror+    --      checkPackages will yield a warning on the last line, but it+    --      would not on each individual branch.+    --      Hovever, this is the same way hackage does it, so we will yield+    --      the exact same errors as it will.+    let pkg_desc = flattenPackageDescription ppd+    ioChecks <- checkPackageFiles pkg_desc "."+    let packageChecks = ioChecks ++ checkPackage ppd (Just pkg_desc)+        buildImpossible = [ x | x@PackageBuildImpossible {} <- packageChecks ]+        buildWarning    = [ x | x@PackageBuildWarning {}    <- packageChecks ]+        distSuspicious  = [ x | x@PackageDistSuspicious {}  <- packageChecks ]+        distInexusable  = [ x | x@PackageDistInexcusable {} <- packageChecks ]++    unless (null buildImpossible) $ do+        putStrLn "The package will not build sanely due to these errors:"+        printCheckMessages buildImpossible++    unless (null buildWarning) $ do+        putStrLn "The following warnings are likely affect your build negatively:"+        printCheckMessages buildWarning++    unless (null distSuspicious) $ do+        putStrLn "These warnings may cause trouble when distributing the package:"+        printCheckMessages distSuspicious++    unless (null distInexusable) $ do+        putStrLn "The following errors will cause portability problems on other environments:"+        printCheckMessages distInexusable++    let isDistError (PackageDistSuspicious {}) = False+        isDistError _                          = True+        errors = filter isDistError packageChecks++    unless (null errors) $ do+        putStrLn "Hackage would reject this package."++    when (null packageChecks) $ do+        putStrLn "No errors or warnings could be found in the package."++    return (null packageChecks)++  where+    printCheckMessages = mapM_ (putStrLn . format . explanation)+    format = toUTF8 . wrapText . ("* "++)

@@ -0,0 +1,532 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.Config+-- Copyright   :  (c) David Himmelstrup 2005+-- License     :  BSD-like+--+-- Maintainer  :  lemmih@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Utilities for handling saved state such as known packages, known servers and downloaded packages.+-----------------------------------------------------------------------------+module Distribution.Client.Config (+    SavedConfig(..),+    loadConfig,++    showConfig,+    showConfigWithComments,+    parseConfig,++    defaultCabalDir,+    defaultConfigFile,+    defaultCacheDir,+    defaultLogsDir,+  ) where+++import Distribution.Client.Types+         ( RemoteRepo(..), Username(..), Password(..) )+import Distribution.Client.BuildReports.Types+         ( ReportLevel(..) )+import Distribution.Client.Setup+         ( GlobalFlags(..), globalCommand+         , ConfigExFlags(..), configureExOptions, defaultConfigExFlags+         , InstallFlags(..), installOptions, defaultInstallFlags+         , UploadFlags(..), uploadCommand+         , ReportFlags(..), reportCommand+         , showRepo, parseRepo )++import Distribution.Simple.Setup+         ( ConfigFlags(..), configureOptions, defaultConfigFlags+         , installDirsOptions+         , Flag, toFlag, flagToMaybe, fromFlagOrDefault )+import Distribution.Simple.InstallDirs+         ( InstallDirs(..), defaultInstallDirs+         , PathTemplate, toPathTemplate )+import Distribution.ParseUtils+         ( FieldDescr(..), liftField+         , ParseResult(..), locatedErrorMsg, showPWarning+         , readFields, warning, lineNo+         , simpleField, listField, parseFilePathQ, parseTokenQ )+import qualified Distribution.ParseUtils as ParseUtils+         ( Field(..) )+import qualified Distribution.Text as Text+         ( Text(..) )+import Distribution.Simple.Command+         ( CommandUI(commandOptions), commandDefaultFlags, ShowOrParseArgs(..)+         , viewAsFieldDescr )+import Distribution.Simple.Program+         ( defaultProgramConfiguration )+import Distribution.Simple.Utils+         ( notice, warn, lowercase )+import Distribution.Compiler+         ( CompilerFlavor(..), defaultCompilerFlavor )+import Distribution.Verbosity+         ( Verbosity, normal )++import Data.List+         ( partition, find )+import Data.Maybe+         ( fromMaybe )+import Data.Monoid+         ( Monoid(..) )+import Control.Monad+         ( when, foldM, liftM )+import qualified Data.Map as Map+import qualified Distribution.Compat.ReadP as Parse+         ( option )+import qualified Text.PrettyPrint.HughesPJ as Disp+         ( Doc, render, text, colon, vcat, empty, isEmpty, nest )+import Text.PrettyPrint.HughesPJ+         ( (<>), (<+>), ($$), ($+$) )+import System.Directory+         ( createDirectoryIfMissing, getAppUserDataDirectory )+import Network.URI+         ( URI(..), URIAuth(..) )+import System.FilePath+         ( (</>), takeDirectory )+import System.Environment+         ( getEnvironment )+import System.IO.Error+         ( isDoesNotExistError )++--+-- * Configuration saved in the config file+--++data SavedConfig = SavedConfig {+    savedGlobalFlags       :: GlobalFlags,+    savedInstallFlags      :: InstallFlags,+    savedConfigureFlags    :: ConfigFlags,+    savedConfigureExFlags  :: ConfigExFlags,+    savedUserInstallDirs   :: InstallDirs (Flag PathTemplate),+    savedGlobalInstallDirs :: InstallDirs (Flag PathTemplate),+    savedUploadFlags       :: UploadFlags,+    savedReportFlags       :: ReportFlags+  }++instance Monoid SavedConfig where+  mempty = SavedConfig {+    savedGlobalFlags       = mempty,+    savedInstallFlags      = mempty,+    savedConfigureFlags    = mempty,+    savedConfigureExFlags  = mempty,+    savedUserInstallDirs   = mempty,+    savedGlobalInstallDirs = mempty,+    savedUploadFlags       = mempty,+    savedReportFlags       = mempty+  }+  mappend a b = SavedConfig {+    savedGlobalFlags       = combine savedGlobalFlags,+    savedInstallFlags      = combine savedInstallFlags,+    savedConfigureFlags    = combine savedConfigureFlags,+    savedConfigureExFlags  = combine savedConfigureExFlags,+    savedUserInstallDirs   = combine savedUserInstallDirs,+    savedGlobalInstallDirs = combine savedGlobalInstallDirs,+    savedUploadFlags       = combine savedUploadFlags,+    savedReportFlags       = combine savedReportFlags+  }+    where combine field = field a `mappend` field b++updateInstallDirs :: Flag Bool -> SavedConfig -> SavedConfig+updateInstallDirs userInstallFlag+  savedConfig@SavedConfig {+    savedConfigureFlags    = configureFlags,+    savedUserInstallDirs   = userInstallDirs,+    savedGlobalInstallDirs = globalInstallDirs+  } =+  savedConfig {+    savedConfigureFlags = configureFlags {+      configInstallDirs = installDirs+    }+  }+  where+    installDirs | userInstall = userInstallDirs+                | otherwise   = globalInstallDirs+    userInstall = fromFlagOrDefault defaultUserInstall $+                    configUserInstall configureFlags `mappend` userInstallFlag++--+-- * Default config+--++-- | These are the absolute basic defaults. The fields that must be+-- initialised. When we load the config from the file we layer the loaded+-- values over these ones, so any missing fields in the file take their values+-- from here.+--+baseSavedConfig :: IO SavedConfig+baseSavedConfig = do+  userPrefix <- defaultCabalDir+  logsDir    <- defaultLogsDir+  worldFile  <- defaultWorldFile+  return mempty {+    savedConfigureFlags  = mempty {+      configHcFlavor     = toFlag defaultCompiler,+      configUserInstall  = toFlag defaultUserInstall,+      configVerbosity    = toFlag normal+    },+    savedUserInstallDirs = mempty {+      prefix             = toFlag (toPathTemplate userPrefix)+    },+    savedGlobalFlags = mempty {+      globalLogsDir      = toFlag logsDir,+      globalWorldFile    = toFlag worldFile+    }+  }++-- | This is the initial configuration that we write out to to the config file+-- if the file does not exist (or the config we use if the file cannot be read+-- for some other reason). When the config gets loaded it gets layered on top+-- of 'baseSavedConfig' so we do not need to include it into the initial+-- values we save into the config file.+--+initialSavedConfig :: IO SavedConfig+initialSavedConfig = do+  cacheDir   <- defaultCacheDir+  logsDir    <- defaultLogsDir+  worldFile  <- defaultWorldFile+  return mempty {+    savedGlobalFlags     = mempty {+      globalCacheDir     = toFlag cacheDir,+      globalRemoteRepos  = [defaultRemoteRepo],+      globalWorldFile    = toFlag worldFile+    },+    savedInstallFlags    = mempty {+      installSummaryFile = [toPathTemplate (logsDir </> "build.log")],+      installBuildReports= toFlag AnonymousReports+    }+  }++--TODO: misleading, there's no way to override this default+--      either make it possible or rename to simply getCabalDir.+defaultCabalDir :: IO FilePath+defaultCabalDir = getAppUserDataDirectory "cabal"++defaultConfigFile :: IO FilePath+defaultConfigFile = do+  dir <- defaultCabalDir+  return $ dir </> "config"++defaultCacheDir :: IO FilePath+defaultCacheDir = do+  dir <- defaultCabalDir+  return $ dir </> "packages"++defaultLogsDir :: IO FilePath+defaultLogsDir = do+  dir <- defaultCabalDir+  return $ dir </> "logs"++-- | Default position of the world file+defaultWorldFile :: IO FilePath+defaultWorldFile = do+  dir <- defaultCabalDir+  return $ dir </> "world"++defaultCompiler :: CompilerFlavor+defaultCompiler = fromMaybe GHC defaultCompilerFlavor++defaultUserInstall :: Bool+defaultUserInstall = True+-- We do per-user installs by default on all platforms. We used to default to+-- global installs on Windows but that no longer works on Windows Vista or 7.++defaultRemoteRepo :: RemoteRepo+defaultRemoteRepo = RemoteRepo name uri+  where+    name = "hackage.haskell.org"+    uri  = URI "http:" (Just (URIAuth "" name "")) "/packages/archive" "" ""++--+-- * Config file reading+--++loadConfig :: Verbosity -> Flag FilePath -> Flag Bool -> IO SavedConfig+loadConfig verbosity configFileFlag userInstallFlag = addBaseConf $ do+  let sources = [+        ("commandline option",   return . flagToMaybe $ configFileFlag),+        ("env var CABAL_CONFIG", lookup "CABAL_CONFIG" `liftM` getEnvironment),+        ("default config file",  Just `liftM` defaultConfigFile) ]++      getSource [] = error "no config file path candidate found."+      getSource ((msg,action): xs) = +                        action >>= maybe (getSource xs) (return . (,) msg)++  (source, configFile) <- getSource sources+  minp <- readConfigFile mempty configFile+  case minp of+    Nothing -> do+      notice verbosity $ "Config file path source is " ++ source ++ "."+      notice verbosity $ "Config file " ++ configFile ++ " not found."+      notice verbosity $ "Writing default configuration to " ++ configFile+      commentConf <- commentSavedConfig+      initialConf <- initialSavedConfig+      writeConfigFile configFile commentConf initialConf+      return initialConf+    Just (ParseOk ws conf) -> do+      when (not $ null ws) $ warn verbosity $+        unlines (map (showPWarning configFile) ws)+      return conf+    Just (ParseFailed err) -> do+      let (line, msg) = locatedErrorMsg err+      warn verbosity $+          "Error parsing config file " ++ configFile+        ++ maybe "" (\n -> ":" ++ show n) line ++ ":\n" ++ msg+      warn verbosity $ "Using default configuration."+      initialSavedConfig++  where+    addBaseConf body = do+      base  <- baseSavedConfig+      extra <- body+      return (updateInstallDirs userInstallFlag (base `mappend` extra))++readConfigFile :: SavedConfig -> FilePath -> IO (Maybe (ParseResult SavedConfig))+readConfigFile initial file = handleNotExists $+  fmap (Just . parseConfig initial) (readFile file)++  where+    handleNotExists action = catch action $ \ioe ->+      if isDoesNotExistError ioe+        then return Nothing+        else ioError ioe++writeConfigFile :: FilePath -> SavedConfig -> SavedConfig -> IO ()+writeConfigFile file comments vals = do+  createDirectoryIfMissing True (takeDirectory file)+  writeFile file $ explanation ++ showConfigWithComments comments vals ++ "\n"+  where+    explanation = unlines+      ["-- This is the configuration file for the 'cabal' command line tool."+      ,""+      ,"-- The available configuration options are listed below."+      ,"-- Some of them have default values listed."+      ,""+      ,"-- Lines (like this one) beginning with '--' are comments."+      ,"-- Be careful with spaces and indentation because they are"+      ,"-- used to indicate layout for nested sections."+      ,"",""+      ]++-- | These are the default values that get used in Cabal if a no value is+-- given. We use these here to include in comments when we write out the+-- initial config file so that the user can see what default value they are+-- overriding.+--+commentSavedConfig :: IO SavedConfig+commentSavedConfig = do+  userInstallDirs   <- defaultInstallDirs defaultCompiler True True+  globalInstallDirs <- defaultInstallDirs defaultCompiler False True+  return SavedConfig {+    savedGlobalFlags       = commandDefaultFlags globalCommand,+    savedInstallFlags      = defaultInstallFlags,+    savedConfigureExFlags  = defaultConfigExFlags,+    savedConfigureFlags    = (defaultConfigFlags defaultProgramConfiguration) {+      configUserInstall    = toFlag defaultUserInstall+    },+    savedUserInstallDirs   = fmap toFlag userInstallDirs,+    savedGlobalInstallDirs = fmap toFlag globalInstallDirs,+    savedUploadFlags       = commandDefaultFlags uploadCommand,+    savedReportFlags       = commandDefaultFlags reportCommand+  }++-- | All config file fields.+--+configFieldDescriptions :: [FieldDescr SavedConfig]+configFieldDescriptions =++     toSavedConfig liftGlobalFlag+       (commandOptions globalCommand ParseArgs)+       ["version", "numeric-version", "config-file"] []++  ++ toSavedConfig liftConfigFlag+       (configureOptions ParseArgs)+       (["builddir", "configure-option"] ++ map fieldName installDirsFields)++        --FIXME: this is only here because viewAsFieldDescr gives us a parser+        -- that only recognises 'ghc' etc, the case-sensitive flag names, not+        -- what the normal case-insensitive parser gives us.+       [simpleField "compiler"+          (fromFlagOrDefault Disp.empty . fmap Text.disp) (optional Text.parse)+          configHcFlavor (\v flags -> flags { configHcFlavor = v })+       ]++  ++ toSavedConfig liftConfigExFlag+       (configureExOptions ParseArgs)+       [] []++  ++ toSavedConfig liftInstallFlag+       (installOptions ParseArgs)+       ["dry-run", "reinstall", "only"] []++  ++ toSavedConfig liftUploadFlag+       (commandOptions uploadCommand ParseArgs)+       ["verbose", "check"] []++  ++ toSavedConfig liftReportFlag+       (commandOptions reportCommand ParseArgs)+       ["verbose"] []++  where+    toSavedConfig lift options exclusions replacements =+      [ lift (fromMaybe field replacement)+      | opt <- options+      , let field       = viewAsFieldDescr opt+            name        = fieldName field+            replacement = find ((== name) . fieldName) replacements+      , name `notElem` exclusions ]+    optional = Parse.option mempty . fmap toFlag++-- TODO: next step, make the deprecated fields elicit a warning.+--+deprecatedFieldDescriptions :: [FieldDescr SavedConfig]+deprecatedFieldDescriptions =+  [ liftGlobalFlag $+    listField "repos"+      (Disp.text . showRepo) parseRepo+      globalRemoteRepos (\rs cfg -> cfg { globalRemoteRepos = rs })+  , liftGlobalFlag $+    simpleField "cachedir"+      (Disp.text . fromFlagOrDefault "") (optional parseFilePathQ)+      globalCacheDir    (\d cfg -> cfg { globalCacheDir = d })+  , liftUploadFlag $+    simpleField "hackage-username"+      (Disp.text . fromFlagOrDefault "" . fmap unUsername)+      (optional (fmap Username parseTokenQ))+      uploadUsername    (\d cfg -> cfg { uploadUsername = d })+  , liftUploadFlag $+    simpleField "hackage-password"+      (Disp.text . fromFlagOrDefault "" . fmap unPassword)+      (optional (fmap Password parseTokenQ))+      uploadPassword    (\d cfg -> cfg { uploadPassword = d })+  ]+ ++ map (modifyFieldName ("user-"++)   . liftUserInstallDirs)   installDirsFields+ ++ map (modifyFieldName ("global-"++) . liftGlobalInstallDirs) installDirsFields+  where+    optional = Parse.option mempty . fmap toFlag+    modifyFieldName :: (String -> String) -> FieldDescr a -> FieldDescr a+    modifyFieldName f d = d { fieldName = f (fieldName d) }++liftUserInstallDirs :: FieldDescr (InstallDirs (Flag PathTemplate))+                    -> FieldDescr SavedConfig+liftUserInstallDirs = liftField+  savedUserInstallDirs (\flags conf -> conf { savedUserInstallDirs = flags })++liftGlobalInstallDirs :: FieldDescr (InstallDirs (Flag PathTemplate))+                      -> FieldDescr SavedConfig+liftGlobalInstallDirs = liftField+  savedGlobalInstallDirs (\flags conf -> conf { savedGlobalInstallDirs = flags })++liftGlobalFlag :: FieldDescr GlobalFlags -> FieldDescr SavedConfig+liftGlobalFlag = liftField+  savedGlobalFlags (\flags conf -> conf { savedGlobalFlags = flags })++liftConfigFlag :: FieldDescr ConfigFlags -> FieldDescr SavedConfig+liftConfigFlag = liftField+  savedConfigureFlags (\flags conf -> conf { savedConfigureFlags = flags })++liftConfigExFlag :: FieldDescr ConfigExFlags -> FieldDescr SavedConfig+liftConfigExFlag = liftField+  savedConfigureExFlags (\flags conf -> conf { savedConfigureExFlags = flags })++liftInstallFlag :: FieldDescr InstallFlags -> FieldDescr SavedConfig+liftInstallFlag = liftField+  savedInstallFlags (\flags conf -> conf { savedInstallFlags = flags })++liftUploadFlag :: FieldDescr UploadFlags -> FieldDescr SavedConfig+liftUploadFlag = liftField+  savedUploadFlags (\flags conf -> conf { savedUploadFlags = flags })++liftReportFlag :: FieldDescr ReportFlags -> FieldDescr SavedConfig+liftReportFlag = liftField+  savedReportFlags (\flags conf -> conf { savedReportFlags = flags })++parseConfig :: SavedConfig -> String -> ParseResult SavedConfig+parseConfig initial = \str -> do+  fields <- readFields str+  let (knownSections, others) = partition isKnownSection fields+  config <- parse others+  let user0   = savedUserInstallDirs config+      global0 = savedGlobalInstallDirs config+  (user, global) <- foldM parseSections (user0, global0) knownSections+  return config {+    savedUserInstallDirs   = user,+    savedGlobalInstallDirs = global+  }++  where+    isKnownSection (ParseUtils.Section _ "install-dirs" _ _) = True+    isKnownSection _                                          = False++    parse = parseFields (configFieldDescriptions+                      ++ deprecatedFieldDescriptions) initial++    parseSections accum@(u,g) (ParseUtils.Section _ "install-dirs" name fs)+      | name' == "user"   = do u' <- parseFields installDirsFields u fs+                               return (u', g)+      | name' == "global" = do g' <- parseFields installDirsFields g fs+                               return (u, g')+      | otherwise         = do+          warning "The install-paths section should be for 'user' or 'global'"+          return accum+      where name' = lowercase name+    parseSections accum f = do+      warning $ "Unrecognized stanza on line " ++ show (lineNo f)+      return accum++showConfig :: SavedConfig -> String+showConfig = showConfigWithComments mempty++showConfigWithComments :: SavedConfig -> SavedConfig -> String+showConfigWithComments comment vals = Disp.render $+      ppFields configFieldDescriptions comment vals+  $+$ Disp.text ""+  $+$ installDirsSection "user"   savedUserInstallDirs+  $+$ Disp.text ""+  $+$ installDirsSection "global" savedGlobalInstallDirs+  where+    installDirsSection name field =+      ppSection "install-dirs" name installDirsFields+                (field comment) (field vals)++------------------------+-- * Parsing utils+--++--FIXME: replace this with something better in Cabal-1.5+parseFields :: [FieldDescr a] -> a -> [ParseUtils.Field] -> ParseResult a+parseFields fields initial = foldM setField initial+  where+    fieldMap = Map.fromList+      [ (name, f) | f@(FieldDescr name _ _) <- fields ]+    setField accum (ParseUtils.F line name value) = case Map.lookup name fieldMap of+      Just (FieldDescr _ _ set) -> set line value accum+      Nothing -> do+        warning $ "Unrecognized field " ++ name ++ " on line " ++ show line+        return accum+    setField accum f = do+      warning $ "Unrecognized stanza on line " ++ show (lineNo f)+      return accum++-- | This is a customised version of the function from Cabal that also prints+-- default values for empty fields as comments.+--+ppFields :: [FieldDescr a] -> a -> a -> Disp.Doc+ppFields fields def cur = Disp.vcat [ ppField name (getter def) (getter cur)+                                    | FieldDescr name getter _ <- fields]++ppField :: String -> Disp.Doc -> Disp.Doc -> Disp.Doc+ppField name def cur+  | Disp.isEmpty cur = Disp.text "--" <+> Disp.text name <> Disp.colon <+> def+  | otherwise        =                    Disp.text name <> Disp.colon <+> cur++ppSection :: String -> String -> [FieldDescr a] -> a -> a -> Disp.Doc+ppSection name arg fields def cur =+     Disp.text name <+> Disp.text arg+  $$ Disp.nest 2 (ppFields fields def cur)++installDirsFields :: [FieldDescr (InstallDirs (Flag PathTemplate))]+installDirsFields = map viewAsFieldDescr installDirsOptions+

@@ -0,0 +1,191 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.Configure+-- Copyright   :  (c) David Himmelstrup 2005,+--                    Duncan Coutts 2005+-- License     :  BSD-like+--+-- Maintainer  :  cabal-devel@haskell.org+-- Portability :  portable+--+-- High level interface to configuring a package.+-----------------------------------------------------------------------------+module Distribution.Client.Configure (+    configure,+  ) where++import Distribution.Client.Dependency+import qualified Distribution.Client.InstallPlan as InstallPlan+import Distribution.Client.InstallPlan (InstallPlan)+import Distribution.Client.IndexUtils as IndexUtils+         ( getAvailablePackages, getInstalledPackages )+import Distribution.Client.Setup+         ( ConfigExFlags(..), configureCommand, filterConfigureFlags )+import Distribution.Client.Types as Available+import Distribution.Client.SetupWrapper+         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )++import Distribution.Simple.Compiler+         ( CompilerId(..), Compiler(compilerId)+         , PackageDB(..), PackageDBStack )+import Distribution.Simple.Program (ProgramConfiguration )+import Distribution.Simple.Setup+         ( ConfigFlags(..), toFlag, flagToMaybe, fromFlagOrDefault )+import Distribution.Client.PackageIndex (PackageIndex)+import Distribution.Simple.Utils+         ( defaultPackageDesc )+import Distribution.Package+         ( Package(..), packageName, Dependency(..), thisPackageVersion )+import Distribution.PackageDescription.Parse+         ( readPackageDescription )+import Distribution.PackageDescription.Configuration+         ( finalizePackageDescription )+import Distribution.Version+         ( anyVersion, thisVersion )+import Distribution.Simple.Utils as Utils+         ( notice, info, debug, die )+import Distribution.System+         ( Platform, buildPlatform )+import Distribution.Verbosity as Verbosity+         ( Verbosity )++import Data.Monoid (Monoid(..))++-- | Configure the package found in the local directory+configure :: Verbosity+          -> PackageDBStack+          -> [Repo]+          -> Compiler+          -> ProgramConfiguration+          -> ConfigFlags+          -> ConfigExFlags+          -> [String]+          -> IO ()+configure verbosity packageDBs repos comp conf+  configFlags configExFlags extraArgs = do++  installed <- getInstalledPackages verbosity comp packageDBs conf+  available <- getAvailablePackages verbosity repos++  progress <- planLocalPackage verbosity comp configFlags configExFlags+                               installed available++  notice verbosity "Resolving dependencies..."+  maybePlan <- foldProgress logMsg (return . Left) (return . Right)+                            progress+  case maybePlan of+    Left message -> do+      info verbosity message+      setupWrapper verbosity (setupScriptOptions installed) Nothing+        configureCommand (const configFlags) extraArgs++    Right installPlan -> case InstallPlan.ready installPlan of+      [pkg@(ConfiguredPackage (AvailablePackage _ _ (LocalUnpackedPackage _)) _ _)] ->+        configurePackage verbosity+          (InstallPlan.planPlatform installPlan)+          (InstallPlan.planCompiler installPlan)+          (setupScriptOptions installed)+          configFlags pkg extraArgs++      _ -> die $ "internal error: configure install plan should have exactly "+              ++ "one local ready package."++  where+    setupScriptOptions index = SetupScriptOptions {+      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.+      usePackageDB     = if UserPackageDB `elem` packageDBs+                           then packageDBs+                           else packageDBs ++ [UserPackageDB],+      usePackageIndex  = if UserPackageDB `elem` packageDBs+                           then Just index+                           else Nothing,+      useProgramConfig = conf,+      useDistPref      = fromFlagOrDefault+                           (useDistPref defaultSetupScriptOptions)+                           (configDistPref configFlags),+      useLoggingHandle = Nothing,+      useWorkingDir    = Nothing+    }++    logMsg message rest = debug verbosity message >> rest++-- | Make an 'InstallPlan' for the unpacked package in the current directory,+-- and all its dependencies.+--+planLocalPackage :: Verbosity -> Compiler+                 -> ConfigFlags -> ConfigExFlags+                 -> PackageIndex InstalledPackage+                 -> AvailablePackageDb+                 -> IO (Progress String String InstallPlan)+planLocalPackage verbosity comp configFlags configExFlags installed+  (AvailablePackageDb _ availablePrefs) = do+  pkg <- readPackageDescription verbosity =<< defaultPackageDesc verbosity++  let -- We create a local package and ask to resolve a dependency on it+      localPkg = AvailablePackage {+        packageInfoId                = packageId pkg,+        Available.packageDescription = pkg,+        packageSource                = LocalUnpackedPackage "."+      }++      resolverParams =++          addPreferences+            -- preferences from the config file or command line+            [ PackageVersionPreference name ver+            | Dependency name ver <- configPreferences configExFlags ]++        . addConstraints+            -- version constraints from the config file or command line+            [ PackageVersionConstraint name ver+            | Dependency name ver <- configConstraints configFlags ]++        . addConstraints+            -- package flags from the config file or command line+            [ PackageFlagsConstraint (packageName pkg)+                                     (configConfigurationsFlags configFlags) ]++        $ standardInstallPolicy+            installed+            (AvailablePackageDb mempty availablePrefs)+            [SpecificSourcePackage localPkg]++  return (resolveDependencies buildPlatform (compilerId comp) resolverParams)+++-- | Call an installer for an 'AvailablePackage' but override the configure+-- flags with the ones given by the 'ConfiguredPackage'. In particular the+-- 'ConfiguredPackage' specifies an exact 'FlagAssignment' and exactly+-- versioned package dependencies. So we ignore any previous partial flag+-- assignment or dependency constraints and use the new ones.+--+configurePackage :: Verbosity+                 -> Platform -> CompilerId+                 -> SetupScriptOptions+                 -> ConfigFlags+                 -> ConfiguredPackage+                 -> [String]+                 -> IO ()+configurePackage verbosity platform comp scriptOptions configFlags+  (ConfiguredPackage (AvailablePackage _ gpkg _) flags deps) extraArgs =++  setupWrapper verbosity+    scriptOptions (Just pkg) configureCommand configureFlags extraArgs++  where+    configureFlags   = filterConfigureFlags configFlags {+      configConfigurationsFlags = flags,+      configConstraints         = map thisPackageVersion deps,+      configVerbosity           = toFlag verbosity+    }++    pkg = case finalizePackageDescription flags+           (const True)+           platform comp [] gpkg of+      Left _ -> error "finalizePackageDescription ConfiguredPackage failed"+      Right (desc, _) -> desc

@@ -0,0 +1,441 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.Dependency+-- Copyright   :  (c) David Himmelstrup 2005,+--                    Bjorn Bringert 2007+--                    Duncan Coutts 2008+-- License     :  BSD-like+--+-- Maintainer  :  cabal-devel@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Top level interface to dependency resolution.+-----------------------------------------------------------------------------+module Distribution.Client.Dependency (+    -- * The main package dependency resolver+    resolveDependencies,+    Progress(..),+    foldProgress,++    -- * Alternate, simple resolver that does not do dependencies recursively+    resolveWithoutDependencies,++    -- * Constructing resolver policies+    DepResolverParams(..),+    PackageConstraint(..),+    PackagesPreferenceDefault(..),+    PackagePreference(..),+    InstalledPreference(..),++    -- ** Standard policy+    standardInstallPolicy,+    PackageSpecifier(..),++    -- ** Extra policy options+    dontUpgradeBasePackage,+    hideBrokenInstalledPackages,+    upgradeDependencies,+    reinstallTargets,++    -- ** Policy utils+    addConstraints,+    addPreferences,+    setPreferenceDefault,+    addAvailablePackages,+    hideInstalledPackagesSpecific,+    hideInstalledPackagesAllVersions,+  ) where++import Distribution.Client.Dependency.TopDown (topDownResolver)+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+         ( AvailablePackageDb(AvailablePackageDb)+         , AvailablePackage(..), InstalledPackage )+import Distribution.Client.Dependency.Types+         ( DependencyResolver, PackageConstraint(..)+         , PackagePreferences(..), InstalledPreference(..)+         , Progress(..), foldProgress )+import Distribution.Client.Targets+import Distribution.Package+         ( PackageName(..), PackageId, Package(..), packageVersion+         , Dependency(Dependency))+import Distribution.Version+         ( VersionRange, anyVersion, withinRange, simplifyVersionRange )+import Distribution.Compiler+         ( CompilerId(..) )+import Distribution.System+         ( Platform )+import Distribution.Simple.Utils (comparing)+import Distribution.Text+         ( display )++import Data.List (maximumBy, foldl')+import Data.Maybe (fromMaybe, isJust)+import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Set (Set)+++-- ------------------------------------------------------------+-- * High level planner policy+-- ------------------------------------------------------------++-- | The set of parameters to the dependency resolver. These parameters are+-- relatively low level but many kinds of high level policies can be+-- implemented in terms of adjustments to the parameters.+--+data DepResolverParams = DepResolverParams {+       depResolverTargets           :: [PackageName],+       depResolverConstraints       :: [PackageConstraint],+       depResolverPreferences       :: [PackagePreference],+       depResolverPreferenceDefault :: PackagesPreferenceDefault,+       depResolverInstalled         :: PackageIndex InstalledPackage,+       depResolverAvailable         :: PackageIndex AvailablePackage+     }+++-- | Global policy for all packages to say if we prefer package versions that+-- are already installed locally or if we just prefer the latest available.+--+data PackagesPreferenceDefault =++     -- | Always prefer the latest version irrespective of any existing+     -- installed version.+     --+     -- * This is the standard policy for upgrade.+     --+     PreferAllLatest++     -- | Always prefer the installed versions over ones that would need to be+     -- installed. Secondarily, prefer latest versions (eg the latest installed+     -- version or if there are none then the latest available version).+   | PreferAllInstalled++     -- | Prefer the latest version for packages that are explicitly requested+     -- but prefers the installed version for any other packages.+     --+     -- * This is the standard policy for install.+     --+   | PreferLatestForSelected+++-- | A package selection preference for a particular package.+--+-- Preferences are soft constraints that the dependency resolver should try to+-- respect where possible. It is not specified if preferences on some packages+-- are more important than others.+--+data PackagePreference =++     -- | A suggested constraint on the version number.+     PackageVersionPreference   PackageName VersionRange++     -- | If we prefer versions of packages that are already installed.+   | PackageInstalledPreference PackageName InstalledPreference++basicDepResolverParams :: PackageIndex InstalledPackage+                       -> PackageIndex AvailablePackage+                       -> DepResolverParams+basicDepResolverParams installed available =+    DepResolverParams {+       depResolverTargets           = [],+       depResolverConstraints       = [],+       depResolverPreferences       = [],+       depResolverPreferenceDefault = PreferLatestForSelected,+       depResolverInstalled         = installed,+       depResolverAvailable         = available+     }++addTargets :: [PackageName]+           -> DepResolverParams -> DepResolverParams+addTargets extraTargets params =+    params {+      depResolverTargets = extraTargets ++ depResolverTargets params+    }++addConstraints :: [PackageConstraint]+               -> DepResolverParams -> DepResolverParams+addConstraints extraConstraints params =+    params {+      depResolverConstraints = extraConstraints+                            ++ depResolverConstraints params+    }++addPreferences :: [PackagePreference]+               -> DepResolverParams -> DepResolverParams+addPreferences extraPreferences params =+    params {+      depResolverPreferences = extraPreferences+                            ++ depResolverPreferences params+    }++setPreferenceDefault :: PackagesPreferenceDefault+                     -> DepResolverParams -> DepResolverParams+setPreferenceDefault preferenceDefault params =+    params {+      depResolverPreferenceDefault = preferenceDefault+    }++dontUpgradeBasePackage :: DepResolverParams -> DepResolverParams+dontUpgradeBasePackage params =+    addConstraints extraConstraints params+  where+    extraConstraints =+      [ PackageInstalledConstraint pkgname+      | all (/=PackageName "base") (depResolverTargets params)+      , pkgname <-  [ PackageName "base", PackageName "ghc-prim" ]+      , isInstalled pkgname ]+    -- TODO: the top down resolver chokes on the base constraints+    -- below when there are no targets and thus no dep on base.+    -- Need to refactor contraints separate from needing packages.+    isInstalled = not . null+                . PackageIndex.lookupPackageName (depResolverInstalled params)++addAvailablePackages :: [AvailablePackage]+                     -> DepResolverParams -> DepResolverParams+addAvailablePackages pkgs params =+    params {+      depResolverAvailable = foldl (flip PackageIndex.insert)+                                   (depResolverAvailable params) pkgs+    }++hideInstalledPackagesSpecific :: [PackageId]+                              -> DepResolverParams -> DepResolverParams+hideInstalledPackagesSpecific pkgids params =+    --TODO: this should work using exclude constraints instead+    params {+      depResolverInstalled = foldl' (flip PackageIndex.deletePackageId)+                                    (depResolverInstalled params) pkgids+    }++hideInstalledPackagesAllVersions :: [PackageName]+                                 -> DepResolverParams -> DepResolverParams+hideInstalledPackagesAllVersions pkgnames params =+    --TODO: this should work using exclude constraints instead+    params {+      depResolverInstalled =+        foldl' (flip PackageIndex.deletePackageName)+               (depResolverInstalled params) pkgnames+    }+++hideBrokenInstalledPackages :: DepResolverParams -> DepResolverParams+hideBrokenInstalledPackages params =+    hideInstalledPackagesSpecific pkgids params+  where+    pkgids = map packageId+           . PackageIndex.reverseDependencyClosure (depResolverInstalled params)+           . map (packageId . fst)+           . PackageIndex.brokenPackages+           $ depResolverInstalled params+++upgradeDependencies :: DepResolverParams -> DepResolverParams+upgradeDependencies = setPreferenceDefault PreferAllLatest+++reinstallTargets :: DepResolverParams -> DepResolverParams+reinstallTargets params =+    hideInstalledPackagesAllVersions (depResolverTargets params) params+++standardInstallPolicy :: PackageIndex InstalledPackage+                      -> AvailablePackageDb+                      -> [PackageSpecifier AvailablePackage]+                      -> DepResolverParams+standardInstallPolicy+    installed (AvailablePackageDb available availablePrefs) pkgSpecifiers++  = addPreferences+      [ PackageVersionPreference name ver+      | (name, ver) <- Map.toList availablePrefs ]++  . addConstraints+      (concatMap pkgSpecifierConstraints pkgSpecifiers)++  . addTargets+      (map pkgSpecifierTarget pkgSpecifiers)++  . hideInstalledPackagesSpecific+      [ packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers ]++  . addAvailablePackages+      [ pkg  | SpecificSourcePackage pkg <- pkgSpecifiers ]++  $ basicDepResolverParams+      installed available+++-- ------------------------------------------------------------+-- * Interface to the standard resolver+-- ------------------------------------------------------------++defaultResolver :: DependencyResolver+defaultResolver = topDownResolver++-- | Run the dependency solver.+--+-- Since this is potentially an expensive operation, the result is wrapped in a+-- a 'Progress' structure that can be unfolded to provide progress information,+-- logging messages and the final result or an error.+--+resolveDependencies :: Platform+                    -> CompilerId+                    -> DepResolverParams+                    -> Progress String String InstallPlan++    --TODO: is this needed here? see dontUpgradeBasePackage+resolveDependencies platform comp params+  | null (depResolverTargets params)+  = return (mkInstallPlan platform comp [])++resolveDependencies platform comp params =++    fmap (mkInstallPlan platform comp)+  $ defaultResolver platform comp installed available+                    preferences constraints targets+  where+    DepResolverParams+      targets constraints+      prefs defpref+      installed available = dontUpgradeBasePackage+                          . hideBrokenInstalledPackages+                          $ params++    preferences = interpretPackagesPreference+                    (Set.fromList targets) defpref prefs+++-- | Make an install plan from the output of the dep resolver.+-- It checks that the plan is valid, or it's an error in the dep resolver.+--+mkInstallPlan :: Platform+              -> CompilerId+              -> [InstallPlan.PlanPackage] -> InstallPlan+mkInstallPlan platform comp pkgs =+  case InstallPlan.new platform comp (PackageIndex.fromList pkgs) of+    Right plan     -> plan+    Left  problems -> error $ unlines $+        "internal error: could not construct a valid install plan."+      : "The proposed (invalid) plan contained the following problems:"+      : map InstallPlan.showPlanProblem problems+++-- | Give an interpretation to the global 'PackagesPreference' as+--  specific per-package 'PackageVersionPreference'.+--+interpretPackagesPreference :: Set PackageName+                            -> PackagesPreferenceDefault+                            -> [PackagePreference]+                            -> (PackageName -> PackagePreferences)+interpretPackagesPreference selected defaultPref prefs =+  \pkgname -> PackagePreferences (versionPref pkgname) (installPref pkgname)++  where+    versionPref pkgname =+      fromMaybe anyVersion (Map.lookup pkgname versionPrefs)+    versionPrefs = Map.fromList+      [ (pkgname, pref)+      | PackageVersionPreference pkgname pref <- prefs ]++    installPref pkgname =+      fromMaybe (installPrefDefault pkgname) (Map.lookup pkgname installPrefs)+    installPrefs = Map.fromList+      [ (pkgname, pref)+      | PackageInstalledPreference pkgname pref <- prefs ]+    installPrefDefault = case defaultPref of+      PreferAllLatest         -> \_       -> PreferLatest+      PreferAllInstalled      -> \_       -> PreferInstalled+      PreferLatestForSelected -> \pkgname ->+        -- When you say cabal install foo, what you really mean is, prefer the+        -- latest version of foo, but the installed version of everything else+        if pkgname `Set.member` selected then PreferLatest+                                         else PreferInstalled++-- ------------------------------------------------------------+-- * Simple resolver that ignores dependencies+-- ------------------------------------------------------------++-- | A simplistic method of resolving a list of target package names to+-- available packages.+--+-- Specifically, it does not consider package dependencies at all. Unlike+-- 'resolveDependencies', no attempt is made to ensure that the selected+-- packages have dependencies that are satisfiable or consistent with+-- each other.+--+-- It is suitable for tasks such as selecting packages to download for user+-- inspection. It is not suitable for selecting packages to install.+--+-- Note: if no installed package index is available, it is ok to pass 'mempty'.+-- It simply means preferences for installed packages will be ignored.+--+resolveWithoutDependencies :: DepResolverParams+                           -> Either [ResolveNoDepsError] [AvailablePackage]+resolveWithoutDependencies (DepResolverParams targets constraints+                                prefs defpref installed available) =+    collectEithers (map selectPackage targets)+  where+    selectPackage :: PackageName -> Either ResolveNoDepsError AvailablePackage+    selectPackage pkgname+      | null choices = Left  $! ResolveUnsatisfiable pkgname requiredVersions+      | otherwise    = Right $! maximumBy bestByPrefs choices++      where+        -- Constraints+        requiredVersions = packageConstraints pkgname+        pkgDependency    = Dependency pkgname requiredVersions+        choices          = PackageIndex.lookupDependency available pkgDependency++        -- Preferences+        PackagePreferences preferredVersions preferInstalled+          = packagePreferences pkgname++        bestByPrefs   = comparing $ \pkg ->+                          (installPref pkg, versionPref pkg, packageVersion pkg)+        installPref   = case preferInstalled of+          PreferLatest    -> const False+          PreferInstalled -> isJust . PackageIndex.lookupPackageId installed+                           . packageId+        versionPref   pkg = packageVersion pkg `withinRange` preferredVersions++    packageConstraints :: PackageName -> VersionRange+    packageConstraints pkgname =+      Map.findWithDefault anyVersion pkgname packageVersionConstraintMap+    packageVersionConstraintMap =+      Map.fromList [ (name, range)+                   | PackageVersionConstraint name range <- constraints ]++    packagePreferences :: PackageName -> PackagePreferences+    packagePreferences = interpretPackagesPreference+                           (Set.fromList targets) defpref prefs+++collectEithers :: [Either a b] -> Either [a] [b]+collectEithers = collect . partitionEithers+  where+    collect ([], xs) = Right xs+    collect (errs,_) = Left errs+    partitionEithers :: [Either a b] -> ([a],[b])+    partitionEithers = foldr (either left right) ([],[])+     where+       left  a (l, r) = (a:l, r)+       right a (l, r) = (l, a:r)++-- | Errors for 'resolveWithoutDependencies'.+--+data ResolveNoDepsError =++     -- | A package name which cannot be resolved to a specific package.+     -- Also gives the constraint on the version and whether there was+     -- a constraint on the package being installed.+     ResolveUnsatisfiable PackageName VersionRange++instance Show ResolveNoDepsError where+  show (ResolveUnsatisfiable name ver) =+       "There is no available version of " ++ display name+    ++ " that satisfies " ++ display (simplifyVersionRange ver)

@@ -0,0 +1,776 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.Dependency.Types+-- Copyright   :  (c) Duncan Coutts 2008+-- License     :  BSD-like+--+-- Maintainer  :  cabal-devel@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- Common types for dependency resolution.+-----------------------------------------------------------------------------+module Distribution.Client.Dependency.TopDown (+    topDownResolver+  ) where++import Distribution.Client.Dependency.TopDown.Types+import qualified Distribution.Client.Dependency.TopDown.Constraints as Constraints+import Distribution.Client.Dependency.TopDown.Constraints+         ( Satisfiable(..) )+import qualified Distribution.Client.InstallPlan as InstallPlan+import Distribution.Client.InstallPlan+         ( PlanPackage(..) )+import Distribution.Client.Types+         ( AvailablePackage(..), ConfiguredPackage(..), InstalledPackage(..) )+import Distribution.Client.Dependency.Types+         ( DependencyResolver, PackageConstraint(..)+         , PackagePreferences(..), InstalledPreference(..)+         , Progress(..), foldProgress )++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+         , PackageFixedDeps(depends) )+import Distribution.PackageDescription+         ( PackageDescription(buildDepends) )+import Distribution.Client.PackageUtils+         ( externalBuildDepends )+import Distribution.PackageDescription.Configuration+         ( finalizePackageDescription, flattenPackageDescription )+import Distribution.Version+         ( VersionRange, anyVersion, withinRange, simplifyVersionRange+         , UpperBound(..), asVersionIntervals )+import Distribution.Compiler+         ( CompilerId )+import Distribution.System+         ( Platform )+import Distribution.Simple.Utils+         ( equating, comparing )+import Distribution.Text+         ( display )++import Data.List+         ( foldl', maximumBy, minimumBy, nub, sort, groupBy )+import Data.Maybe+         ( fromJust, fromMaybe, catMaybes )+import Data.Monoid+         ( Monoid(mempty) )+import Control.Monad+         ( guard )+import qualified Data.Set as Set+import Data.Set (Set)+import qualified Data.Map as Map+import qualified Data.Graph as Graph+import qualified Data.Array as Array+import Control.Exception+         ( assert )++-- ------------------------------------------------------------+-- * Search state types+-- ------------------------------------------------------------++type Constraints  = Constraints.Constraints+                      InstalledPackageEx UnconfiguredPackage ExclusionReason+type SelectedPackages = PackageIndex SelectedPackage++-- ------------------------------------------------------------+-- * The search tree type+-- ------------------------------------------------------------++data SearchSpace inherited pkg+   = ChoiceNode inherited [[(pkg, SearchSpace inherited pkg)]]+   | Failure Failure++-- ------------------------------------------------------------+-- * Traverse a search tree+-- ------------------------------------------------------------++explore :: (PackageName -> PackagePreferences)+        -> SearchSpace (SelectedPackages, Constraints, SelectionChanges)+                       SelectablePackage+        -> Progress Log Failure (SelectedPackages, Constraints)++explore _    (Failure failure)       = Fail failure+explore _    (ChoiceNode (s,c,_) []) = Done (s,c)+explore pref (ChoiceNode _ choices)  =+  case [ choice | [choice] <- choices ] of+    ((_, node'):_) -> Step (logInfo node') (explore pref node')+    []             -> Step (logInfo node') (explore pref node')+      where+        choice     = minimumBy (comparing topSortNumber) choices+        pkgname    = packageName . fst . head $ choice+        (_, node') = maximumBy (bestByPref pkgname) choice+  where+    topSortNumber choice = case fst (head choice) of+      InstalledOnly           (InstalledPackageEx  _ i _) -> i+      AvailableOnly           (UnconfiguredPackage _ i _) -> i+      InstalledAndAvailable _ (UnconfiguredPackage _ i _) -> i++    bestByPref pkgname = case packageInstalledPreference of+        PreferLatest    ->+          comparing (\(p,_) -> (               isPreferred p, packageId p))+        PreferInstalled ->+          comparing (\(p,_) -> (isInstalled p, isPreferred p, packageId p))+      where+        isInstalled (AvailableOnly _) = False+        isInstalled _                 = True+        isPreferred p = packageVersion p `withinRange` preferredVersions+        (PackagePreferences preferredVersions packageInstalledPreference)+          = pref pkgname++    logInfo node = Select selected discarded+      where (selected, discarded) = case node of+              Failure    _               -> ([], [])+              ChoiceNode (_,_,changes) _ -> changes++-- ------------------------------------------------------------+-- * Generate a search tree+-- ------------------------------------------------------------++type ConfigurePackage = PackageIndex SelectablePackage+                     -> SelectablePackage+                     -> Either [Dependency] SelectedPackage++-- | (packages selected, packages discarded)+type SelectionChanges = ([SelectedPackage], [PackageIdentifier])++searchSpace :: ConfigurePackage+            -> Constraints+            -> SelectedPackages+            -> SelectionChanges+            -> Set PackageName+            -> SearchSpace (SelectedPackages, Constraints, SelectionChanges)+                           SelectablePackage+searchSpace configure constraints selected changes next =+  ChoiceNode (selected, constraints, changes)+    [ [ (pkg, select name pkg)+      | pkg <- PackageIndex.lookupPackageName available name ]+    | name <- Set.elems next ]+  where+    available = Constraints.choices constraints++    select name pkg = case configure available pkg of+      Left missing -> Failure $ ConfigureFailed pkg+                        [ (dep, Constraints.conflicting constraints dep)+                        | dep <- missing ]+      Right pkg' -> case constrainDeps pkg' newDeps constraints [] of+        Left failure       -> Failure failure+        Right (constraints', newDiscarded) ->+          searchSpace configure+            constraints' selected' (newSelected, newDiscarded) next'+        where+          selected' = foldl' (flip PackageIndex.insert) selected newSelected+          newSelected =+            case Constraints.isPaired constraints (packageId pkg) of+              Nothing     -> [pkg']+              Just pkgid' -> [pkg', pkg'']+                where+                  Just pkg'' = fmap (\(InstalledOnly p) -> InstalledOnly p)+                    (PackageIndex.lookupPackageId available pkgid')++          newPkgs   = [ name'+                      | dep <- newDeps+                      , let (Dependency name' _) = untagDependency dep+                      , null (PackageIndex.lookupPackageName selected' name') ]+          newDeps   = concatMap packageConstraints newSelected+          next'     = Set.delete name+                    $ foldl' (flip Set.insert) next newPkgs++packageConstraints :: SelectedPackage -> [TaggedDependency]+packageConstraints = either installedConstraints availableConstraints+                   . preferAvailable+  where+    preferAvailable (InstalledOnly           pkg) = Left pkg+    preferAvailable (AvailableOnly           pkg) = Right pkg+    preferAvailable (InstalledAndAvailable _ pkg) = Right pkg+    installedConstraints (InstalledPackageEx    _ _ deps) =+      [ TaggedDependency InstalledConstraint (thisPackageVersion dep)+      | dep <- deps ]+    availableConstraints (SemiConfiguredPackage _ _ deps) =+      [ TaggedDependency NoInstalledConstraint dep | dep <- deps ]++constrainDeps :: SelectedPackage -> [TaggedDependency] -> Constraints+              -> [PackageIdentifier]+              -> Either Failure (Constraints, [PackageIdentifier])+constrainDeps pkg []         cs discard =+  case addPackageSelectConstraint (packageId pkg) cs of+    Satisfiable cs' discard' -> Right (cs', discard' ++ discard)+    _                        -> impossible+constrainDeps pkg (dep:deps) cs discard =+  case addPackageDependencyConstraint (packageId pkg) dep cs of+    Satisfiable cs' discard' -> constrainDeps pkg deps cs' (discard' ++ discard)+    Unsatisfiable            -> impossible+    ConflictsWith conflicts  ->+      Left (DependencyConflict pkg dep conflicts)++-- ------------------------------------------------------------+-- * The main algorithm+-- ------------------------------------------------------------++search :: ConfigurePackage+       -> (PackageName -> PackagePreferences)+       -> Constraints+       -> Set PackageName+       -> Progress Log Failure (SelectedPackages, Constraints)+search configure pref constraints =+  explore pref . searchSpace configure constraints mempty ([], [])++-- ------------------------------------------------------------+-- * The top level resolver+-- ------------------------------------------------------------++-- | The main exported resolver, with string logging and failure types to fit+-- the standard 'DependencyResolver' interface.+--+topDownResolver :: DependencyResolver+topDownResolver = ((((((mapMessages .).).).).).) . topDownResolver'+  where+    mapMessages :: Progress Log Failure a -> Progress String String a+    mapMessages = foldProgress (Step . showLog) (Fail . showFailure) Done++-- | The native resolver with detailed structured logging and failure types.+--+topDownResolver' :: Platform -> CompilerId+                 -> PackageIndex InstalledPackage+                 -> PackageIndex AvailablePackage+                 -> (PackageName -> PackagePreferences)+                 -> [PackageConstraint]+                 -> [PackageName]+                 -> Progress Log Failure [PlanPackage]+topDownResolver' platform comp installed available+                 preferences constraints targets =+      fmap (uncurry finalise)+    . (\cs -> search configure preferences cs initialPkgNames)+  =<< addTopLevelConstraints constraints constraintSet++  where+    configure   = configurePackage platform comp+    constraintSet :: Constraints+    constraintSet = Constraints.empty+      (annotateInstalledPackages             topSortNumber installed')+      (annotateAvailablePackages constraints topSortNumber available')+    (installed', available') = selectNeededSubset installed available+                                                  initialPkgNames+    topSortNumber = topologicalSortNumbering installed' available'++    initialPkgNames = Set.fromList targets++    finalise selected' constraints' =+        PackageIndex.allPackages+      . fst . improvePlan installed' constraints'+      . PackageIndex.fromList+      $ finaliseSelectedPackages preferences selected' constraints'++addTopLevelConstraints :: [PackageConstraint] -> Constraints+                       -> Progress a Failure Constraints+addTopLevelConstraints []                                      cs = Done cs+addTopLevelConstraints (PackageFlagsConstraint   _   _  :deps) cs =+  addTopLevelConstraints deps cs++addTopLevelConstraints (PackageVersionConstraint pkg ver:deps) cs =+  case addTopLevelVersionConstraint pkg ver cs of+    Satisfiable cs' _       ->+      addTopLevelConstraints deps cs'++    Unsatisfiable           ->+      Fail (TopLevelVersionConstraintUnsatisfiable pkg ver)++    ConflictsWith conflicts ->+      Fail (TopLevelVersionConstraintConflict pkg ver conflicts)++addTopLevelConstraints (PackageInstalledConstraint pkg:deps) cs =+  case addTopLevelInstalledConstraint pkg cs of+    Satisfiable cs' _       -> addTopLevelConstraints deps cs'++    Unsatisfiable           ->+      Fail (TopLevelInstallConstraintUnsatisfiable pkg)++    ConflictsWith conflicts ->+      Fail (TopLevelInstallConstraintConflict pkg conflicts)++configurePackage :: Platform -> CompilerId -> ConfigurePackage+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 dependencySatisfiable+                                    platform comp [] p of+      Left missing        -> Left missing+      Right (pkg, flags') -> Right $+        SemiConfiguredPackage apkg flags' (externalBuildDepends 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 InstalledPackage+                          -> PackageIndex InstalledPackageEx+annotateInstalledPackages dfsNumber installed = PackageIndex.fromList+  [ InstalledPackageEx pkg (dfsNumber (packageName pkg)) (transitiveDepends pkg)+  | pkg <- PackageIndex.allPackages installed ]+  where+    transitiveDepends :: InstalledPackage -> [PackageIdentifier]+    transitiveDepends = map (packageId . toPkg) . tail . Graph.reachable graph+                      . fromJust . toVertex . packageId+    (graph, toPkg, toVertex) = PackageIndex.dependencyGraph installed+++-- | Annotate each available packages with its topological sort number and any+-- user-supplied partial flag assignment.+--+annotateAvailablePackages :: [PackageConstraint]+                          -> (PackageName -> TopologicalSortNumber)+                          -> PackageIndex AvailablePackage+                          -> PackageIndex UnconfiguredPackage+annotateAvailablePackages constraints dfsNumber available = PackageIndex.fromList+  [ UnconfiguredPackage pkg (dfsNumber name) (flagsFor name)+  | pkg <- PackageIndex.allPackages available+  , let name = packageName pkg ]+  where+    flagsFor = fromMaybe [] . flip Map.lookup flagsMap+    flagsMap = Map.fromList+      [ (name, flags)+      | PackageFlagsConstraint name flags <- constraints ]++-- | One of the heuristics we use when guessing which path to take in the+-- search space is an ordering on the choices we make. It's generally better+-- to make decisions about packages higer in the dep graph first since they+-- place constraints on packages lower in the dep graph.+--+-- To pick them in that order we annotate each package with its topological+-- sort number. So if package A depends on package B then package A will have+-- a lower topological sort number than B and we'll make a choice about which+-- version of A to pick before we make a choice about B (unless there is only+-- one possible choice for B in which case we pick that immediately).+--+-- To construct these topological sort numbers we combine and flatten the+-- installed and available package sets. We consider only dependencies between+-- named packages, not including versions and for not-yet-configured packages+-- we look at all the possible dependencies, not just those under any single+-- flag assignment. This means we can actually get impossible combinations of+-- edges and even cycles, but that doesn't really matter here, it's only a+-- heuristic.+--+topologicalSortNumbering :: PackageIndex InstalledPackage+                         -> PackageIndex AvailablePackage+                         -> (PackageName -> TopologicalSortNumber)+topologicalSortNumbering installed available =+    \pkgname -> let Just vertex = toVertex pkgname+                 in topologicalSortNumbers Array.! vertex+  where+    topologicalSortNumbers = Array.array (Array.bounds graph)+                                         (zip (Graph.topSort graph) [0..])+    (graph, _, toVertex)   = Graph.graphFromEdges $+         [ ((), packageName pkg, nub deps)+         | pkgs@(pkg:_) <- PackageIndex.allPackagesByName installed+         , let deps = [ packageName dep+                      | pkg' <- pkgs+                      , dep  <- depends pkg' ] ]+      ++ [ ((), packageName pkg, nub deps)+         | pkgs@(pkg:_) <- PackageIndex.allPackagesByName available+         , let deps = [ depName+                      | AvailablePackage _ pkg' _ <- pkgs+                      , Dependency depName _ <-+                          buildDepends (flattenPackageDescription pkg') ] ]++-- | We don't need the entire index (which is rather large and costly if we+-- force it by examining the whole thing). So trace out the maximul subset of+-- each index that we could possibly ever need. Do this by flattening packages+-- and looking at the names of all possible dependencies.+--+selectNeededSubset :: PackageIndex InstalledPackage+                   -> PackageIndex AvailablePackage+                   -> Set PackageName+                   -> (PackageIndex InstalledPackage+                      ,PackageIndex AvailablePackage)+selectNeededSubset installed available = select mempty mempty+  where+    select :: PackageIndex InstalledPackage+           -> PackageIndex AvailablePackage+           -> Set PackageName+           -> (PackageIndex InstalledPackage+              ,PackageIndex AvailablePackage)+    select installed' available' remaining+      | Set.null remaining = (installed', available')+      | otherwise = select installed'' available'' remaining''+      where+        (next, remaining') = Set.deleteFindMin remaining+        moreInstalled = PackageIndex.lookupPackageName installed next+        moreAvailable = PackageIndex.lookupPackageName available next+        moreRemaining = -- we filter out packages already included in the indexes+                        -- this avoids an infinite loop if a package depends on itself+                        -- like base-3.0.3.0 with base-4.0.0.0+                        filter notAlreadyIncluded+                      $ [ packageName dep+                        | pkg <- moreInstalled+                        , dep <- depends pkg ]+                     ++ [ name+                        | AvailablePackage _ pkg _ <- moreAvailable+                        , Dependency name _ <-+                            buildDepends (flattenPackageDescription pkg) ]+        installed''   = foldl' (flip PackageIndex.insert) installed' moreInstalled+        available''   = foldl' (flip PackageIndex.insert) available' moreAvailable+        remaining''   = foldl' (flip         Set.insert) remaining' moreRemaining+        notAlreadyIncluded name = null (PackageIndex.lookupPackageName installed' name)+                                  && null (PackageIndex.lookupPackageName available' name)++-- ------------------------------------------------------------+-- * Post processing the solution+-- ------------------------------------------------------------++finaliseSelectedPackages :: (PackageName -> PackagePreferences)+                         -> SelectedPackages+                         -> Constraints+                         -> [PlanPackage]+finaliseSelectedPackages pref selected constraints =+  map finaliseSelected (PackageIndex.allPackages selected)+  where+    remainingChoices = Constraints.choices constraints+    finaliseSelected (InstalledOnly         ipkg     ) = finaliseInstalled ipkg+    finaliseSelected (AvailableOnly              apkg) = finaliseAvailable Nothing apkg+    finaliseSelected (InstalledAndAvailable ipkg apkg) =+      case PackageIndex.lookupPackageId remainingChoices (packageId ipkg) of+        Nothing                          -> impossible --picked package not in constraints+        Just (AvailableOnly _)           -> impossible --to constrain to avail only+        Just (InstalledOnly _)           -> finaliseInstalled ipkg+        Just (InstalledAndAvailable _ _) -> finaliseAvailable (Just ipkg) apkg++    finaliseInstalled (InstalledPackageEx pkg _ _) = InstallPlan.PreExisting pkg+    finaliseAvailable mipkg (SemiConfiguredPackage pkg flags deps) =+      InstallPlan.Configured (ConfiguredPackage pkg flags deps')+      where+        deps' = map (packageId . pickRemaining mipkg) deps++    pickRemaining mipkg dep@(Dependency _name versionRange) =+          case PackageIndex.lookupDependency remainingChoices dep of+            []        -> impossible+            [pkg']    -> pkg'+            remaining -> assert (checkIsPaired remaining)+                       $ maximumBy bestByPref remaining+      where+        -- We order candidate packages to pick for a dependency by these+        -- three factors. The last factor is just highest version wins.+        bestByPref =+          comparing (\p -> (isCurrent p, isPreferred p, packageVersion p))+        -- 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 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+        -- preferred version according to the hackage or user's suggested+        -- version constraints. TODO: distinguish hacks from prefs+        bounded = boundedAbove versionRange+        isPreferred p+          | bounded   = True -- any constant will do+          | otherwise = packageVersion p `withinRange` preferredVersions+          where (PackagePreferences preferredVersions _) = pref (packageName p)++        boundedAbove :: VersionRange -> Bool+        boundedAbove vr = case asVersionIntervals vr of+          []        -> True -- this is the inconsistent version range.+          intervals -> case last intervals of+            (_,   UpperBound _ _) -> True+            (_, NoUpperBound    ) -> False++        -- We really only expect to find more than one choice remaining when+        -- we're finalising a dependency on a paired package.+        checkIsPaired [p1, p2] =+          case Constraints.isPaired constraints (packageId p1) of+            Just p2'   -> packageId p2' == packageId p2+            Nothing    -> False+        checkIsPaired _ = False++-- | Improve an existing installation plan by, where possible, swapping+-- packages we plan to install with ones that are already installed.+-- This may add additional constraints due to the dependencies of installed+-- packages on other installed packages.+--+improvePlan :: PackageIndex InstalledPackage+            -> Constraints+            -> PackageIndex PlanPackage+            -> (PackageIndex PlanPackage, Constraints)+improvePlan installed constraints0 selected0 =+  foldl' improve (selected0, constraints0) (reverseTopologicalOrder selected0)+  where+    improve (selected, constraints) = fromMaybe (selected, constraints)+                                    . improvePkg selected constraints++    -- The idea is to improve the plan by swapping a configured package for+    -- an equivalent installed one. For a particular package the condition is+    -- that the package be in a configured state, that a the same version be+    -- already installed with the exact same dependencies and all the packages+    -- in the plan that it depends on are in the installed state+    improvePkg selected constraints pkgid = do+      Configured pkg  <- PackageIndex.lookupPackageId selected  pkgid+      ipkg            <- PackageIndex.lookupPackageId installed pkgid+      guard $ all (isInstalled selected) (depends pkg)+      tryInstalled selected constraints [ipkg]++    isInstalled selected pkgid =+      case PackageIndex.lookupPackageId selected pkgid of+        Just (PreExisting _) -> True+        _                    -> False++    tryInstalled :: PackageIndex PlanPackage -> Constraints+                 -> [InstalledPackage]+                 -> Maybe (PackageIndex PlanPackage, Constraints)+    tryInstalled selected constraints [] = Just (selected, constraints)+    tryInstalled selected constraints (pkg:pkgs) =+      case constraintsOk (packageId pkg) (depends pkg) constraints of+        Nothing           -> Nothing+        Just constraints' -> tryInstalled selected' constraints' pkgs'+          where+            selected' = PackageIndex.insert (PreExisting pkg) selected+            pkgs'      = catMaybes (map notSelected (depends pkg)) ++ pkgs+            notSelected pkgid =+              case (PackageIndex.lookupPackageId installed pkgid+                   ,PackageIndex.lookupPackageId selected  pkgid) of+                (Just pkg', Nothing) -> Just pkg'+                _                    -> Nothing++    constraintsOk _     []              constraints = Just constraints+    constraintsOk pkgid (pkgid':pkgids) constraints =+      case addPackageDependencyConstraint pkgid dep constraints of+        Satisfiable constraints' _ -> constraintsOk pkgid pkgids constraints'+        _                          -> Nothing+      where+        dep = TaggedDependency InstalledConstraint (thisPackageVersion pkgid')++    reverseTopologicalOrder :: PackageFixedDeps pkg+                            => PackageIndex pkg -> [PackageIdentifier]+    reverseTopologicalOrder index = map (packageId . toPkg)+                                  . Graph.topSort+                                  . Graph.transposeG+                                  $ graph+      where (graph, toPkg, _) = PackageIndex.dependencyGraph index++-- ------------------------------------------------------------+-- * Adding and recording constraints+-- ------------------------------------------------------------++addPackageSelectConstraint :: PackageIdentifier -> Constraints+                           -> Satisfiable Constraints+                                [PackageIdentifier] ExclusionReason+addPackageSelectConstraint pkgid constraints =+  Constraints.constrain dep reason constraints+  where+    dep    = TaggedDependency NoInstalledConstraint (thisPackageVersion pkgid)+    reason = SelectedOther pkgid++addPackageExcludeConstraint :: PackageIdentifier -> Constraints+                            -> Satisfiable Constraints+                                 [PackageIdentifier] ExclusionReason+addPackageExcludeConstraint pkgid constraints =+  Constraints.constrain dep reason constraints+  where+    dep    = TaggedDependency NoInstalledConstraint+               (notThisPackageVersion pkgid)+    reason = ExcludedByConfigureFail++addPackageDependencyConstraint :: PackageIdentifier -> TaggedDependency -> Constraints+                               -> Satisfiable Constraints+                                    [PackageIdentifier] ExclusionReason+addPackageDependencyConstraint pkgid dep constraints =+  Constraints.constrain dep reason constraints+  where+    reason = ExcludedByPackageDependency pkgid dep++addTopLevelVersionConstraint :: PackageName -> VersionRange+                             -> Constraints+                             -> Satisfiable Constraints+                                  [PackageIdentifier] ExclusionReason+addTopLevelVersionConstraint pkg ver constraints =+  Constraints.constrain taggedDep reason constraints+  where+    dep       = Dependency pkg ver+    taggedDep = TaggedDependency NoInstalledConstraint dep+    reason    = ExcludedByTopLevelDependency dep++addTopLevelInstalledConstraint :: PackageName+                               -> Constraints+                               -> Satisfiable Constraints+                                    [PackageIdentifier] ExclusionReason+addTopLevelInstalledConstraint pkg constraints =+  Constraints.constrain taggedDep reason constraints+  where+    dep       = Dependency pkg anyVersion+    taggedDep = TaggedDependency InstalledConstraint dep+    reason    = ExcludedByTopLevelDependency dep++-- ------------------------------------------------------------+-- * Reasons for constraints+-- ------------------------------------------------------------++-- | For every constraint we record we also record the reason that constraint+-- is needed. So if we end up failing due to conflicting constraints then we+-- can give an explnanation as to what was conflicting and why.+--+data ExclusionReason =++     -- | We selected this other version of the package. That means we exclude+     -- all the other versions.+     SelectedOther PackageIdentifier++     -- | We excluded this version of the package because it failed to+     -- configure probably because of unsatisfiable deps.+   | ExcludedByConfigureFail++     -- | We excluded this version of the package because another package that+     -- we selected imposed a dependency which this package did not satisfy.+   | ExcludedByPackageDependency PackageIdentifier TaggedDependency++     -- | We excluded this version of the package because it did not satisfy+     -- a dependency given as an original top level input.+     --+   | ExcludedByTopLevelDependency Dependency++-- | Given an excluded package and the reason it was excluded, produce a human+-- readable explanation.+--+showExclusionReason :: PackageIdentifier -> ExclusionReason -> String+showExclusionReason pkgid (SelectedOther pkgid') =+  display pkgid ++ " was excluded because " +++  display pkgid' ++ " was selected instead"+showExclusionReason pkgid ExcludedByConfigureFail =+  display pkgid ++ " was excluded because it could not be configured"+showExclusionReason pkgid (ExcludedByPackageDependency pkgid' dep) =+  display pkgid ++ " was excluded because " +++  display pkgid' ++ " requires " ++ displayDep (untagDependency dep)+showExclusionReason pkgid (ExcludedByTopLevelDependency dep) =+  display pkgid ++ " was excluded because of the top level dependency " +++  displayDep dep+++-- ------------------------------------------------------------+-- * Logging progress and failures+-- ------------------------------------------------------------++data Log = Select [SelectedPackage] [PackageIdentifier]+data Failure+   = ConfigureFailed+       SelectablePackage+       [(Dependency, [(PackageIdentifier, [ExclusionReason])])]+   | DependencyConflict+       SelectedPackage TaggedDependency+       [(PackageIdentifier, [ExclusionReason])]+   | TopLevelVersionConstraintConflict+       PackageName VersionRange+       [(PackageIdentifier, [ExclusionReason])]+   | TopLevelVersionConstraintUnsatisfiable+       PackageName VersionRange+   | TopLevelInstallConstraintConflict+       PackageName+       [(PackageIdentifier, [ExclusionReason])]+   | TopLevelInstallConstraintUnsatisfiable+       PackageName++showLog :: Log -> String+showLog (Select selected discarded) = case (selectedMsg, discardedMsg) of+  ("", y) -> y+  (x, "") -> x+  (x,  y) -> x ++ " and " ++ y++  where+    selectedMsg  = "selecting " ++ case selected of+      []     -> ""+      [s]    -> display (packageId s) ++ " " ++ kind s+      (s:ss) -> listOf id+              $ (display (packageId s) ++ " " ++ kind s)+              : [ display (packageVersion s') ++ " " ++ kind s'+                | s' <- ss ]++    kind (InstalledOnly _)           = "(installed)"+    kind (AvailableOnly _)           = "(hackage)"+    kind (InstalledAndAvailable _ _) = "(installed or hackage)"++    discardedMsg = case discarded of+      []  -> ""+      _   -> "discarding " ++ listOf id+        [ element+        | (pkgid:pkgids) <- groupBy (equating packageName) (sort discarded)+        , element <- display pkgid : map (display . packageVersion) pkgids ]++showFailure :: Failure -> String+showFailure (ConfigureFailed pkg missingDeps) =+     "cannot configure " ++ displayPkg pkg ++ ". It requires "+  ++ listOf (displayDep . fst) missingDeps+  ++ '\n' : unlines (map (uncurry whyNot) missingDeps)++  where+    whyNot (Dependency name ver) [] =+         "There is no available version of " ++ display name+      ++ " that satisfies " ++ displayVer ver++    whyNot dep conflicts =+         "For the dependency on " ++ displayDep dep+      ++ " there are these packages: " ++ listOf display pkgs+      ++ ". However none of them are available.\n"+      ++ unlines [ showExclusionReason (packageId pkg') reason+                 | (pkg', reasons) <- conflicts, reason <- reasons ]++      where pkgs = map fst conflicts++showFailure (DependencyConflict pkg (TaggedDependency _ dep) conflicts) =+     "dependencies conflict: "+  ++ displayPkg pkg ++ " requires " ++ displayDep dep ++ " however\n"+  ++ unlines [ showExclusionReason (packageId pkg') reason+             | (pkg', reasons) <- conflicts, reason <- reasons ]++showFailure (TopLevelVersionConstraintConflict name ver conflicts) =+     "constraints conflict: "+  ++ "top level constraint " ++ displayDep (Dependency name ver) ++ " however\n"+  ++ unlines [ showExclusionReason (packageId pkg') reason+             | (pkg', reasons) <- conflicts, reason <- reasons ]++showFailure (TopLevelVersionConstraintUnsatisfiable name ver) =+     "There is no available version of " ++ display name+      ++ " that satisfies " ++ displayVer ver++showFailure (TopLevelInstallConstraintConflict name conflicts) =+     "constraints conflict: "+  ++ "top level constraint " ++ display name ++ "-installed however\n"+  ++ unlines [ showExclusionReason (packageId pkg') reason+             | (pkg', reasons) <- conflicts, reason <- reasons ]++showFailure (TopLevelInstallConstraintUnsatisfiable name) =+     "There is no installed version of " ++ display name++displayVer :: VersionRange -> String+displayVer = display . simplifyVersionRange++displayDep :: Dependency -> String+displayDep = display . simplifyDependency++simplifyDependency :: Dependency -> Dependency+simplifyDependency (Dependency name range) =+  Dependency name (simplifyVersionRange range)++-- ------------------------------------------------------------+-- * Utils+-- ------------------------------------------------------------++impossible :: a+impossible = internalError "impossible"++internalError :: String -> a+internalError msg = error $ "internal error: " ++ msg++displayPkg :: Package pkg => pkg -> String+displayPkg = display . packageId++listOf :: (a -> String) -> [a] -> String+listOf _    []   = []+listOf disp [x0] = disp x0+listOf disp (x0:x1:xs) = disp x0 ++ go x1 xs+  where go x []       = " and " ++ disp x+        go x (x':xs') = ", " ++ disp x ++ go x' xs'

@@ -0,0 +1,316 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.Dependency.TopDown.Constraints+-- Copyright   :  (c) Duncan Coutts 2008+-- License     :  BSD-like+--+-- Maintainer  :  duncan@community.haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- A set of satisfiable dependencies (package version constraints).+-----------------------------------------------------------------------------+module Distribution.Client.Dependency.TopDown.Constraints (+  Constraints,+  empty,+  choices,+  isPaired,++  constrain,+  Satisfiable(..),+  conflicting,+  ) where++import Distribution.Client.Dependency.TopDown.Types+import qualified Distribution.Client.PackageIndex as PackageIndex+import Distribution.Client.PackageIndex (PackageIndex)+import Distribution.Package+         ( PackageName, PackageIdentifier(..)+         , Package(packageId), packageName, packageVersion+         , PackageFixedDeps(depends)+         , Dependency(Dependency) )+import Distribution.Version+         ( Version, withinRange )+import Distribution.Client.Utils+         ( mergeBy, MergeResult(..) )++import Data.List+         ( foldl' )+import Data.Monoid+         ( Monoid(mempty) )+import Data.Maybe+         ( catMaybes )+import qualified Data.Map as Map+import Data.Map (Map)+import Control.Exception+         ( assert )++-- | A set of constraints on package versions. For each package name we record+-- what other packages depends on it and what constraints they impose on the+-- version of the package.+--+data (Package installed, Package available)+  => Constraints installed available reason+   = Constraints++       -- Remaining available choices+       (PackageIndex (InstalledOrAvailable installed available))++       -- Paired choices+       (Map PackageName (Version, Version))++       -- Choices that we have excluded for some reason+       -- usually by applying constraints+       (PackageIndex (ExcludedPackage PackageIdentifier reason))++       -- Purely for the invariant, we keep a copy of the original index+       (PackageIndex (InstalledOrAvailable installed available))+++data ExcludedPackage pkg reason+   = ExcludedPackage pkg [reason] -- reasons for excluding just the available+                         [reason] -- reasons for excluding installed and avail++instance Package pkg => Package (ExcludedPackage pkg reason) where+  packageId (ExcludedPackage p _ _) = packageId p++-- | There is a conservation of packages property. Packages are never gained or+-- lost, they just transfer from the remaining pot to the excluded pot.+--+invariant :: (Package installed, Package available)+          => Constraints installed available a -> Bool+invariant (Constraints available _ excluded original) = all check merged+  where+    merged = mergeBy (\a b -> packageId a `compare` mergedPackageId b)+                     (PackageIndex.allPackages original)+                     (mergeBy (\a b -> packageId a `compare` packageId b)+                              (PackageIndex.allPackages available)+                              (PackageIndex.allPackages excluded))+      where+        mergedPackageId (OnlyInLeft  p  ) = packageId p+        mergedPackageId (OnlyInRight   p) = packageId p+        mergedPackageId (InBoth      p _) = packageId p++    check (InBoth (InstalledOnly _) cur) = case cur of+      -- If the package was originally installed only then+      -- now it's either still remaining as installed only+      -- or it has been excluded in which case we excluded both+      -- installed and available since it was only installed+      OnlyInLeft  (InstalledOnly _)            -> True+      OnlyInRight (ExcludedPackage _ [] (_:_)) -> True+      _                                        -> False++    check (InBoth (AvailableOnly _) cur) = case cur of+      -- If the package was originally available only then+      -- now it's either still remaining as available only+      -- or it has been excluded in which case we excluded both+      -- installed and available since it was only available+      OnlyInLeft  (AvailableOnly   _)          -> True+      OnlyInRight (ExcludedPackage _ [] (_:_)) -> True+      _                                        -> True++    -- If the package was originally installed and available+    -- then there are three cases.+    check (InBoth (InstalledAndAvailable _ _) cur) = case cur of+      -- We can have both remaining:+      OnlyInLeft                    (InstalledAndAvailable _ _)  -> True+      -- both excluded, in particular it can have had the available excluded+      -- and later had both excluded so we do not mind if the available excluded+      -- is empty or non-empty.+      OnlyInRight                   (ExcludedPackage _ _  (_:_)) -> True+      -- the installed remaining and the available excluded:+      InBoth      (InstalledOnly _) (ExcludedPackage _ (_:_) []) -> True+      _                                                          -> False++    check _ = False++-- | An update to the constraints can move packages between the two piles+-- but not gain or loose packages.+transitionsTo :: (Package installed, Package available)+              => Constraints installed available a+              -> Constraints installed available a -> Bool+transitionsTo constraints @(Constraints available  _ excluded  _)+              constraints'@(Constraints available' _ excluded' _) =+     invariant constraints && invariant constraints'+  && null availableGained  && null excludedLost+  && map packageId availableLost == map packageId excludedGained++  where+    availableLost   = foldr lost [] availableChange where+      lost (OnlyInLeft  pkg)          rest = pkg : rest+      lost (InBoth (InstalledAndAvailable _ pkg)+                   (InstalledOnly _)) rest = AvailableOnly pkg : rest+      lost _                          rest = rest+    availableGained = [ pkg | OnlyInRight pkg <- availableChange ]+    excludedLost    = [ pkg | OnlyInLeft  pkg <- excludedChange  ]+    excludedGained  = [ pkg | OnlyInRight pkg <- excludedChange  ]+                   ++ [ pkg | InBoth (ExcludedPackage _ (_:_) [])+                                 pkg@(ExcludedPackage _ (_:_) (_:_))+                                              <- excludedChange  ]+    availableChange = mergeBy (\a b -> packageId a `compare` packageId b)+                              (PackageIndex.allPackages available)+                              (PackageIndex.allPackages available')+    excludedChange  = mergeBy (\a b -> packageId a `compare` packageId b)+                              (PackageIndex.allPackages excluded)+                              (PackageIndex.allPackages excluded')++-- | We construct 'Constraints' with an initial 'PackageIndex' of all the+-- packages available.+--+empty :: (PackageFixedDeps installed, Package available)+      => PackageIndex installed+      -> PackageIndex available+      -> Constraints installed available reason+empty installed available = Constraints pkgs pairs mempty pkgs+  where+    pkgs = PackageIndex.fromList+         . map toInstalledOrAvailable+         $ mergeBy (\a b -> packageId a `compare` packageId b)+                   (PackageIndex.allPackages installed)+                   (PackageIndex.allPackages available)+    toInstalledOrAvailable (OnlyInLeft  i  ) = InstalledOnly         i+    toInstalledOrAvailable (OnlyInRight   a) = AvailableOnly           a+    toInstalledOrAvailable (InBoth      i a) = InstalledAndAvailable i a++    -- pick up cases like base-3 and 4 where one version depends on the other:+    pairs = Map.fromList+      [ (name, (packageVersion pkgid1, packageVersion pkgid2))+      | [pkg1, pkg2] <- PackageIndex.allPackagesByName installed+      , let name   = packageName pkg1+            pkgid1 = packageId pkg1+            pkgid2 = packageId pkg2+      ,    any ((pkgid1==) . packageId) (depends pkg2)+        || any ((pkgid2==) . packageId) (depends pkg1) ]++-- | The package choices that are still available.+--+choices :: (Package installed, Package available)+        => Constraints installed available reason+        -> PackageIndex (InstalledOrAvailable installed available)+choices (Constraints available _ _ _) = available++isPaired :: (Package installed, Package available)+         => Constraints installed available reason+         -> PackageIdentifier -> Maybe PackageIdentifier+isPaired (Constraints _ pairs _ _) (PackageIdentifier name version) =+  case Map.lookup name pairs of+    Just (v1, v2)+      | version == v1 -> Just (PackageIdentifier name v2)+      | version == v2 -> Just (PackageIdentifier name v1)+    _                 -> Nothing++data Satisfiable constraints discarded reason+       = Satisfiable constraints discarded+       | Unsatisfiable+       | ConflictsWith [(PackageIdentifier, [reason])]++constrain :: (Package installed, Package available)+          => TaggedDependency+          -> reason+          -> Constraints installed available reason+          -> Satisfiable (Constraints installed available reason)+                         [PackageIdentifier] reason+constrain (TaggedDependency installedConstraint (Dependency name versionRange))+          reason constraints@(Constraints available paired excluded original)++  | not anyRemaining+  = if null conflicts then Unsatisfiable+                      else ConflictsWith conflicts++  | otherwise+  = let constraints' = Constraints available' paired excluded' original+     in assert (constraints `transitionsTo` constraints') $+        Satisfiable constraints' (map packageId newExcluded)++  where+  -- This tells us if any packages would remain at all for this package name if+  -- we applied this constraint. This amounts to checking if any package+  -- satisfies the given constraint, including version range and installation+  -- status.+  --+  anyRemaining = any satisfiesConstraint availableChoices++  conflicts = [ (packageId pkg, reasonsAvail ++ reasonsAll)+              | ExcludedPackage pkg reasonsAvail reasonsAll <- excludedChoices+              , satisfiesVersionConstraint pkg ]++  -- Applying this constraint may involve deleting some choices for this+  -- package name, or restricting which install states are available.+  available' = updateAvailable available+  updateAvailable = flip (foldl' (flip update)) availableChoices where+    update pkg | not (satisfiesVersionConstraint pkg)+               = PackageIndex.deletePackageId (packageId pkg)+    update _   | installedConstraint == NoInstalledConstraint+               = id+    update pkg = case pkg of+      InstalledOnly         _   -> id+      AvailableOnly           _ -> PackageIndex.deletePackageId (packageId pkg)+      InstalledAndAvailable i _ -> PackageIndex.insert (InstalledOnly i)++  -- Applying the constraint means adding exclusions for the packages that+  -- we're just freshly excluding, ie the ones we're removing from available.+  excluded' = foldl' (flip PackageIndex.insert) excluded+                (newExcluded ++ oldExcluded)++  newExcluded = catMaybes (map exclude availableChoices) where+    exclude pkg+      | not (satisfiesVersionConstraint pkg)+      = Just (ExcludedPackage pkgid [] [reason])+      | installedConstraint == NoInstalledConstraint+      = Nothing+      | otherwise = case pkg of+      InstalledOnly         _   -> Nothing+      AvailableOnly           _ -> Just (ExcludedPackage pkgid [] [reason])+      InstalledAndAvailable _ _ ->+        case PackageIndex.lookupPackageId excluded pkgid of+          Just (ExcludedPackage _ avail both)+                  -> Just (ExcludedPackage pkgid (reason:avail) both)+          Nothing -> Just (ExcludedPackage pkgid [reason] [])+      where pkgid = packageId pkg++  -- Additionally we have to add extra exclusions for any already-excluded+  -- packages that happen to be covered by the (inverse of the) constraint.+  oldExcluded = catMaybes (map exclude excludedChoices) where+    exclude (ExcludedPackage pkgid avail both)+      -- if it doesn't satisfy the version constraint then we exclude the+      -- package as a whole, the available or the installed instances or both.+      | not (satisfiesVersionConstraint pkgid)+      = Just (ExcludedPackage pkgid avail (reason:both))+      -- if on the other hand it does satisfy the constraint and we were also+      -- constraining to just the installed version then we exclude just the+      -- available instance.+      | installedConstraint == InstalledConstraint+      = Just (ExcludedPackage pkgid (reason:avail) both)+      | otherwise = Nothing++  -- util definitions+  availableChoices = PackageIndex.lookupPackageName available name+  excludedChoices  = PackageIndex.lookupPackageName excluded  name++  satisfiesConstraint pkg = satisfiesVersionConstraint pkg+                         && satisfiesInstallStateConstraint pkg++  satisfiesVersionConstraint :: Package pkg => pkg -> Bool+  satisfiesVersionConstraint = case Map.lookup name paired of+    Nothing       -> \pkg ->+      packageVersion pkg `withinRange` versionRange+    Just (v1, v2) -> \pkg -> case packageVersion pkg of+      v | v == v1+       || v == v2   -> v1 `withinRange` versionRange+                    || v2 `withinRange` versionRange+        | otherwise -> v `withinRange` versionRange++  satisfiesInstallStateConstraint = case installedConstraint of+    NoInstalledConstraint -> \_   -> True+    InstalledConstraint   -> \pkg -> case pkg of+      AvailableOnly _             -> False+      _                           -> True++conflicting :: (Package installed, Package available)+            => Constraints installed available reason+            -> Dependency+            -> [(PackageIdentifier, [reason])]+conflicting (Constraints _ _ excluded _) dep =+  [ (pkgid, reasonsAvail ++ reasonsAll) --TODO+  | ExcludedPackage pkgid reasonsAvail reasonsAll <-+      PackageIndex.lookupDependency excluded dep ]

@@ -0,0 +1,93 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.Dependency.TopDown.Types+-- Copyright   :  (c) Duncan Coutts 2008+-- License     :  BSD-like+--+-- Maintainer  :  cabal-devel@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- Types for the top-down dependency resolver.+-----------------------------------------------------------------------------+module Distribution.Client.Dependency.TopDown.Types where++import Distribution.Client.Types+         ( AvailablePackage(..), InstalledPackage )++import Distribution.Package+         ( PackageIdentifier, Dependency+         , Package(packageId), PackageFixedDeps(depends) )+import Distribution.PackageDescription+         ( FlagAssignment )++-- ------------------------------------------------------------+-- * The various kinds of packages+-- ------------------------------------------------------------++type SelectablePackage+   = InstalledOrAvailable InstalledPackageEx UnconfiguredPackage++type SelectedPackage+   = InstalledOrAvailable InstalledPackageEx SemiConfiguredPackage++data InstalledOrAvailable installed available+   = InstalledOnly         installed+   | AvailableOnly                   available+   | InstalledAndAvailable installed available++type TopologicalSortNumber = Int++data InstalledPackageEx+   = InstalledPackageEx+       InstalledPackage+       !TopologicalSortNumber+       [PackageIdentifier]    -- transative closure of installed deps++data UnconfiguredPackage+   = UnconfiguredPackage+       AvailablePackage+       !TopologicalSortNumber+       FlagAssignment++data SemiConfiguredPackage+   = SemiConfiguredPackage+       AvailablePackage  -- package info+       FlagAssignment    -- total flag assignment for the package+       [Dependency]      -- dependencies we end up with when we apply+                         -- the flag assignment++instance Package InstalledPackageEx where+  packageId (InstalledPackageEx p _ _) = packageId p++instance PackageFixedDeps InstalledPackageEx where+  depends (InstalledPackageEx _ _ deps) = deps++instance Package UnconfiguredPackage where+  packageId (UnconfiguredPackage p _ _) = packageId p++instance Package SemiConfiguredPackage where+  packageId (SemiConfiguredPackage p _ _) = packageId p++instance (Package installed, Package available)+      => Package (InstalledOrAvailable installed available) where+  packageId (InstalledOnly         p  ) = packageId p+  packageId (AvailableOnly         p  ) = packageId p+  packageId (InstalledAndAvailable p _) = packageId p++-- ------------------------------------------------------------+-- * Tagged Dependency type+-- ------------------------------------------------------------++-- | Installed packages can only depend on other installed packages while+-- packages that are not yet installed but which we plan to install can depend+-- on installed or other not-yet-installed packages.+--+-- This makes life more complex as we have to remember these constraints.+--+data TaggedDependency = TaggedDependency InstalledConstraint Dependency+data InstalledConstraint = InstalledConstraint | NoInstalledConstraint+  deriving Eq++untagDependency :: TaggedDependency -> Dependency+untagDependency (TaggedDependency _ dep) = dep

@@ -0,0 +1,115 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.Dependency.Types+-- Copyright   :  (c) Duncan Coutts 2008+-- License     :  BSD-like+--+-- Maintainer  :  cabal-devel@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- Common types for dependency resolution.+-----------------------------------------------------------------------------+module Distribution.Client.Dependency.Types (+    DependencyResolver,++    PackageConstraint(..),+    PackagePreferences(..),+    InstalledPreference(..),++    Progress(..),+    foldProgress,+  ) where++import Distribution.Client.Types+         ( AvailablePackage(..), InstalledPackage )+import qualified Distribution.Client.InstallPlan as InstallPlan++import Distribution.PackageDescription+         ( FlagAssignment )+import Distribution.Client.PackageIndex+         ( PackageIndex )+import Distribution.Package+         ( PackageName )+import Distribution.Version+         ( VersionRange )+import Distribution.Compiler+         ( CompilerId )+import Distribution.System+         ( Platform )++import Prelude hiding (fail)++-- | A dependency resolver is a function that works out an installation plan+-- given the set of installed and available packages and a set of deps to+-- solve for.+--+-- The reason for this interface is because there are dozens of approaches to+-- solving the package dependency problem and we want to make it easy to swap+-- in alternatives.+--+type DependencyResolver = Platform+                       -> CompilerId+                       -> PackageIndex InstalledPackage+                       -> PackageIndex AvailablePackage+                       -> (PackageName -> PackagePreferences)+                       -> [PackageConstraint]+                       -> [PackageName]+                       -> Progress String String [InstallPlan.PlanPackage]++-- | Per-package constraints. Package constraints must be respected by the+-- solver. Multiple constraints for each package can be given, though obviously+-- it is possible to construct conflicting constraints (eg impossible version+-- range or inconsistent flag assignment).+--+data PackageConstraint+   = PackageVersionConstraint   PackageName VersionRange+   | PackageInstalledConstraint PackageName+   | PackageFlagsConstraint     PackageName FlagAssignment+  deriving (Show,Eq)++-- | A per-package preference on the version. It is a soft constraint that the+-- 'DependencyResolver' should try to respect where possible. It consists of+-- a 'InstalledPreference' which says if we prefer versions of packages+-- that are already installed. It also hase a 'PackageVersionPreference' which+-- is a suggested constraint on the version number. The resolver should try to+-- use package versions that satisfy the suggested version constraint.+--+-- It is not specified if preferences on some packages are more important than+-- others.+--+data PackagePreferences = PackagePreferences VersionRange InstalledPreference++-- | Wether we prefer an installed version of a package or simply the latest+-- version.+--+data InstalledPreference = PreferInstalled | PreferLatest++-- | A type to represent the unfolding of an expensive long running+-- calculation that may fail. We may get intermediate steps before the final+-- retult which may be used to indicate progress and\/or logging messages.+--+data Progress step fail done = Step step (Progress step fail done)+                             | Fail fail+                             | Done done++-- | Consume a 'Progres' calculation. Much like 'foldr' for lists but with+-- two base cases, one for a final result and one for failure.+--+-- Eg to convert into a simple 'Either' result use:+--+-- > foldProgress (flip const) Left Right+--+foldProgress :: (step -> a -> a) -> (fail -> a) -> (done -> a)+             -> Progress step fail done -> a+foldProgress step fail done = fold+  where fold (Step s p) = step s (fold p)+        fold (Fail f)   = fail f+        fold (Done r)   = done r++instance Functor (Progress step fail) where+  fmap f = foldProgress Step Fail (Done . f)++instance Monad (Progress step fail) where+  return a = Done a+  p >>= f  = foldProgress Step Fail f p

@@ -0,0 +1,171 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.Fetch+-- Copyright   :  (c) David Himmelstrup 2005+--                    Duncan Coutts 2011+-- License     :  BSD-like+--+-- Maintainer  :  cabal-devel@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- The cabal fetch command+-----------------------------------------------------------------------------+module Distribution.Client.Fetch (+    fetch,+  ) where++import Distribution.Client.Types+import Distribution.Client.Targets+import Distribution.Client.FetchUtils hiding (fetchPackage)+import Distribution.Client.Dependency+import Distribution.Client.PackageIndex (PackageIndex)+import Distribution.Client.IndexUtils as IndexUtils+         ( getAvailablePackages, getInstalledPackages )+import qualified Distribution.Client.InstallPlan as InstallPlan+import Distribution.Client.Setup+         ( GlobalFlags(..), FetchFlags(..) )++import Distribution.Package+         ( packageId )+import Distribution.Simple.Compiler+         ( Compiler(compilerId), PackageDBStack )+import Distribution.Simple.Program+         ( ProgramConfiguration )+import Distribution.Simple.Setup+         ( fromFlag )+import Distribution.Simple.Utils+         ( die, notice, debug )+import Distribution.System+         ( buildPlatform )+import Distribution.Text+         ( display )+import Distribution.Verbosity+         ( Verbosity )++import Control.Monad+         ( filterM )++-- ------------------------------------------------------------+-- * The fetch command+-- ------------------------------------------------------------++--TODO:+-- * add fetch -o support+-- * support tarball URLs via ad-hoc download cache (or in -o mode?)+-- * suggest using --no-deps, unpack or fetch -o if deps cannot be satisfied+-- * Port various flags from install:+--   * --updage-dependencies+--   * --constraint and --preference+--   * --only-dependencies, but note it conflicts with --no-deps+++-- | Fetch a list of packages and their dependencies.+--+fetch :: Verbosity+      -> PackageDBStack+      -> [Repo]+      -> Compiler+      -> ProgramConfiguration+      -> GlobalFlags+      -> FetchFlags+      -> [UserTarget]+      -> IO ()+fetch verbosity _ _ _ _ _ _ [] =+    notice verbosity "No packages requested. Nothing to do."++fetch verbosity packageDBs repos comp conf+      globalFlags fetchFlags userTargets = do++    mapM_ checkTarget userTargets++    installed     <- getInstalledPackages verbosity comp packageDBs conf+    availableDb   <- getAvailablePackages verbosity repos++    pkgSpecifiers <- resolveUserTargets verbosity+                       globalFlags (packageIndex availableDb) userTargets++    pkgs  <- planPackages+               verbosity comp fetchFlags+               installed availableDb pkgSpecifiers++    pkgs' <- filterM (fmap not . isFetched . packageSource) pkgs+    if null pkgs'+      --TODO: when we add support for remote tarballs then this message+      -- will need to be changed because for remote tarballs we fetch them+      -- at the earlier phase.+      then notice verbosity $ "No packages need to be fetched. "+                           ++ "All the requested packages are already local "+                           ++ "or cached locally."+      else if dryRun+             then notice verbosity $ unlines $+                     "The following packages would be fetched:"+                   : map (display . packageId) pkgs'++             else mapM_ (fetchPackage verbosity . packageSource) pkgs'++  where+    dryRun = fromFlag (fetchDryRun fetchFlags)++planPackages :: Verbosity+             -> Compiler+             -> FetchFlags+             -> PackageIndex InstalledPackage+             -> AvailablePackageDb+             -> [PackageSpecifier AvailablePackage]+             -> IO [AvailablePackage]+planPackages verbosity comp fetchFlags+             installed availableDb pkgSpecifiers++  | includeDependencies = do+      notice verbosity "Resolving dependencies..."+      installPlan <- foldProgress logMsg die return $+                       resolveDependencies+                         buildPlatform (compilerId comp)+                         resolverParams++      -- The packages we want to fetch are those packages the 'InstallPlan'+      -- that are in the 'InstallPlan.Configured' state.+      return+        [ pkg+        | (InstallPlan.Configured (InstallPlan.ConfiguredPackage pkg _ _))+            <- InstallPlan.toList installPlan ]++  | otherwise =+      either (die . unlines . map show) return $+        resolveWithoutDependencies resolverParams++  where+    resolverParams =++        -- Reinstall the targets given on the command line so that the dep+        -- resolver will decide that they need fetching, even if they're+        -- already installed. Sicne we want to get the source packages of+        -- things we might have installed (but not have the sources for).+        reinstallTargets++      $ standardInstallPolicy installed availableDb pkgSpecifiers++    includeDependencies = fromFlag (fetchDeps fetchFlags)+    logMsg message rest = debug verbosity message >> rest+++checkTarget :: UserTarget -> IO ()+checkTarget target = case target of+    UserTargetRemoteTarball _uri+      -> die $ "The 'fetch' command does not yet support remote tarballs. "+            ++ "In the meantime you can use the 'unpack' commands."+    _ -> return ()++fetchPackage :: Verbosity -> PackageLocation a -> IO ()+fetchPackage verbosity pkgsrc = case pkgsrc of+    LocalUnpackedPackage _dir  -> return ()+    LocalTarballPackage  _file -> return ()++    RemoteTarballPackage _uri _ ->+      die $ "The 'fetch' command does not yet support remote tarballs. "+         ++ "In the meantime you can use the 'unpack' commands."++    RepoTarballPackage repo pkgid _ -> do+      _ <- fetchRepoTarball verbosity repo pkgid+      return ()

@@ -0,0 +1,193 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.FetchUtils+-- Copyright   :  (c) David Himmelstrup 2005+--                    Duncan Coutts 2011+-- License     :  BSD-like+--+-- Maintainer  :  cabal-devel@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Functions for fetching packages+-----------------------------------------------------------------------------+module Distribution.Client.FetchUtils (++    -- * fetching packages+    fetchPackage,+    isFetched,+    checkFetched,++    -- ** specifically for repo packages+    fetchRepoTarball,++    -- * fetching other things+    downloadIndex,+  ) where++import Distribution.Client.Types+import Distribution.Client.HttpUtils+         ( downloadURI, isOldHackageURI )++import Distribution.Package+         ( PackageId, packageName, packageVersion )+import Distribution.Simple.Utils+         ( notice, info, setupMessage )+import Distribution.Text+         ( display )+import Distribution.Verbosity+         ( Verbosity )++import Data.Maybe+import System.Directory+         ( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )+import System.IO+         ( openTempFile, hClose )+import System.FilePath+         ( (</>), (<.>) )+import qualified System.FilePath.Posix as FilePath.Posix+         ( combine, joinPath )+import Network.URI+         ( URI(uriPath) )++-- ------------------------------------------------------------+-- * Actually fetch things+-- ------------------------------------------------------------++-- | Returns @True@ if the package has already been fetched+-- or does not need fetching.+--+isFetched :: PackageLocation (Maybe FilePath) -> IO Bool+isFetched loc = case loc of+    LocalUnpackedPackage _dir       -> return True+    LocalTarballPackage  _file      -> return True+    RemoteTarballPackage _uri local -> return (isJust local)+    RepoTarballPackage repo pkgid _ -> doesFileExist (packageFile repo pkgid)+++checkFetched :: PackageLocation (Maybe FilePath)+             -> IO (Maybe (PackageLocation FilePath))+checkFetched loc = case loc of+    LocalUnpackedPackage dir  ->+      return (Just $ LocalUnpackedPackage dir)+    LocalTarballPackage  file ->+      return (Just $ LocalTarballPackage  file)+    RemoteTarballPackage uri (Just file) ->+      return (Just $ RemoteTarballPackage uri file)+    RepoTarballPackage repo pkgid (Just file) ->+      return (Just $ RepoTarballPackage repo pkgid file)++    RemoteTarballPackage _uri Nothing -> return Nothing+    RepoTarballPackage repo pkgid Nothing -> do+      let file = packageFile repo pkgid+      exists <- doesFileExist file+      if exists+        then return (Just $ RepoTarballPackage repo pkgid file)+        else return Nothing+++-- | Fetch a package if we don't have it already.+--+fetchPackage :: Verbosity+             -> PackageLocation (Maybe FilePath)+             -> IO (PackageLocation FilePath)+fetchPackage verbosity loc = case loc of+    LocalUnpackedPackage dir  ->+      return (LocalUnpackedPackage dir)+    LocalTarballPackage  file ->+      return (LocalTarballPackage  file)+    RemoteTarballPackage uri (Just file) ->+      return (RemoteTarballPackage uri file)+    RepoTarballPackage repo pkgid (Just file) ->+      return (RepoTarballPackage repo pkgid file)++    RemoteTarballPackage uri Nothing -> do+      path <- downloadTarballPackage uri+      return (RemoteTarballPackage uri path)+    RepoTarballPackage repo pkgid Nothing -> do+      local <- fetchRepoTarball verbosity repo pkgid+      return (RepoTarballPackage repo pkgid local)+  where+    downloadTarballPackage uri = do+      notice verbosity ("Downloading " ++ show uri)+      tmpdir <- getTemporaryDirectory+      (path, hnd) <- openTempFile tmpdir "cabal-.tar.gz"+      hClose hnd+      downloadURI verbosity uri path+      return path+++-- | Fetch a repo package if we don't have it already.+--+fetchRepoTarball :: Verbosity -> Repo -> PackageId -> IO FilePath+fetchRepoTarball verbosity repo pkgid = do+  fetched <- doesFileExist (packageFile repo pkgid)+  if fetched+    then do info verbosity $ display pkgid ++ " has already been downloaded."+            return (packageFile repo pkgid)+    else do setupMessage verbosity "Downloading" pkgid+            downloadRepoPackage+  where+    downloadRepoPackage = case repoKind repo of+      Right LocalRepo -> return (packageFile repo pkgid)++      Left remoteRepo -> do+        let uri  = packageURI remoteRepo pkgid+            dir  = packageDir       repo pkgid+            path = packageFile      repo pkgid+        createDirectoryIfMissing True dir+        downloadURI verbosity uri path+        return path++-- | Downloads an index file to [config-dir/packages/serv-id].+--+downloadIndex :: Verbosity -> RemoteRepo -> FilePath -> IO FilePath+downloadIndex verbosity repo cacheDir = do+  let uri = (remoteRepoURI repo) {+              uriPath = uriPath (remoteRepoURI repo)+                          `FilePath.Posix.combine` "00-index.tar.gz"+            }+      path = cacheDir </> "00-index" <.> "tar.gz"+  createDirectoryIfMissing True cacheDir+  downloadURI verbosity uri path+  return path+++-- ------------------------------------------------------------+-- * Path utilities+-- ------------------------------------------------------------++-- | Generate the full path to the locally cached copy of+-- the tarball for a given @PackageIdentifer@.+--+packageFile :: Repo -> PackageId -> FilePath+packageFile repo pkgid = packageDir repo pkgid+                     </> display pkgid+                     <.> "tar.gz"++-- | Generate the full path to the directory where the local cached copy of+-- the tarball for a given @PackageIdentifer@ is stored.+--+packageDir :: Repo -> PackageId -> FilePath+packageDir repo pkgid = repoLocalDir repo+                    </> display (packageName    pkgid)+                    </> display (packageVersion pkgid)++-- | Generate the URI of the tarball for a given package.+--+packageURI :: RemoteRepo -> PackageId -> URI+packageURI repo pkgid | isOldHackageURI (remoteRepoURI repo) =+  (remoteRepoURI repo) {+    uriPath = FilePath.Posix.joinPath+      [uriPath (remoteRepoURI repo)+      ,display (packageName    pkgid)+      ,display (packageVersion pkgid)+      ,display pkgid <.> "tar.gz"]+  }+packageURI repo pkgid =+  (remoteRepoURI repo) {+    uriPath = FilePath.Posix.joinPath+      [uriPath (remoteRepoURI repo)+      ,"package"+      ,display pkgid <.> "tar.gz"]+  }

@@ -0,0 +1,44 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.GZipUtils+-- Copyright   :  (c) Dmitry Astapov 2010+-- License     :  BSD-like+--+-- Maintainer  :  cabal-devel@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Provides a convenience functions for working with files that may or may not+-- be zipped.+-----------------------------------------------------------------------------+module Distribution.Client.GZipUtils (+    maybeDecompress,+  ) where++import qualified Data.ByteString.Lazy.Internal as BS (ByteString(..))+import Data.ByteString.Lazy (ByteString)+import Codec.Compression.GZip+import Codec.Compression.Zlib.Internal++-- | Attempts to decompress the `bytes' under the assumption that+-- "data format" error at the very beginning of the stream means+-- that it is already decompressed. Caller should make sanity checks+-- to verify that it is not, in fact, garbage.+--+-- This is to deal with http proxies that lie to us and transparently+-- decompress without removing the content-encoding header. See:+-- <http://hackage.haskell.org/trac/hackage/ticket/686>+--+maybeDecompress :: ByteString -> ByteString+maybeDecompress bytes = foldStream $ decompressWithErrors gzipOrZlibFormat defaultDecompressParams bytes+  where+    -- DataError at the beginning of the stream probably means that stream is not compressed.+    -- Returning it as-is.+    -- TODO: alternatively, we might consider looking for the two magic bytes+    -- at the beginning of the gzip header.+    foldStream (StreamError DataError _) = bytes+    foldStream somethingElse = doFold somethingElse++    doFold StreamEnd               = BS.Empty+    doFold (StreamChunk bs stream) = BS.Chunk bs (doFold stream)+    doFold (StreamError _ msg)  = error $ "Codec.Compression.Zlib: " ++ msg

@@ -0,0 +1,105 @@+-----------------------------------------------------------------------------+-- |+-- 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 (listToMaybe)+import Data.List (maximumBy)+import Control.Monad (guard)+import System.Directory (createDirectoryIfMissing, doesFileExist,+                         renameFile)+import System.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 "tmphaddock" $ \tempDir -> do++        let flags = [ "--gen-contents"+                    , "--gen-index"+                    , "--odir=" ++ tempDir+                    , "--title=Haskell modules on this system" ]+                 ++ [ "--read-interface=" ++ html ++ "," ++ interface+                    | (interface, html) <- paths ]+        rawSystemProgram verbosity confHaddock flags+        renameFile (tempDir </> "index.html") (tempDir </> destFile)+        installDirectoryContents verbosity tempDir destDir+      +  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 String)+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)

@@ -0,0 +1,197 @@+{-# OPTIONS -cpp #-}+-----------------------------------------------------------------------------+-- | Separate module for HTTP actions, using a proxy server if one exists +-----------------------------------------------------------------------------+module Distribution.Client.HttpUtils (+    downloadURI,+    getHTTP,+    proxy,+    isOldHackageURI+  ) where++import Network.HTTP+         ( Request (..), Response (..), RequestMethod (..)+         , Header(..), HeaderName(..) )+import Network.URI+         ( URI (..), URIAuth (..), parseAbsoluteURI )+import Network.Stream+         ( Result, ConnError(..) )+import Network.Browser+         ( Proxy (..), Authority (..), browse+         , setOutHandler, setErrHandler, setProxy, request)+import Control.Monad+         ( mplus, join, liftM2 )+import qualified Data.ByteString.Lazy.Char8 as ByteString+import Data.ByteString.Lazy (ByteString)+#ifdef WIN32+import System.Win32.Types+         ( DWORD, HKEY )+import System.Win32.Registry+         ( hKEY_CURRENT_USER, regOpenKey, regCloseKey+         , regQueryValue, regQueryValueEx )+import Control.Exception+         ( bracket )+import Distribution.Compat.Exception+         ( handleIO )+import Foreign+         ( toBool, Storable(peek, sizeOf), castPtr, alloca )+#endif+import System.Environment (getEnvironment)++import qualified Paths_cabal_install_ghc72 (version)+import Distribution.Verbosity (Verbosity)+import Distribution.Simple.Utils+         ( die, info, warn, debug+         , copyFileVerbose, writeFileAtomic )+import Distribution.Text+         ( display )+import qualified System.FilePath.Posix as FilePath.Posix+         ( splitDirectories )++-- FIXME: all this proxy stuff is far too complicated, especially parsing+-- the proxy strings. Network.Browser should have a way to pick up the+-- proxy settings hiding all this system-dependent stuff below.++-- try to read the system proxy settings on windows or unix+proxyString, envProxyString, registryProxyString :: IO (Maybe String)+#ifdef WIN32+-- read proxy settings from the windows registry+registryProxyString = handleIO (\_ -> return Nothing) $+  bracket (regOpenKey hive path) regCloseKey $ \hkey -> do+    enable <- fmap toBool $ regQueryValueDWORD hkey "ProxyEnable"+    if enable+        then fmap Just $ regQueryValue hkey (Just "ProxyServer")+        else return Nothing+  where+    -- some sources say proxy settings should be at +    -- HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows+    --                   \CurrentVersion\Internet Settings\ProxyServer+    -- but if the user sets them with IE connection panel they seem to+    -- end up in the following place:+    hive  = hKEY_CURRENT_USER+    path = "Software\\Microsoft\\Windows\\CurrentVersion\\Internet Settings"++    regQueryValueDWORD :: HKEY -> String -> IO DWORD+    regQueryValueDWORD hkey name = alloca $ \ptr -> do+      regQueryValueEx hkey name (castPtr ptr) (sizeOf (undefined :: DWORD))+      peek ptr+#else+registryProxyString = return Nothing+#endif++-- read proxy settings by looking for an env var+envProxyString = do+  env <- getEnvironment+  return (lookup "http_proxy" env `mplus` lookup "HTTP_PROXY" env)++proxyString = liftM2 mplus envProxyString registryProxyString+++-- |Get the local proxy settings  +proxy :: Verbosity -> IO Proxy+proxy verbosity = do+  mstr <- proxyString+  case mstr of+    Nothing   -> return NoProxy+    Just str  -> case parseHttpProxy str of+      Nothing -> do+        warn verbosity $ "invalid http proxy uri: " ++ show str+        warn verbosity $ "proxy uri must be http with a hostname"+        warn verbosity $ "ignoring http proxy, trying a direct connection"+        return NoProxy+      Just p  -> return p+--TODO: print info message when we're using a proxy++-- | We need to be able to parse non-URIs like @\"wwwcache.example.com:80\"@+-- which lack the @\"http://\"@ URI scheme. The problem is that+-- @\"wwwcache.example.com:80\"@ is in fact a valid URI but with scheme+-- @\"wwwcache.example.com:\"@, no authority part and a path of @\"80\"@.+--+-- So our strategy is to try parsing as normal uri first and if it lacks the+-- 'uriAuthority' then we try parsing again with a @\"http://\"@ prefix.+--+parseHttpProxy :: String -> Maybe Proxy+parseHttpProxy str = join+                   . fmap uri2proxy+                   $ parseHttpURI str+             `mplus` parseHttpURI ("http://" ++ str)+  where+    parseHttpURI str' = case parseAbsoluteURI str' of+      Just uri@URI { uriAuthority = Just _ }+         -> Just (fixUserInfo uri)+      _  -> Nothing++fixUserInfo :: URI -> URI+fixUserInfo uri = uri{ uriAuthority = f `fmap` uriAuthority uri }+    where+      f a@URIAuth{ uriUserInfo = s } =+          a{ uriUserInfo = case reverse s of+                             '@':s' -> reverse s'+                             _      -> s+           }+uri2proxy :: URI -> Maybe Proxy+uri2proxy uri@URI{ uriScheme = "http:"+                 , uriAuthority = Just (URIAuth auth' host port)+                 } = Just (Proxy (host ++ port) auth)+  where auth = if null auth'+                 then Nothing+                 else Just (AuthBasic "" usr pwd uri)+        (usr,pwd') = break (==':') auth'+        pwd        = case pwd' of+                       ':':cs -> cs+                       _      -> pwd'+uri2proxy _ = Nothing++mkRequest :: URI -> Request ByteString+mkRequest uri = Request{ rqURI     = uri+                       , rqMethod  = GET+                       , rqHeaders = [Header HdrUserAgent userAgent]+                       , rqBody    = ByteString.empty }+  where userAgent = "cabal-install/" ++ display Paths_cabal_install_ghc72.version++-- |Carry out a GET request, using the local proxy settings+getHTTP :: Verbosity -> URI -> IO (Result (Response ByteString))+getHTTP verbosity uri = do+                 p   <- proxy verbosity+                 let req = mkRequest uri+                 (_, resp) <- browse $ do+                                setErrHandler (warn verbosity . ("http error: "++))+                                setOutHandler (debug verbosity)+                                setProxy p+                                request req+                 return (Right resp)++downloadURI :: Verbosity+            -> URI      -- ^ What to download+            -> FilePath -- ^ Where to put it+            -> IO ()+downloadURI verbosity uri path | uriScheme uri == "file:" =+  copyFileVerbose verbosity (uriPath uri) path+downloadURI verbosity uri path = do+  result <- getHTTP verbosity uri+  let result' = case result of+        Left  err -> Left err+        Right rsp -> case rspCode rsp of+          (2,0,0) -> Right (rspBody rsp)+          (a,b,c) -> Left err+            where+              err = ErrorMisc $ "Unsucessful HTTP code: "+                             ++ concatMap show [a,b,c]++  case result' of+    Left err   -> die $ "Failed to download " ++ show uri ++ " : " ++ show err+    Right body -> do+      info verbosity ("Downloaded to " ++ path)+      writeFileAtomic path (ByteString.unpack body)+      --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.+      --      remember the ETag so we can not re-download if nothing changed.++-- Utility function for legacy support.+isOldHackageURI :: URI -> Bool+isOldHackageURI uri+    = case uriAuthority uri of+        Just (URIAuth {uriRegName = "hackage.haskell.org"}) ->+            FilePath.Posix.splitDirectories (uriPath uri) == ["/","packages","archive"]+        _ -> False

@@ -0,0 +1,265 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.IndexUtils+-- Copyright   :  (c) Duncan Coutts 2008+-- License     :  BSD-like+--+-- Maintainer  :  duncan@community.haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- Extra utils related to the package indexes.+-----------------------------------------------------------------------------+module Distribution.Client.IndexUtils (+  getInstalledPackages,+  getAvailablePackages,++  readPackageIndexFile,+  parseRepoIndex,+  ) where++import qualified Distribution.Client.Tar as Tar+import Distribution.Client.Types++import Distribution.Package+         ( PackageId, PackageIdentifier(..), PackageName(..)+         , Package(..), packageVersion+         , 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+         ( Version(Version), intersectVersionRanges )+import Distribution.Text+         ( simpleParse )+import Distribution.Verbosity+         ( Verbosity, lessVerbose )+import Distribution.Simple.Utils+         ( warn, info, fromUTF8, equating )++import Data.Maybe  (catMaybes, fromMaybe)+import Data.List   (isPrefixOf, groupBy)+import Data.Monoid (Monoid(..))+import qualified Data.Map as Map+import Control.Monad (MonadPlus(mplus), when)+import Control.Exception (evaluate)+import qualified Data.ByteString.Lazy as BS+import qualified Data.ByteString.Lazy.Char8 as BS.Char8+import Data.ByteString.Lazy (ByteString)+import Distribution.Client.GZipUtils (maybeDecompress)+import System.FilePath ((</>), takeExtension, splitDirectories, normalise)+import System.FilePath.Posix as FilePath.Posix+         ( takeFileName )+import System.IO.Error (isDoesNotExistError)+import System.Directory+         ( getModificationTime )+import System.Time+         ( getClockTime, diffClockTimes, normalizeTimeDiff, TimeDiff(tdDay) )++getInstalledPackages :: Verbosity -> Compiler+                     -> PackageDBStack -> ProgramConfiguration+                     -> IO (PackageIndex InstalledPackage)+getInstalledPackages verbosity comp packageDbs conf =+    fmap convert (Configure.getInstalledPackages verbosity'+                                                 comp packageDbs conf)+  where+    --FIXME: make getInstalledPackages use sensible verbosity in the first place+    verbosity'  = lessVerbose verbosity++    convert :: InstalledPackageIndex.PackageIndex -> PackageIndex InstalledPackage+    convert index = PackageIndex.fromList+      -- There can be multiple installed instances of each package version,+      -- like when the same package is installed in the global & user dbs.+      -- InstalledPackageIndex.allPackagesByName gives us the installed+      -- packages with the most preferred instances first, so by picking the+      -- first we should get the user one. This is almost but not quite the+      -- same as what ghc does.+      [ InstalledPackage ipkg (sourceDeps index ipkg)+      | ipkgs <- InstalledPackageIndex.allPackagesByName index+      , (ipkg:_) <- groupBy (equating packageVersion) ipkgs ]++    -- 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.+--+-- All the 'AvailablePackage's are marked as having come from the appropriate+-- 'Repo'.+--+-- This is a higher level wrapper used internally in cabal-install.+--+getAvailablePackages :: Verbosity -> [Repo] -> IO AvailablePackageDb+getAvailablePackages verbosity [] = do+  warn verbosity $ "No remote package servers have been specified. Usually "+                ++ "you would have one specified in the config file."+  return AvailablePackageDb {+    packageIndex       = mempty,+    packagePreferences = mempty+  }+getAvailablePackages verbosity repos = do+  info verbosity "Reading available packages..."+  pkgss <- mapM (readRepoIndex verbosity) repos+  let (pkgs, prefs) = mconcat pkgss+      prefs' = Map.fromListWith intersectVersionRanges+                 [ (name, range) | Dependency name range <- prefs ]+  _ <- evaluate pkgs+  _ <- evaluate prefs'+  return AvailablePackageDb {+    packageIndex       = pkgs,+    packagePreferences = prefs'+  }++-- | Read a repository index from disk, from the local file specified by+-- the 'Repo'.+--+-- All the 'AvailablePackage's are marked as having come from the given 'Repo'.+--+-- This is a higher level wrapper used internally in cabal-install.+--+readRepoIndex :: Verbosity -> Repo+              -> IO (PackageIndex AvailablePackage, [Dependency])+readRepoIndex verbosity repo = handleNotFound $ do+  let indexFile = repoLocalDir repo </> "00-index.tar"+  (pkgs, prefs) <- either fail return+                 . foldlTarball extract ([], [])+               =<< BS.readFile indexFile++  pkgIndex <- evaluate $ PackageIndex.fromList+    [ AvailablePackage {+        packageInfoId      = pkgid,+        packageDescription = pkg,+        packageSource      = RepoTarballPackage repo pkgid Nothing+      }+    | (pkgid, pkg) <- pkgs]++  warnIfIndexIsOld indexFile+  return (pkgIndex, prefs)++  where+    extract (pkgs, prefs) entry = fromMaybe (pkgs, prefs) $+              (do pkg <- extractPkg entry; return (pkg:pkgs, prefs))+      `mplus` (do prefs' <- extractPrefs entry; return (pkgs, prefs'++prefs))++    extractPrefs :: Tar.Entry -> Maybe [Dependency]+    extractPrefs entry = case Tar.entryContent entry of+      Tar.NormalFile content _+         | takeFileName (Tar.entryPath entry) == "preferred-versions"+        -> Just . parsePreferredVersions+         . BS.Char8.unpack $ content+      _ -> Nothing++    handleNotFound action = catch action $ \e -> if isDoesNotExistError e+      then do+        case repoKind repo of+          Left  remoteRepo -> warn verbosity $+               "The package list for '" ++ remoteRepoName remoteRepo+            ++ "' does not exist. Run 'cabal update' to download it."+          Right _localRepo -> warn verbosity $+               "The package list for the local repo '" ++ repoLocalDir repo+            ++ "' is missing. The repo is invalid."+        return mempty+      else ioError e++    isOldThreshold = 15 --days+    warnIfIndexIsOld indexFile = do+      indexTime   <- getModificationTime indexFile+      currentTime <- getClockTime+      let diff = normalizeTimeDiff (diffClockTimes currentTime indexTime)+      when (tdDay diff >= isOldThreshold) $ case repoKind repo of+        Left  remoteRepo -> warn verbosity $+             "The package list for '" ++ remoteRepoName remoteRepo+          ++ "' is " ++ show (tdDay diff)  ++ " days old.\nRun "+          ++ "'cabal update' to get the latest list of available packages."+        Right _localRepo -> return ()++parsePreferredVersions :: String -> [Dependency]+parsePreferredVersions = catMaybes+                       . map simpleParse+                       . filter (not . isPrefixOf "--")+                       . lines++-- | Read a compressed \"00-index.tar.gz\" file into a 'PackageIndex'.+--+-- This is supposed to be an \"all in one\" way to easily get at the info in+-- the hackage package index.+--+-- It takes a function to map a 'GenericPackageDescription' into any more+-- specific instance of 'Package' that you might want to use. In the simple+-- case you can just use @\_ p -> p@ here.+--+readPackageIndexFile :: Package pkg+                     => (PackageId -> GenericPackageDescription -> pkg)+                     -> FilePath -> IO (PackageIndex pkg)+readPackageIndexFile mkPkg indexFile = do+  pkgs <- either fail return+        . parseRepoIndex+        . maybeDecompress+      =<< BS.readFile indexFile+  +  evaluate $ PackageIndex.fromList+   [ mkPkg pkgid pkg | (pkgid, pkg) <- pkgs]++-- | Parse an uncompressed \"00-index.tar\" repository index file represented+-- as a 'ByteString'.+--+parseRepoIndex :: ByteString+               -> Either String [(PackageId, GenericPackageDescription)]+parseRepoIndex = foldlTarball (\pkgs -> maybe pkgs (:pkgs) . extractPkg) []++extractPkg :: Tar.Entry -> Maybe (PackageId, GenericPackageDescription)+extractPkg entry = case Tar.entryContent entry of+  Tar.NormalFile content _+     | takeExtension fileName == ".cabal"+    -> case splitDirectories (normalise fileName) of+        [pkgname,vers,_] -> case simpleParse vers of+          Just ver -> Just (pkgid, descr)+            where+              pkgid  = PackageIdentifier (PackageName pkgname) ver+              parsed = parsePackageDescription . fromUTF8 . BS.Char8.unpack+                                               $ content+              descr  = case parsed of+                ParseOk _ d -> d+                _           -> error $ "Couldn't read cabal file "+                                    ++ show fileName+          _ -> Nothing+        _ -> Nothing+  _ -> Nothing+  where+    fileName = Tar.entryPath entry++foldlTarball :: (a -> Tar.Entry -> a) -> a+             -> ByteString -> Either String a+foldlTarball f z = either Left (Right . foldl f z) . check [] . Tar.read+  where+    check _  (Tar.Fail err)  = Left  err+    check ok Tar.Done        = Right ok+    check ok (Tar.Next e es) = check (e:ok) es

@@ -0,0 +1,556 @@+{-# 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(..) )+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+           >=> 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 }++-- | 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+    [ "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 "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

@@ -0,0 +1,191 @@+{-# 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+                                , isUpper (head file) ]+        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) && not (ignoreDir entry) =+          scanForModulesIn projectRoot $ foldl (</>) srcRoot (entry : hierarchy)+      | otherwise = return []+    ignoreDir ('.':_)  = True+    ignoreDir dir      = dir `elem` ["dist", "_darcs"]++-- Unfortunately we cannot use the version exported by Distribution.Simple.Program+knownSuffixHandlers :: [(String,String)]+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

@@ -0,0 +1,1722 @@+module Distribution.Client.Init.Licenses+  ( License+  , bsd3+  , gplv2+  , gplv3+  , lgpl2+  , lgpl3++  ) where++type License = String++bsd3 :: String -> String -> License+bsd3 authors year = unlines+    [ "Copyright (c)" ++ year ++ ", " ++ authors+    , ""+    , "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 " ++ authors ++ " 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."+    ]+

@@ -0,0 +1,152 @@+{-# 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+              , 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+    , 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+    , 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 .. ]++#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

@@ -0,0 +1,875 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.Install+-- Copyright   :  (c) 2005 David Himmelstrup+--                    2007 Bjorn Bringert+--                    2007-2010 Duncan Coutts+-- License     :  BSD-like+--+-- Maintainer  :  cabal-devel@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- High level interface to package installation.+-----------------------------------------------------------------------------+module Distribution.Client.Install (+    install,+    upgrade,+  ) where++import Data.List+         ( unfoldr, find, nub, sort )+import Data.Maybe+         ( isJust, fromMaybe )+import Control.Exception as Exception+         ( 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+         ( getTemporaryDirectory, doesFileExist, createDirectoryIfMissing )+import System.FilePath+         ( (</>), (<.>), takeDirectory )+import System.IO+         ( openFile, IOMode(AppendMode) )+import System.IO.Error+         ( isDoesNotExistError, ioeGetFileName )++import Distribution.Client.Targets+import Distribution.Client.Dependency+import Distribution.Client.FetchUtils+import qualified Distribution.Client.Haddock as Haddock (regenerateHaddockIndex)+-- import qualified Distribution.Client.Info as Info+import Distribution.Client.IndexUtils as IndexUtils+         ( getAvailablePackages, getInstalledPackages )+import qualified Distribution.Client.InstallPlan as InstallPlan+import Distribution.Client.InstallPlan (InstallPlan)+import Distribution.Client.Setup+         ( GlobalFlags(..)+         , ConfigFlags(..), configureCommand, filterConfigureFlags+         , ConfigExFlags(..), InstallFlags(..) )+import Distribution.Client.Config+         ( defaultCabalDir )+import Distribution.Client.Tar (extractTarGzFile)+import Distribution.Client.Types as Available+import Distribution.Client.BuildReports.Types+         ( ReportLevel(..) )+import Distribution.Client.SetupWrapper+         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )+import qualified Distribution.Client.BuildReports.Anonymous as BuildReports+import qualified Distribution.Client.BuildReports.Storage as BuildReports+         ( storeAnonymous, storeLocal, fromInstallPlan )+import qualified Distribution.Client.InstallSymlink as InstallSymlink+         ( symlinkBinaries )+import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade+import qualified Distribution.Client.World as World+import Paths_cabal_install_ghc72 (getBinDir)++import Distribution.Simple.Compiler+         ( CompilerId(..), Compiler(compilerId), compilerFlavor+         , PackageDB(..), PackageDBStack )+import Distribution.Simple.Program (ProgramConfiguration, defaultProgramConfiguration)+import qualified Distribution.Simple.InstallDirs as InstallDirs+import qualified Distribution.Client.PackageIndex as PackageIndex+import Distribution.Client.PackageIndex (PackageIndex)+import Distribution.Simple.Setup+         ( haddockCommand, HaddockFlags(..), emptyHaddockFlags+         , buildCommand, BuildFlags(..), emptyBuildFlags+         , toFlag, fromFlag, fromFlagOrDefault, flagToMaybe )+import qualified Distribution.Simple.Setup as Cabal+         ( installCommand, InstallFlags(..), emptyInstallFlags )+import Distribution.Simple.Utils+         ( rawSystemExit, comparing )+import Distribution.Simple.InstallDirs as InstallDirs+         ( PathTemplate, fromPathTemplate, toPathTemplate, substPathTemplate+         , initialPathTemplateEnv, installDirsTemplateEnv )+import Distribution.Package+         ( PackageIdentifier, packageName, packageVersion+         , Package(..), PackageFixedDeps(..)+         , Dependency(..), thisPackageVersion )+import qualified Distribution.PackageDescription as PackageDescription+import Distribution.PackageDescription+         ( PackageDescription )+import Distribution.PackageDescription.Configuration+         ( finalizePackageDescription )+import Distribution.Version+         ( Version, anyVersion, thisVersion )+import Distribution.Simple.Utils as Utils+         ( notice, info, debug, warn, die, intercalate, withTempDirectory )+import Distribution.Client.Utils+         ( inDir, mergeBy, MergeResult(..) )+import Distribution.System+         ( Platform, buildPlatform, OS(Windows), buildOS )+import Distribution.Text+         ( display )+import Distribution.Verbosity as Verbosity+         ( Verbosity, showForCabal, verbose )+import Distribution.Simple.BuildPaths ( exeExtension )++--TODO:+-- * assign flags to packages individually+--   * complain about flags that do not apply to any package given as target+--     so flags do not apply to dependencies, only listed, can use flag+--     constraints for dependencies+--   * only record applicable flags in world file+-- * allow flag constraints+-- * allow installed constraints+-- * allow flag and installed preferences+-- * change world file to use cabal section syntax+--   * allow persistent configure flags for each package individually++-- ------------------------------------------------------------+-- * Top level user actions+-- ------------------------------------------------------------++-- | Installs the packages needed to satisfy a list of dependencies.+--+install, upgrade+  :: Verbosity+  -> PackageDBStack+  -> [Repo]+  -> Compiler+  -> ProgramConfiguration+  -> GlobalFlags+  -> ConfigFlags+  -> ConfigExFlags+  -> InstallFlags+  -> [UserTarget]+  -> IO ()+install verbosity packageDBs repos comp conf+  globalFlags configFlags configExFlags installFlags userTargets0 = do++    installed     <- getInstalledPackages verbosity comp packageDBs conf+    availableDb   <- getAvailablePackages verbosity repos++    let -- For install, if no target is given it means we use the+        -- current directory as the single target+        userTargets | null userTargets0 = [UserTargetLocalDir "."]+                    | otherwise         = userTargets0++    pkgSpecifiers <- resolveUserTargets verbosity+                       globalFlags (packageIndex availableDb) userTargets++    notice verbosity "Resolving dependencies..."+    installPlan   <- foldProgress logMsg die return $+                       planPackages+                         comp configFlags configExFlags installFlags+                         installed availableDb pkgSpecifiers++    printPlanMessages verbosity installed installPlan dryRun++    unless dryRun $ do+      installPlan' <- performInstallations verbosity+                        context installed installPlan+      postInstallActions verbosity context userTargets installPlan'++  where+    context :: InstallContext+    context = (packageDBs, repos, comp, conf,+               globalFlags, configFlags, configExFlags, installFlags)++    dryRun      = fromFlag (installDryRun installFlags)+    logMsg message rest = debug verbosity message >> rest+++upgrade _ _ _ _ _ _ _ _ _ _ = die $+    "Use the 'cabal install' command instead of 'cabal upgrade'.\n"+ ++ "You can install the latest version of a package using 'cabal install'. "+ ++ "The 'cabal upgrade' command has been removed because people found it "+ ++ "confusing and it often led to broken packages.\n"+ ++ "If you want the old upgrade behaviour then use the install command "+ ++ "with the --upgrade-dependencies flag (but check first with --dry-run "+ ++ "to see what would happen). This will try to pick the latest versions "+ ++ "of all dependencies, rather than the usual behaviour of trying to pick "+ ++ "installed versions of all dependencies. If you do use "+ ++ "--upgrade-dependencies, it is recommended that you do not upgrade core "+ ++ "packages (e.g. by using appropriate --constraint= flags)."++type InstallContext = ( PackageDBStack+                      , [Repo]+                      , Compiler+                      , ProgramConfiguration+                      , GlobalFlags+                      , ConfigFlags+                      , ConfigExFlags+                      , InstallFlags )++-- ------------------------------------------------------------+-- * Installation planning+-- ------------------------------------------------------------++planPackages :: Compiler+             -> ConfigFlags+             -> ConfigExFlags+             -> InstallFlags+             -> PackageIndex InstalledPackage+             -> AvailablePackageDb+             -> [PackageSpecifier AvailablePackage]+             -> Progress String String InstallPlan+planPackages comp configFlags configExFlags installFlags+             installed availableDb pkgSpecifiers =++        resolveDependencies+          buildPlatform (compilerId comp)+          resolverParams++    >>= if onlyDeps then adjustPlanOnlyDeps else return++  where+    resolverParams =++        setPreferenceDefault (if upgradeDeps then PreferAllLatest+                                             else PreferLatestForSelected)++      . addPreferences+          -- preferences from the config file or command line+          [ PackageVersionPreference name ver+          | Dependency name ver <- configPreferences configExFlags ]++      . addConstraints+          -- version constraints from the config file or command line+          [ PackageVersionConstraint name ver+          | Dependency name ver <- configConstraints configFlags ]++      . addConstraints+          --FIXME: this just applies all flags to all targets which+          -- is silly. We should check if the flags are appropriate+          [ PackageFlagsConstraint (pkgSpecifierTarget pkgSpecifier) flags+          | let flags = configConfigurationsFlags configFlags+          , not (null flags)+          , pkgSpecifier <- pkgSpecifiers ]++      . (if reinstall then reinstallTargets else id)++      $ standardInstallPolicy installed availableDb pkgSpecifiers++    --TODO: this is a general feature and should be moved to D.C.Dependency+    -- Also, the InstallPlan.remove should return info more precise to the+    -- problem, rather than the very general PlanProblem type.+    adjustPlanOnlyDeps :: InstallPlan -> Progress String String InstallPlan+    adjustPlanOnlyDeps =+        either (Fail . explain) Done+      . InstallPlan.remove isTarget+      where+        isTarget pkg = packageName pkg `elem` targetnames+        targetnames  = map pkgSpecifierTarget pkgSpecifiers+        +        explain :: [InstallPlan.PlanProblem] -> String+        explain problems =+            "Cannot select only the dependencies (as requested by the "+         ++ "'--only-dependencies' flag), "+         ++ (case pkgids of+               [pkgid] -> "the package " ++ display pkgid ++ " is "+               _       -> "the packages "+                       ++ intercalate ", " (map display pkgids) ++ " are ")+         ++ "required by a dependency of one of the other targets."+          where+            pkgids =+              nub [ depid+                  | InstallPlan.PackageMissingDeps _ depids <- problems+                  , depid <- depids+                  , packageName depid `elem` targetnames ]++    reinstall   = fromFlag (installReinstall installFlags)+    upgradeDeps = fromFlag (installUpgradeDeps installFlags)+    onlyDeps    = fromFlag (installOnlyDeps installFlags)++-- ------------------------------------------------------------+-- * Informational messages+-- ------------------------------------------------------------++printPlanMessages :: Verbosity+                  -> PackageIndex InstalledPackage+                  -> InstallPlan+                  -> Bool+                  -> IO ()+printPlanMessages verbosity installed installPlan dryRun = do++  when nothingToInstall $+    notice verbosity $+         "No packages to be installed. All the requested packages are "+      ++ "already installed.\n If you want to reinstall anyway then use "+      ++ "the --reinstall flag."++  when (dryRun || verbosity >= verbose) $+    printDryRun verbosity installed installPlan++  where+    nothingToInstall = null (InstallPlan.ready installPlan)+++printDryRun :: Verbosity+            -> PackageIndex InstalledPackage+            -> InstallPlan+            -> IO ()+printDryRun verbosity installed plan = case unfoldr next plan of+  []   -> return ()+  pkgs+    | verbosity >= Verbosity.verbose -> notice verbosity $ unlines $+        "In order, the following would be installed:"+      : map showPkgAndReason pkgs+    | otherwise -> notice verbosity $ unlines $+        "In order, the following would be installed (use -v for more details):"+      : map (display . packageId) pkgs+  where+    next plan' = case InstallPlan.ready plan' of+      []      -> Nothing+      (pkg:_) -> Just (pkg, InstallPlan.completed pkgid result plan')+        where pkgid = packageId pkg+              result = BuildOk DocsNotTried TestsNotTried+              --FIXME: This is a bit of a hack,+              -- pretending that each package is installed++    showPkgAndReason pkg' = display (packageId pkg') ++ " " +++          case PackageIndex.lookupPackageName installed (packageName pkg') of+            [] -> "(new package)"+            ps ->  case find ((==packageId pkg') . packageId) ps of+              Nothing  -> "(new version)"+              Just pkg -> "(reinstall)" ++ case changes pkg pkg' of+                []   -> ""+                diff -> " changes: "  ++ intercalate ", " diff+    changes pkg pkg' = map change . filter changed+                     $ mergeBy (comparing packageName)+                         (nub . sort . depends $ pkg)+                         (nub . sort . depends $ pkg')+    change (OnlyInLeft pkgid)        = display pkgid ++ " removed"+    change (InBoth     pkgid pkgid') = display pkgid ++ " -> "+                                    ++ display (packageVersion pkgid')+    change (OnlyInRight      pkgid') = display pkgid' ++ " added"+    changed (InBoth    pkgid pkgid') = pkgid /= pkgid'+    changed _                        = True++-- ------------------------------------------------------------+-- * Post installation stuff+-- ------------------------------------------------------------++-- | Various stuff we do after successful or unsuccessfully installing a bunch+-- of packages. This includes:+--+--  * build reporting, local and remote+--  * symlinking binaries+--  * updating indexes+--  * updating world file+--  * error reporting+--+postInstallActions :: Verbosity+                   -> InstallContext+                   -> [UserTarget]+                   -> InstallPlan+                   -> IO ()+postInstallActions verbosity+  (packageDBs, _, comp, conf, globalFlags, configFlags, _, installFlags)+  targets installPlan = do++  unless oneShot $+    World.insert verbosity worldFile+      --FIXME: does not handle flags+      [ World.WorldPkgInfo dep []+      | UserTargetNamed dep <- targets ]++  let buildReports = BuildReports.fromInstallPlan installPlan+  BuildReports.storeLocal (installSummaryFile installFlags) buildReports+  when (reportingLevel >= AnonymousReports) $+    BuildReports.storeAnonymous buildReports+  when (reportingLevel == DetailedReports) $+    storeDetailedBuildReports verbosity logsDir buildReports++  regenerateHaddockIndex verbosity packageDBs comp conf+                         configFlags installFlags installPlan++  symlinkBinaries verbosity configFlags installFlags installPlan++  printBuildFailures installPlan++  where+    reportingLevel = fromFlag (installBuildReports installFlags)+    logsDir        = fromFlag (globalLogsDir globalFlags)+    oneShot        = fromFlag (installOneShot installFlags)+    worldFile      = fromFlag $ globalWorldFile globalFlags++storeDetailedBuildReports :: Verbosity -> FilePath+                          -> [(BuildReports.BuildReport, Repo)] -> IO ()+storeDetailedBuildReports verbosity logsDir reports = sequence_+  [ do dotCabal <- defaultCabalDir+       let logFileName = display (BuildReports.package report) <.> "log"+           logFile     = logsDir </> logFileName+           reportsDir  = dotCabal </> "reports" </> remoteRepoName remoteRepo+           reportFile  = reportsDir </> logFileName++       handleMissingLogFile $ do+         buildLog <- readFile logFile+         createDirectoryIfMissing True reportsDir -- FIXME+         writeFile reportFile (show (BuildReports.show report, buildLog))++  | (report, Repo { repoKind = Left remoteRepo }) <- reports+  , isLikelyToHaveLogFile (BuildReports.installOutcome report) ]++  where+    isLikelyToHaveLogFile BuildReports.ConfigureFailed {} = True+    isLikelyToHaveLogFile BuildReports.BuildFailed     {} = True+    isLikelyToHaveLogFile BuildReports.InstallFailed   {} = True+    isLikelyToHaveLogFile BuildReports.InstallOk       {} = True+    isLikelyToHaveLogFile _                               = False++    handleMissingLogFile = Exception.handleJust missingFile $ \ioe ->+      warn verbosity $ "Missing log file for build report: "+                    ++ fromMaybe ""  (ioeGetFileName ioe)++#if MIN_VERSION_base(4,0,0)+    missingFile ioe+#else+    missingFile (IOException ioe)+#endif+      | isDoesNotExistError ioe  = Just ioe+    missingFile _                = Nothing+++regenerateHaddockIndex :: Verbosity+                       -> [PackageDB]+                       -> Compiler+                       -> ProgramConfiguration+                       -> ConfigFlags+                       -> InstallFlags+                       -> InstallPlan+                       -> IO ()+regenerateHaddockIndex verbosity packageDBs comp conf+                       configFlags installFlags installPlan+  | haddockIndexFileIsRequested && shouldRegenerateHaddockIndex = do++  defaultDirs <- InstallDirs.defaultInstallDirs+                   (compilerFlavor comp)+                   (fromFlag (configUserInstall configFlags))+                   True+  let indexFileTemplate = fromFlag (installHaddockIndex installFlags)+      indexFile = substHaddockIndexFileName defaultDirs indexFileTemplate++  notice verbosity $+     "Updating documentation index " ++ indexFile++  --TODO: might be nice if the install plan gave us the new InstalledPackageInfo+  installed <- getInstalledPackages verbosity comp packageDBs conf+  Haddock.regenerateHaddockIndex verbosity installed conf indexFile++  | otherwise = return ()+  where+    haddockIndexFileIsRequested =+         fromFlag (installDocumentation installFlags)+      && isJust (flagToMaybe (installHaddockIndex installFlags))++    -- We want to regenerate the index if some new documentation was actually+    -- installed. Since the index is per-user, we don't do it for global+    -- installs or special cases where we're installing into a specific db.+    shouldRegenerateHaddockIndex = normalUserInstall+                                && someDocsWereInstalled installPlan+      where+        someDocsWereInstalled = any installedDocs . InstallPlan.toList+        normalUserInstall     = (UserPackageDB `elem` packageDBs)+                             && all (not . isSpecificPackageDB) packageDBs++        installedDocs (InstallPlan.Installed _ (BuildOk DocsOk _)) = True+        installedDocs _                                            = False+        isSpecificPackageDB (SpecificPackageDB _) = True+        isSpecificPackageDB _                     = False++    substHaddockIndexFileName defaultDirs = fromPathTemplate+                                          . substPathTemplate env+      where+        env  = env0 ++ installDirsTemplateEnv absoluteDirs+        env0 = InstallDirs.compilerTemplateEnv (compilerId comp)+            ++ InstallDirs.platformTemplateEnv (buildPlatform)+        absoluteDirs = InstallDirs.substituteInstallDirTemplates+                         env0 templateDirs+        templateDirs = InstallDirs.combineInstallDirs fromFlagOrDefault+                         defaultDirs (configInstallDirs configFlags)+++symlinkBinaries :: Verbosity+                -> ConfigFlags+                -> InstallFlags+                -> InstallPlan -> IO ()+symlinkBinaries verbosity configFlags installFlags plan = do+  failed <- InstallSymlink.symlinkBinaries configFlags installFlags plan+  case failed of+    [] -> return ()+    [(_, exe, path)] ->+      warn verbosity $+           "could not create a symlink in " ++ bindir ++ " for "+        ++ exe ++ " because the file exists there already but is not "+        ++ "managed by cabal. You can create a symlink for this executable "+        ++ "manually if you wish. The executable file has been installed at "+        ++ path+    exes ->+      warn verbosity $+           "could not create symlinks in " ++ bindir ++ " for "+        ++ intercalate ", " [ exe | (_, exe, _) <- exes ]+        ++ " because the files exist there already and are not "+        ++ "managed by cabal. You can create symlinks for these executables "+        ++ "manually if you wish. The executable files have been installed at "+        ++ intercalate ", " [ path | (_, _, path) <- exes ]+  where+    bindir = fromFlag (installSymlinkBinDir installFlags)+++printBuildFailures :: InstallPlan -> IO ()+printBuildFailures plan =+  case [ (pkg, reason)+       | InstallPlan.Failed pkg reason <- InstallPlan.toList plan ] of+    []     -> return ()+    failed -> die . unlines+            $ "Error: some packages failed to install:"+            : [ display (packageId pkg) ++ printFailureReason reason+              | (pkg, reason) <- failed ]+  where+    printFailureReason reason = case reason of+      DependentFailed pkgid -> " depends on " ++ display pkgid+                            ++ " which failed to install."+      DownloadFailed  e -> " failed while downloading the package."+                        ++ " The exception was:\n  " ++ show e+      UnpackFailed    e -> " failed while unpacking the package."+                        ++ " The exception was:\n  " ++ show e+      ConfigureFailed e -> " failed during the configure step."+                        ++ " The exception was:\n  " ++ show e+      BuildFailed     e -> " failed during the building phase."+                        ++ " The exception was:\n  " ++ show e+      InstallFailed   e -> " failed during the final install step."+                        ++ " The exception was:\n  " ++ show e+++-- ------------------------------------------------------------+-- * Actually do the installations+-- ------------------------------------------------------------++data InstallMisc = InstallMisc {+    rootCmd    :: Maybe FilePath,+    libVersion :: Maybe Version+  }++performInstallations :: Verbosity+                     -> InstallContext+                     -> PackageIndex InstalledPackage+                     -> InstallPlan+                     -> IO InstallPlan+performInstallations verbosity+  (packageDBs, _, comp, conf,+   globalFlags, configFlags, configExFlags, installFlags)+  installed installPlan = do++  executeInstallPlan installPlan $ \cpkg ->+    installConfiguredPackage platform compid configFlags+                             cpkg $ \configFlags' src pkg ->+      fetchAvailablePackage verbosity src $ \src' ->+        installLocalPackage verbosity (packageId pkg) src' $ \mpath ->+          installUnpackedPackage verbosity (setupScriptOptions installed)+                                 miscOptions configFlags' installFlags+                                 compid pkg mpath useLogFile++  where+    platform = InstallPlan.planPlatform installPlan+    compid   = InstallPlan.planCompiler installPlan++    setupScriptOptions index = SetupScriptOptions {+      useCabalVersion  = maybe anyVersion thisVersion (libVersion miscOptions),+      useCompiler      = Just comp,+      -- Hack: we typically want to allow the UserPackageDB for finding the+      -- Cabal lib when compiling any Setup.hs even if we're doing a global+      -- install. However we also allow looking in a specific package db.+      usePackageDB     = if UserPackageDB `elem` packageDBs+                           then packageDBs+                           else let (db@GlobalPackageDB:dbs) = packageDBs+                                 in db : UserPackageDB : dbs,+                                --TODO: use Ord instance:+                                -- insert UserPackageDB packageDBs+      usePackageIndex  = if UserPackageDB `elem` packageDBs+                           then Just index+                           else Nothing,+      useProgramConfig = conf,+      useDistPref      = fromFlagOrDefault+                           (useDistPref defaultSetupScriptOptions)+                           (configDistPref configFlags),+      useLoggingHandle = Nothing,+      useWorkingDir    = Nothing+    }+    reportingLevel = fromFlag (installBuildReports installFlags)+    logsDir        = fromFlag (globalLogsDir globalFlags)+    useLogFile :: Maybe (PackageIdentifier -> FilePath)+    useLogFile = fmap substLogFileName logFileTemplate+      where+        logFileTemplate :: Maybe PathTemplate+        logFileTemplate --TODO: separate policy from mechanism+          | reportingLevel == DetailedReports+          = Just $ toPathTemplate $ logsDir </> "$pkgid" <.> "log"+          | otherwise+          = flagToMaybe (installLogFile installFlags)+    substLogFileName template pkg = fromPathTemplate+                                  . substPathTemplate env+                                  $ template+      where env = initialPathTemplateEnv (packageId pkg) (compilerId comp)+    miscOptions  = InstallMisc {+      rootCmd    = if fromFlag (configUserInstall configFlags)+                     then Nothing      -- ignore --root-cmd if --user.+                     else flagToMaybe (installRootCmd installFlags),+      libVersion = flagToMaybe (configCabalVersion configExFlags)+    }+++executeInstallPlan :: Monad m+                   => InstallPlan+                   -> (ConfiguredPackage -> m BuildResult)+                   -> m InstallPlan+executeInstallPlan plan installPkg = case InstallPlan.ready plan of+  []       -> return plan+  (pkg: _) -> do buildResult <- installPkg pkg+                 let plan' = updatePlan (packageId pkg) buildResult plan+                 executeInstallPlan plan' installPkg+  where+    updatePlan pkgid (Right buildSuccess) =+      InstallPlan.completed pkgid buildSuccess++    updatePlan pkgid (Left buildFailure) =+      InstallPlan.failed    pkgid buildFailure depsFailure+      where+        depsFailure = DependentFailed pkgid+        -- So this first pkgid failed for whatever reason (buildFailure).+        -- All the other packages that depended on this pkgid, which we+        -- now cannot build, we mark as failing due to 'DependentFailed'+        -- which kind of means it was not their fault.+++-- | Call an installer for an 'AvailablePackage' but override the configure+-- flags with the ones given by the 'ConfiguredPackage'. In particular the+-- 'ConfiguredPackage' specifies an exact 'FlagAssignment' and exactly+-- versioned package dependencies. So we ignore any previous partial flag+-- assignment or dependency constraints and use the new ones.+--+installConfiguredPackage :: Platform -> CompilerId+                         ->  ConfigFlags -> ConfiguredPackage+                         -> (ConfigFlags -> PackageLocation (Maybe FilePath)+                                         -> PackageDescription -> a)+                         -> a+installConfiguredPackage platform comp configFlags+  (ConfiguredPackage (AvailablePackage _ gpkg source) flags deps)+  installPkg = installPkg configFlags {+    configConfigurationsFlags = flags,+    configConstraints = map thisPackageVersion deps+  } source pkg+  where+    pkg = case finalizePackageDescription flags+           (const True)+           platform comp [] gpkg of+      Left _ -> error "finalizePackageDescription ConfiguredPackage failed"+      Right (desc, _) -> desc++fetchAvailablePackage+  :: Verbosity+  -> PackageLocation (Maybe FilePath)+  -> (PackageLocation FilePath -> IO BuildResult)+  -> IO BuildResult+fetchAvailablePackage verbosity src installPkg = do+  fetched <- checkFetched src+  case fetched of+    Just src' -> installPkg src'+    Nothing   -> onFailure DownloadFailed $+                   fetchPackage verbosity src >>= installPkg+++installLocalPackage+  :: Verbosity -> PackageIdentifier -> PackageLocation FilePath+  -> (Maybe FilePath -> IO BuildResult)+  -> IO BuildResult+installLocalPackage verbosity pkgid location installPkg = case location of++    LocalUnpackedPackage dir ->+      installPkg (Just dir)++    LocalTarballPackage tarballPath ->+      installLocalTarballPackage verbosity pkgid tarballPath installPkg++    RemoteTarballPackage _ tarballPath ->+      installLocalTarballPackage verbosity pkgid tarballPath installPkg++    RepoTarballPackage _ _ tarballPath ->+      installLocalTarballPackage verbosity pkgid tarballPath installPkg+++installLocalTarballPackage+  :: Verbosity -> PackageIdentifier -> FilePath+  -> (Maybe FilePath -> IO BuildResult)+  -> IO BuildResult+installLocalTarballPackage verbosity pkgid tarballPath installPkg = do+  tmp <- getTemporaryDirectory+  withTempDirectory verbosity tmp (display pkgid) $ \tmpDirPath ->+    onFailure UnpackFailed $ do+      info verbosity $ "Extracting " ++ tarballPath+                    ++ " to " ++ tmpDirPath ++ "..."+      let relUnpackedPath = display pkgid+          absUnpackedPath = tmpDirPath </> relUnpackedPath+          descFilePath = absUnpackedPath+                     </> display (packageName pkgid) <.> "cabal"+      extractTarGzFile tmpDirPath relUnpackedPath tarballPath+      exists <- doesFileExist descFilePath+      when (not exists) $+        die $ "Package .cabal file not found: " ++ show descFilePath+      installPkg (Just absUnpackedPath)+++installUnpackedPackage :: Verbosity+                   -> SetupScriptOptions+                   -> InstallMisc+                   -> ConfigFlags+                   -> InstallFlags+                   -> CompilerId+                   -> PackageDescription+                   -> Maybe FilePath -- ^ Directory to change to before starting the installation.+                   -> Maybe (PackageIdentifier -> FilePath) -- ^ File to log output to (if any)+                   -> IO BuildResult+installUnpackedPackage verbosity scriptOptions miscOptions+                       configFlags installConfigFlags+                       compid pkg workingDir useLogFile =++  -- Configure phase+  onFailure ConfigureFailed $ do+    setup configureCommand configureFlags++  -- Build phase+    onFailure BuildFailed $ do+      setup buildCommand' buildFlags++  -- Doc generation phase+      docsResult <- if shouldHaddock+        then (do setup haddockCommand haddockFlags+                 return DocsOk)+               `catchIO`   (\_ -> return DocsFailed)+               `catchExit` (\_ -> return DocsFailed)+        else return DocsNotTried++  -- Tests phase+      testsResult <- return TestsNotTried  --TODO: add optional tests++  -- Install phase+      onFailure InstallFailed $+        withWin32SelfUpgrade verbosity configFlags compid pkg $ do+          case rootCmd miscOptions of+            (Just cmd) -> reexec cmd+            Nothing    -> setup Cabal.installCommand installFlags+          return (Right (BuildOk docsResult testsResult))++  where+    configureFlags   = filterConfigureFlags configFlags {+      configVerbosity = toFlag verbosity'+    }+    buildCommand'    = buildCommand defaultProgramConfiguration+    buildFlags   _   = emptyBuildFlags {+      buildDistPref  = configDistPref configFlags,+      buildVerbosity = toFlag verbosity'+    }+    shouldHaddock    = fromFlag (installDocumentation installConfigFlags)+    haddockFlags _   = emptyHaddockFlags {+      haddockDistPref  = configDistPref configFlags,+      haddockVerbosity = toFlag verbosity'+    }+    installFlags _   = Cabal.emptyInstallFlags {+      Cabal.installDistPref  = configDistPref configFlags,+      Cabal.installVerbosity = toFlag verbosity'+    }+    verbosity' | isJust useLogFile = max Verbosity.verbose verbosity+               | otherwise         = verbosity+    setup cmd flags  = do+      logFileHandle <- case useLogFile of+        Nothing          -> return Nothing+        Just mkLogFileName -> do+          let logFileName = mkLogFileName (packageId pkg)+              logDir      = takeDirectory logFileName+          unless (null logDir) $ createDirectoryIfMissing True logDir+          logFile <- openFile logFileName AppendMode+          return (Just logFile)++      setupWrapper verbosity+        scriptOptions { useLoggingHandle = logFileHandle+                      , useWorkingDir    = workingDir }+        (Just pkg)+        cmd flags []+    reexec cmd = do+      -- look for our on executable file and re-exec ourselves using+      -- a helper program like sudo to elevate priviledges:+      bindir <- getBinDir+      let self = bindir </> "cabal" <.> exeExtension+      weExist <- doesFileExist self+      if weExist+        then inDir workingDir $+               rawSystemExit verbosity cmd+                 [self, "install", "--only"+                 ,"--verbose=" ++ showForCabal verbosity]+        else die $ "Unable to find cabal executable at: " ++ self+++-- helper+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+++-- ------------------------------------------------------------+-- * Wierd windows hacks+-- ------------------------------------------------------------++withWin32SelfUpgrade :: Verbosity+                     -> ConfigFlags+                     -> CompilerId+                     -> PackageDescription+                     -> IO a -> IO a+withWin32SelfUpgrade _ _ _ _ action | buildOS /= Windows = action+withWin32SelfUpgrade verbosity configFlags compid pkg action = do++  defaultDirs <- InstallDirs.defaultInstallDirs+                   compFlavor+                   (fromFlag (configUserInstall configFlags))+                   (PackageDescription.hasLibs pkg)++  Win32SelfUpgrade.possibleSelfUpgrade verbosity+    (exeInstallPaths defaultDirs) action++  where+    pkgid = packageId pkg+    (CompilerId compFlavor _) = compid++    exeInstallPaths defaultDirs =+      [ InstallDirs.bindir absoluteDirs </> exeName <.> exeExtension+      | exe <- PackageDescription.executables pkg+      , PackageDescription.buildable (PackageDescription.buildInfo exe)+      , let exeName = prefix ++ PackageDescription.exeName exe ++ suffix+            prefix  = substTemplate prefixTemplate+            suffix  = substTemplate suffixTemplate ]+      where+        fromFlagTemplate = fromFlagOrDefault (InstallDirs.toPathTemplate "")+        prefixTemplate = fromFlagTemplate (configProgPrefix configFlags)+        suffixTemplate = fromFlagTemplate (configProgSuffix configFlags)+        templateDirs   = InstallDirs.combineInstallDirs fromFlagOrDefault+                           defaultDirs (configInstallDirs configFlags)+        absoluteDirs   = InstallDirs.absoluteInstallDirs+                           pkgid compid InstallDirs.NoCopyDest templateDirs+        substTemplate  = InstallDirs.fromPathTemplate+                       . InstallDirs.substPathTemplate env+          where env = InstallDirs.initialPathTemplateEnv pkgid compid

@@ -0,0 +1,511 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Client.InstallPlan+-- Copyright   :  (c) Duncan Coutts 2008+-- License     :  BSD-like+--+-- Maintainer  :  duncan@community.haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- Package installation plan+--+-----------------------------------------------------------------------------+module Distribution.Client.InstallPlan (+  InstallPlan,+  ConfiguredPackage(..),+  PlanPackage(..),++  -- * Operations on 'InstallPlan's+  new,+  toList,+  ready,+  completed,+  failed,+  remove,++  -- ** Query functions+  planPlatform,+  planCompiler,++  -- * Checking valididy of plans+  valid,+  closed,+  consistent,+  acyclic,+  configuredPackageValid,++  -- ** Details on invalid plans+  PlanProblem(..),+  showPlanProblem,+  PackageProblem(..),+  showPackageProblem,+  problems,+  configuredPackageProblems+  ) where++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.PackageDescription+         ( GenericPackageDescription(genPackageFlags)+         , Flag(flagName), FlagName(..) )+import Distribution.Client.PackageUtils+         ( externalBuildDepends )+import Distribution.PackageDescription.Configuration+         ( finalizePackageDescription )+import Distribution.Client.PackageIndex+         ( PackageIndex )+import qualified Distribution.Client.PackageIndex as PackageIndex+import Distribution.Text+         ( display )+import Distribution.System+         ( Platform )+import Distribution.Compiler+         ( CompilerId(..) )+import Distribution.Client.Utils+         ( duplicates, duplicatesBy, mergeBy, MergeResult(..) )+import Distribution.Simple.Utils+         ( comparing, intercalate )++import Data.List+         ( sort, sortBy )+import Data.Maybe+         ( fromMaybe )+import qualified Data.Graph as Graph+import Data.Graph (Graph)+import Control.Exception+         ( assert )++-- When cabal tries to install a number of packages, including all their+-- dependencies it has a non-trivial problem to solve.+--+-- The Problem:+--+-- In general we start with a set of installed packages and a set of available+-- packages.+--+-- Installed packages have fixed dependencies. They have already been built and+-- we know exactly what packages they were built against, including their exact+-- versions. +--+-- Available package have somewhat flexible dependencies. They are specified as+-- version ranges, though really they're predicates. To make matters worse they+-- have conditional flexible dependencies. Configuration flags can affect which+-- packages are required and can place additional constraints on their+-- versions.+--+-- These two sets of package can and usually do overlap. There can be installed+-- packages that are also available which means they could be re-installed if+-- required, though there will also be packages which are not available and+-- cannot be re-installed. Very often there will be extra versions available+-- than are installed. Sometimes we may like to prefer installed packages over+-- available ones or perhaps always prefer the latest available version whether+-- installed or not.+--+-- The goal is to calculate an installation plan that is closed, acyclic and+-- consistent and where every configured package is valid.+--+-- An installation plan is a set of packages that are going to be used+-- together. It will consist of a mixture of installed packages and available+-- packages along with their exact version dependencies. An installation plan+-- is closed if for every package in the set, all of its dependencies are+-- also in the set. It is consistent if for every package in the set, all+-- dependencies which target that package have the same version.++-- Note that plans do not necessarily compose. You might have a valid plan for+-- package A and a valid plan for package B. That does not mean the composition+-- is simultaniously valid for A and B. In particular you're most likely to+-- have problems with inconsistent dependencies.+-- On the other hand it is true that every closed sub plan is valid.++data PlanPackage = PreExisting InstalledPackage+                 | Configured  ConfiguredPackage+                 | Installed   ConfiguredPackage BuildSuccess+                 | Failed      ConfiguredPackage BuildFailure++instance Package PlanPackage where+  packageId (PreExisting pkg) = packageId pkg+  packageId (Configured  pkg) = packageId pkg+  packageId (Installed pkg _) = packageId pkg+  packageId (Failed    pkg _) = packageId pkg++instance PackageFixedDeps PlanPackage where+  depends (PreExisting pkg) = depends pkg+  depends (Configured  pkg) = depends pkg+  depends (Installed pkg _) = depends pkg+  depends (Failed    pkg _) = depends pkg++data InstallPlan = InstallPlan {+    planIndex    :: PackageIndex PlanPackage,+    planGraph    :: Graph,+    planGraphRev :: Graph,+    planPkgOf    :: Graph.Vertex -> PlanPackage,+    planVertexOf :: PackageIdentifier -> Graph.Vertex,+    planPlatform :: Platform,+    planCompiler :: CompilerId+  }++invariant :: InstallPlan -> Bool+invariant plan =+  valid (planPlatform plan) (planCompiler plan) (planIndex plan)++internalError :: String -> a+internalError msg = error $ "InstallPlan: internal error: " ++ msg++-- | Build an installation plan from a valid set of resolved packages.+--+new :: Platform -> CompilerId -> PackageIndex PlanPackage+    -> Either [PlanProblem] InstallPlan+new platform compiler index =+  case problems platform compiler index of+    [] -> Right InstallPlan {+            planIndex    = index,+            planGraph    = graph,+            planGraphRev = Graph.transposeG graph,+            planPkgOf    = vertexToPkgId,+            planVertexOf = fromMaybe noSuchPkgId . pkgIdToVertex,+            planPlatform = platform,+            planCompiler = compiler+          }+      where (graph, vertexToPkgId, pkgIdToVertex) =+              PackageIndex.dependencyGraph index+            noSuchPkgId = internalError "package is not in the graph"+    probs -> Left probs++toList :: InstallPlan -> [PlanPackage]+toList = PackageIndex.allPackages . planIndex++-- | Remove packages from the install plan. This will result in an+-- error if there are remaining packages that depend on any matching+-- package. This is primarily useful for obtaining an install plan for+-- the dependencies of a package or set of packages without actually+-- installing the package itself, as when doing development.+--+remove :: (PlanPackage -> Bool)+       -> InstallPlan+       -> Either [PlanProblem] InstallPlan+remove shouldRemove plan =+    new (planPlatform plan) (planCompiler plan) newIndex+  where+    newIndex = PackageIndex.fromList $+                 filter (not . shouldRemove) (toList plan)++-- | The packages that are ready to be installed. That is they are in the+-- configured state and have all their dependencies installed already.+-- The plan is complete if the result is @[]@.+--+ready :: InstallPlan -> [ConfiguredPackage]+ready plan = assert check readyPackages+  where+    check = if null readyPackages then null configuredPackages else True+    configuredPackages =+      [ pkg | Configured pkg <- PackageIndex.allPackages (planIndex plan) ]+    readyPackages = filter (all isInstalled . depends) configuredPackages+    isInstalled pkg =+      case PackageIndex.lookupPackageId (planIndex plan) pkg of+        Just (Configured  _) -> False+        Just (Failed    _ _) -> internalError depOnFailed+        Just (PreExisting _) -> True+        Just (Installed _ _) -> True+        Nothing              -> internalError incomplete+    incomplete  = "install plan is not closed"+    depOnFailed = "configured package depends on failed package"++-- | Marks a package in the graph as completed. Also saves the build result for+-- the completed package in the plan.+--+-- * The package must exist in the graph.+-- * The package must have had no uninstalled dependent packages.+--+completed :: PackageIdentifier+          -> BuildSuccess+          -> InstallPlan -> InstallPlan+completed pkgid buildResult plan = assert (invariant plan') plan'+  where+    plan'     = plan {+                  planIndex = PackageIndex.insert installed (planIndex plan)+                }+    installed = Installed (lookupConfiguredPackage plan pkgid) buildResult++-- | Marks a package in the graph as having failed. It also marks all the+-- packages that depended on it as having failed.+--+-- * The package must exist in the graph and be in the configured state.+--+failed :: PackageIdentifier -- ^ The id of the package that failed to install+       -> BuildFailure      -- ^ The build result to use for the failed package+       -> BuildFailure      -- ^ The build result to use for its dependencies+       -> InstallPlan+       -> InstallPlan+failed pkgid buildResult buildResult' plan = assert (invariant plan') plan'+  where+    plan'    = plan {+                 planIndex = PackageIndex.merge (planIndex plan) failures+               }+    pkg      = lookupConfiguredPackage plan pkgid+    failures = PackageIndex.fromList+             $ Failed pkg buildResult+             : [ Failed pkg' buildResult'+               | Just pkg' <- map checkConfiguredPackage+                            $ packagesThatDependOn plan pkgid ]++-- | lookup the reachable packages in the reverse dependency graph+--+packagesThatDependOn :: InstallPlan+                     -> PackageIdentifier -> [PlanPackage]+packagesThatDependOn plan = map (planPkgOf plan)+                          . tail+                          . Graph.reachable (planGraphRev plan)+                          . planVertexOf plan++-- | lookup a package that we expect to be in the configured state+--+lookupConfiguredPackage :: InstallPlan+                        -> PackageIdentifier -> ConfiguredPackage+lookupConfiguredPackage plan pkgid =+  case PackageIndex.lookupPackageId (planIndex plan) pkgid of+    Just (Configured pkg) -> pkg+    _  -> internalError $ "not configured or no such pkg " ++ display pkgid++-- | check a package that we expect to be in the configured or failed state+--+checkConfiguredPackage :: PlanPackage -> Maybe ConfiguredPackage+checkConfiguredPackage (Configured pkg) = Just pkg+checkConfiguredPackage (Failed     _ _) = Nothing+checkConfiguredPackage pkg                =+  internalError $ "not configured or no such pkg " ++ display (packageId pkg)++-- ------------------------------------------------------------+-- * Checking valididy of plans+-- ------------------------------------------------------------++-- | A valid installation plan is a set of packages that is 'acyclic',+-- 'closed' and 'consistent'. Also, every 'ConfiguredPackage' in the+-- plan has to have a valid configuration (see 'configuredPackageValid').+--+-- * if the result is @False@ use 'problems' to get a detailed list.+--+valid :: Platform -> CompilerId -> PackageIndex PlanPackage -> Bool+valid platform comp index = null (problems platform comp index)++data PlanProblem =+     PackageInvalid       ConfiguredPackage [PackageProblem]+   | PackageMissingDeps   PlanPackage [PackageIdentifier]+   | PackageCycle         [PlanPackage]+   | PackageInconsistency PackageName [(PackageIdentifier, Version)]+   | PackageStateInvalid  PlanPackage PlanPackage++showPlanProblem :: PlanProblem -> String+showPlanProblem (PackageInvalid pkg packageProblems) =+     "Package " ++ display (packageId pkg)+  ++ " has an invalid configuration, in particular:\n"+  ++ unlines [ "  " ++ showPackageProblem problem+             | problem <- packageProblems ]++showPlanProblem (PackageMissingDeps pkg missingDeps) =+     "Package " ++ display (packageId pkg)+  ++ " depends on the following packages which are missing from the plan "+  ++ intercalate ", " (map display missingDeps)++showPlanProblem (PackageCycle cycleGroup) =+     "The following packages are involved in a dependency cycle "+  ++ intercalate ", " (map (display.packageId) cycleGroup)++showPlanProblem (PackageInconsistency name inconsistencies) =+     "Package " ++ display name+  ++ " is required by several packages,"+  ++ " but they require inconsistent versions:\n"+  ++ unlines [ "  package " ++ display pkg ++ " requires "+                            ++ display (PackageIdentifier name ver)+             | (pkg, ver) <- inconsistencies ]++showPlanProblem (PackageStateInvalid pkg pkg') =+     "Package " ++ display (packageId pkg)+  ++ " is in the " ++ showPlanState pkg+  ++ " state but it depends on package " ++ display (packageId pkg')+  ++ " which is in the " ++ showPlanState pkg'+  ++ " state"+  where+    showPlanState (PreExisting _) = "pre-existing"+    showPlanState (Configured  _) = "configured"+    showPlanState (Installed _ _) = "installed"+    showPlanState (Failed    _ _) = "failed"++-- | For an invalid plan, produce a detailed list of problems as human readable+-- error messages. This is mainly intended for debugging purposes.+-- Use 'showPlanProblem' for a human readable explanation.+--+problems :: Platform -> CompilerId+         -> PackageIndex PlanPackage -> [PlanProblem]+problems platform comp index =+     [ PackageInvalid pkg packageProblems+     | Configured pkg <- PackageIndex.allPackages index+     , let packageProblems = configuredPackageProblems platform comp pkg+     , not (null packageProblems) ]++  ++ [ PackageMissingDeps pkg missingDeps+     | (pkg, missingDeps) <- PackageIndex.brokenPackages index ]++  ++ [ PackageCycle cycleGroup+     | cycleGroup <- PackageIndex.dependencyCycles index ]++  ++ [ PackageInconsistency name inconsistencies+     | (name, inconsistencies) <- PackageIndex.dependencyInconsistencies index ]++  ++ [ PackageStateInvalid pkg pkg'+     | pkg <- PackageIndex.allPackages index+     , Just pkg' <- map (PackageIndex.lookupPackageId index) (depends pkg)+     , not (stateDependencyRelation pkg pkg') ]++-- | The graph of packages (nodes) and dependencies (edges) must be acyclic.+--+-- * if the result is @False@ use 'PackageIndex.dependencyCycles' to find out+--   which packages are involved in dependency cycles.+--+acyclic :: PackageIndex PlanPackage -> Bool+acyclic = null . PackageIndex.dependencyCycles++-- | An installation plan is closed if for every package in the set, all of+-- its dependencies are also in the set. That is, the set is closed under the+-- dependency relation.+--+-- * if the result is @False@ use 'PackageIndex.brokenPackages' to find out+--   which packages depend on packages not in the index.+--+closed :: PackageIndex PlanPackage -> Bool+closed = null . PackageIndex.brokenPackages++-- | An installation plan is consistent if all dependencies that target a+-- single package name, target the same version.+--+-- This is slightly subtle. It is not the same as requiring that there be at+-- most one version of any package in the set. It only requires that of+-- packages which have more than one other package depending on them. We could+-- actually make the condition even more precise and say that different+-- versions are ok so long as they are not both in the transative closure of+-- any other package (or equivalently that their inverse closures do not+-- intersect). The point is we do not want to have any packages depending+-- directly or indirectly on two different versions of the same package. The+-- current definition is just a safe aproximation of that.+--+-- * if the result is @False@ use 'PackageIndex.dependencyInconsistencies' to+--   find out which packages are.+--+consistent :: PackageIndex PlanPackage -> Bool+consistent = null . PackageIndex.dependencyInconsistencies++-- | The states of packages have that depend on each other must respect+-- this relation. That is for very case where package @a@ depends on+-- package @b@ we require that @dependencyStatesOk a b = True@.+--+stateDependencyRelation :: PlanPackage -> PlanPackage -> Bool+stateDependencyRelation (PreExisting _) (PreExisting _) = True++stateDependencyRelation (Configured  _) (PreExisting _) = True+stateDependencyRelation (Configured  _) (Configured  _) = True+stateDependencyRelation (Configured  _) (Installed _ _) = True++stateDependencyRelation (Installed _ _) (PreExisting _) = True+stateDependencyRelation (Installed _ _) (Installed _ _) = True++stateDependencyRelation (Failed    _ _) (PreExisting _) = True+-- failed can depends on configured because a package can depend on+-- several other packages and if one of the deps fail then we fail+-- but we still depend on the other ones that did not fail:+stateDependencyRelation (Failed    _ _) (Configured  _) = True+stateDependencyRelation (Failed    _ _) (Installed _ _) = True+stateDependencyRelation (Failed    _ _) (Failed    _ _) = True++stateDependencyRelation _               _               = False++-- | A 'ConfiguredPackage' is valid if the flag assignment is total and if+-- in the configuration given by the flag assignment, all the package+-- dependencies are satisfied by the specified packages.+--+configuredPackageValid :: Platform -> CompilerId -> ConfiguredPackage -> Bool+configuredPackageValid platform comp pkg =+  null (configuredPackageProblems platform comp pkg)++data PackageProblem = DuplicateFlag FlagName+                    | MissingFlag   FlagName+                    | ExtraFlag     FlagName+                    | DuplicateDeps [PackageIdentifier]+                    | MissingDep    Dependency+                    | ExtraDep      PackageIdentifier+                    | InvalidDep    Dependency PackageIdentifier++showPackageProblem :: PackageProblem -> String+showPackageProblem (DuplicateFlag (FlagName flag)) =+  "duplicate flag in the flag assignment: " ++ flag++showPackageProblem (MissingFlag (FlagName flag)) =+  "missing an assignment for the flag: " ++ flag++showPackageProblem (ExtraFlag (FlagName flag)) =+  "extra flag given that is not used by the package: " ++ flag++showPackageProblem (DuplicateDeps pkgids) =+     "duplicate packages specified as selected dependencies: "+  ++ intercalate ", " (map display pkgids)++showPackageProblem (MissingDep dep) =+     "the package has a dependency " ++ display dep+  ++ " but no package has been selected to satisfy it."++showPackageProblem (ExtraDep pkgid) =+     "the package configuration specifies " ++ display pkgid+  ++ " but (with the given flag assignment) the package does not actually"+  ++ " depend on any version of that package."++showPackageProblem (InvalidDep dep pkgid) =+     "the package depends on " ++ display dep+  ++ " but the configuration specifies " ++ display pkgid+  ++ " which does not satisfy the dependency."++configuredPackageProblems :: Platform -> CompilerId+                          -> ConfiguredPackage -> [PackageProblem]+configuredPackageProblems platform comp+  (ConfiguredPackage pkg specifiedFlags specifiedDeps) =+     [ DuplicateFlag flag | ((flag,_):_) <- duplicates specifiedFlags ]+  ++ [ MissingFlag flag | OnlyInLeft  flag <- mergedFlags ]+  ++ [ ExtraFlag   flag | OnlyInRight flag <- mergedFlags ]+  ++ [ DuplicateDeps pkgs+     | pkgs <- duplicatesBy (comparing packageName) specifiedDeps ]+  ++ [ MissingDep dep       | OnlyInLeft  dep       <- mergedDeps ]+  ++ [ ExtraDep       pkgid | OnlyInRight     pkgid <- mergedDeps ]+  ++ [ InvalidDep dep pkgid | InBoth      dep pkgid <- mergedDeps+                            , not (packageSatisfiesDependency pkgid dep) ]+  where+    mergedFlags = mergeBy compare+      (sort $ map flagName (genPackageFlags (packageDescription pkg)))+      (sort $ map fst specifiedFlags)++    mergedDeps = mergeBy+      (\dep pkgid -> dependencyName dep `compare` packageName pkgid)+      (sortBy (comparing dependencyName) requiredDeps)+      (sortBy (comparing packageName)    specifiedDeps)++    packageSatisfiesDependency+      (PackageIdentifier name  version)+      (Dependency        name' versionRange) = assert (name == name') $+        version `withinRange` versionRange++    dependencyName (Dependency name _) = name++    requiredDeps :: [Dependency]+    requiredDeps =+      --TODO: use something lower level than finalizePackageDescription+      case finalizePackageDescription specifiedFlags+         (const True)+         platform comp+         []+         (packageDescription pkg) of+        Right (resolvedPkg, _) -> externalBuildDepends resolvedPkg+        Left  _ -> error "configuredPackageInvalidDeps internal error"