cabal-install 0.14.1 → 1.16.0
raw patch · 27 files changed
+743/−238 lines, 27 filesdep ~Cabaldep ~basedep ~containersnew-uploader
Dependency ranges changed: Cabal, base, containers, directory, network, unix
Files
- Distribution/Client/BuildReports/Upload.hs +6/−2
- Distribution/Client/Config.hs +7/−2
- Distribution/Client/Configure.hs +6/−4
- Distribution/Client/Dependency/Modular/IndexConversion.hs +10/−11
- Distribution/Client/Dependency/TopDown.hs +4/−4
- Distribution/Client/Haddock.hs +8/−9
- Distribution/Client/HttpUtils.hs +6/−6
- Distribution/Client/IndexUtils.hs +31/−29
- Distribution/Client/Init.hs +5/−2
- Distribution/Client/Init/Licenses.hs +206/−0
- Distribution/Client/Install.hs +135/−49
- Distribution/Client/InstallSymlink.hs +5/−4
- Distribution/Client/JobControl.hs +12/−2
- Distribution/Client/Setup.hs +20/−9
- Distribution/Client/SetupWrapper.hs +94/−35
- Distribution/Client/Tar.hs +1/−9
- Distribution/Client/Targets.hs +8/−6
- Distribution/Client/Types.hs +9/−3
- Distribution/Client/Unpack.hs +24/−9
- Distribution/Client/Upload.hs +22/−5
- Distribution/Client/Utils.hs +15/−1
- Distribution/Client/World.hs +2/−1
- Distribution/Compat/Time.hs +37/−0
- Main.hs +4/−18
- bootstrap.sh +9/−9
- cabal-install.cabal +11/−9
- cbits/getnumcores.c +46/−0
Distribution/Client/BuildReports/Upload.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE CPP, PatternGuards #-} -- This is a quick hack for uploading build reports to Hackage. module Distribution.Client.BuildReports.Upload@@ -51,7 +51,11 @@ } case rspCode response of (3,0,3) | [Just buildId] <- [ do rel <- parseRelativeReference location+#if MIN_VERSION_network(2,4,0)+ return $ relativeTo rel uri+#else relativeTo rel uri+#endif | Header HdrLocation location <- rspHeaders response ] -> return $ buildId _ -> error "Unrecognised response from server."@@ -61,7 +65,7 @@ -> BrowserAction (HandleStream BuildLog) () putBuildLog reportId buildLog = do --FIXME: do something if the request fails- (_, response) <- request Request {+ (_, _response) <- request Request { rqURI = reportId{uriPath = uriPath reportId </> "log"}, rqMethod = PUT, rqHeaders = [Header HdrContentType ("text/plain"),
Distribution/Client/Config.hs view
@@ -36,6 +36,8 @@ , UploadFlags(..), uploadCommand , ReportFlags(..), reportCommand , showRepo, parseRepo )+import Distribution.Client.Utils+ ( numberOfProcessors ) import Distribution.Simple.Compiler ( OptimisationLevel(..) )@@ -93,6 +95,8 @@ ( getEnvironment ) import System.IO.Error ( isDoesNotExistError )+import Distribution.Compat.Exception+ ( catchIO ) -- -- * Configuration saved in the config file@@ -198,7 +202,8 @@ }, savedInstallFlags = mempty { installSummaryFile = [toPathTemplate (logsDir </> "build.log")],- installBuildReports= toFlag AnonymousReports+ installBuildReports= toFlag AnonymousReports,+ installNumJobs = toFlag (Just numberOfProcessors) } } @@ -291,7 +296,7 @@ fmap (Just . parseConfig initial) (readFile file) where- handleNotExists action = catch action $ \ioe ->+ handleNotExists action = catchIO action $ \ioe -> if isDoesNotExistError ioe then return Nothing else ioError ioe
Distribution/Client/Configure.hs view
@@ -82,7 +82,7 @@ configureCommand (const configFlags) extraArgs Right installPlan -> case InstallPlan.ready installPlan of- [pkg@(ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _)) _ _ _)] ->+ [pkg@(ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _) _) _ _ _)] -> configurePackage verbosity (InstallPlan.planPlatform installPlan) (InstallPlan.planCompiler installPlan)@@ -105,7 +105,8 @@ (configDistPref configFlags), useLoggingHandle = Nothing, useWorkingDir = Nothing,- forceExternalSetupMethod = False+ forceExternalSetupMethod = False,+ setupCacheLock = Nothing } where -- Hack: we typically want to allow the UserPackageDB for finding the@@ -137,7 +138,8 @@ localPkg = SourcePackage { packageInfoId = packageId pkg, Source.packageDescription = pkg,- packageSource = LocalUnpackedPackage "."+ packageSource = LocalUnpackedPackage ".",+ packageDescrOverride = Nothing } testsEnabled = fromFlagOrDefault False $ configTests configFlags@@ -193,7 +195,7 @@ -> [String] -> IO () configurePackage verbosity platform comp scriptOptions configFlags- (ConfiguredPackage (SourcePackage _ gpkg _) flags stanzas deps) extraArgs =+ (ConfiguredPackage (SourcePackage _ gpkg _ _) flags stanzas deps) extraArgs = setupWrapper verbosity scriptOptions (Just pkg) configureCommand configureFlags extraArgs
Distribution/Client/Dependency/Modular/IndexConversion.hs view
@@ -12,7 +12,6 @@ import Distribution.Package -- from Cabal import Distribution.PackageDescription as PD -- from Cabal import qualified Distribution.Simple.PackageIndex as SI-import Distribution.Simple.Utils (equating) import Distribution.System import Distribution.Client.Dependency.Modular.Dependency as D@@ -25,9 +24,9 @@ -- | Convert both the installed package index and the source package -- index into one uniform solver index. ----- We use 'allPackagesByName' for the installed package index because--- that returns us several instances of the same package and version--- in order of preference. This allows us in principle to "shadow"+-- We use 'allPackagesBySourcePackageId' for the installed package index+-- because that returns us several instances of the same package and version+-- in order of preference. This allows us in principle to \"shadow\" -- packages if there are several installed packages of the same version. -- There are currently some shortcomings in both GHC and Cabal in -- resolving these situations. However, the right thing to do is to@@ -41,14 +40,14 @@ -- | Convert a Cabal installed package index to the simpler, -- more uniform index format of the solver. convIPI' :: Bool -> SI.PackageIndex -> [(PN, I, PInfo)]-convIPI' sip idx = combine (convIP idx) . versioned . SI.allPackagesByName $ idx- where- -- group installed packages by version- versioned = L.map (groupBy (equating packageVersion))+convIPI' sip idx = -- apply shadowing whenever there are multple installed packages with -- the same version- combine f pkgs = [ g (f p) | pbn <- pkgs, pbv <- pbn,- (g, p) <- zip (id : repeat shadow) pbv ]+ [ maybeShadow (convIP idx pkg)+ | (_pkgid, pkgs) <- SI.allPackagesBySourcePackageId idx+ , (maybeShadow, pkg) <- zip (id : repeat shadow) pkgs ]+ where+ -- shadowing is recorded in the package info shadow (pn, i, PInfo fdeps fds encs _) | sip = (pn, i, PInfo fdeps fds encs (Just Shadowed)) shadow x = x@@ -93,7 +92,7 @@ -- | Convert a single source package into the solver-specific format. convSP :: OS -> Arch -> CompilerId -> SourcePackage -> (PN, I, PInfo)-convSP os arch cid (SourcePackage (PackageIdentifier pn pv) gpd _pl) =+convSP os arch cid (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) = let i = I pv InRepo in (pn, i, convGPD os arch cid (PI pn i) gpd)
Distribution/Client/Dependency/TopDown.hs view
@@ -368,7 +368,7 @@ [ (dep, Constraints.conflicting cs dep) | dep <- missing ] - configure cs (UnconfiguredPackage (SourcePackage _ pkg _) _ flags stanzas) =+ configure cs (UnconfiguredPackage (SourcePackage _ pkg _ _) _ flags stanzas) = finalizePackageDescription flags (dependencySatisfiable cs) platform comp [] (enableStanzas stanzas pkg) dependencySatisfiable cs =@@ -397,7 +397,7 @@ InstalledAndSource ipkg apkg -> fmap (InstalledAndSource ipkg) (configure apkg) where- configure (UnconfiguredPackage apkg@(SourcePackage _ p _) _ flags stanzas) =+ configure (UnconfiguredPackage apkg@(SourcePackage _ p _ _) _ flags stanzas) = case finalizePackageDescription flags dependencySatisfiable platform comp [] (enableStanzas stanzas p) of Left missing -> Left missing@@ -481,7 +481,7 @@ ++ [ ((), packageName pkg, nub deps) | pkgs@(pkg:_) <- PackageIndex.allPackagesByName sourcePkgIndex , let deps = [ depName- | SourcePackage _ pkg' _ <- pkgs+ | SourcePackage _ pkg' _ _ <- pkgs , Dependency depName _ <- buildDepends (flattenPackageDescription pkg') ] ] @@ -517,7 +517,7 @@ | pkg <- moreInstalled , dep <- depends pkg ] ++ [ name- | SourcePackage _ pkg _ <- moreSource+ | SourcePackage _ pkg _ _ <- moreSource , Dependency name _ <- buildDepends (flattenPackageDescription pkg) ] installedPkgIndex'' = foldl' (flip PackageIndex.insert)
Distribution/Client/Haddock.hs view
@@ -22,14 +22,15 @@ import System.Directory (createDirectoryIfMissing, doesFileExist, renameFile) import System.FilePath ((</>), splitFileName)-import Distribution.Package (Package(..))+import Distribution.Package+ ( Package(..), packageVersion ) import Distribution.Simple.Program (haddockProgram, ProgramConfiguration , rawSystemProgram, requireProgramVersion) import Distribution.Version (Version(Version), orLaterVersion) import Distribution.Verbosity (Verbosity) import Distribution.Text (display)-import Distribution.Simple.PackageIndex (PackageIndex, allPackages,- allPackagesByName, fromList)+import Distribution.Simple.PackageIndex+ ( PackageIndex, allPackagesByName ) import Distribution.Simple.Utils ( comparing, intercalate, debug , installDirectoryContents, withTempDirectory )@@ -64,12 +65,10 @@ where (destDir,destFile) = splitFileName index- pkgs' = map (maximumBy $ comparing packageId)- . allPackagesByName- . fromList- . filter exposed- . allPackages- $ pkgs+ pkgs' = [ maximumBy (comparing packageVersion) pkgvers'+ | (_pname, pkgvers) <- allPackagesByName pkgs+ , let pkgvers' = filter exposed pkgvers+ , not (null pkgvers') ] haddockPackagePaths :: [InstalledPackageInfo] -> IO ([(FilePath, FilePath)], Maybe String)
Distribution/Client/HttpUtils.hs view
@@ -18,8 +18,8 @@ import Network.Stream ( Result, ConnError(..) ) import Network.Browser- ( Proxy (..), Authority(..), BrowserAction, browse, setAllowBasicAuth, setAuthorityGen- , setOutHandler, setErrHandler, setProxy, request)+ ( Proxy (..), Authority (..), BrowserAction, browse+ , setOutHandler, setErrHandler, setProxy, setAuthorityGen, request) import Control.Monad ( mplus, join, liftM, liftM2 ) import qualified Data.ByteString.Lazy.Char8 as ByteString@@ -153,10 +153,10 @@ -- |Carry out a GET request, using the local proxy settings getHTTP :: Verbosity -> URI -> IO (Result (Response ByteString)) getHTTP verbosity uri = liftM (\(_, resp) -> Right resp) $- cabalBrowse verbosity Nothing (request (mkRequest uri))+ cabalBrowse verbosity (return ()) (request (mkRequest uri)) cabalBrowse :: Verbosity- -> Maybe (String, String)+ -> BrowserAction s () -> BrowserAction s a -> IO a cabalBrowse verbosity auth act = do@@ -165,8 +165,8 @@ setProxy p setErrHandler (warn verbosity . ("http error: "++)) setOutHandler (debug verbosity)- setAllowBasicAuth False- setAuthorityGen (\_ _ -> return auth)+ auth+ setAuthorityGen (\_ _ -> return Nothing) act downloadURI :: Verbosity
Distribution/Client/IndexUtils.hs view
@@ -51,11 +51,11 @@ import Distribution.Verbosity ( Verbosity, lessVerbose ) import Distribution.Simple.Utils- ( die, warn, info, fromUTF8, equating )+ ( die, warn, info, fromUTF8 ) import Data.Char (isAlphaNum) import Data.Maybe (catMaybes, fromMaybe)-import Data.List (isPrefixOf, groupBy)+import Data.List (isPrefixOf) import Data.Monoid (Monoid(..)) import qualified Data.Map as Map import Control.Monad (MonadPlus(mplus), when, unless, liftM)@@ -71,10 +71,10 @@ import System.IO import System.IO.Unsafe (unsafeInterleaveIO) import System.IO.Error (isDoesNotExistError)+import Distribution.Compat.Exception (catchIO) import System.Directory ( getModificationTime, doesFileExist )-import System.Time- ( getClockTime, diffClockTimes, normalizeTimeDiff, TimeDiff(tdDay) )+import Distribution.Compat.Time getInstalledPackages :: Verbosity -> Compiler@@ -88,15 +88,14 @@ 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 ]+ -- There can be multiple installed instances of each package version,+ -- like when the same package is installed in the global & user dbs.+ -- InstalledPackageIndex.allPackagesBySourcePackageId 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)+ | (_,ipkg:_) <- InstalledPackageIndex.allPackagesBySourcePackageId index' ] where -- The InstalledPackageInfo only lists dependencies by the -- InstalledPackageId, which means we do not directly know the corresponding@@ -170,14 +169,15 @@ readPackageIndexCacheFile mkAvailablePackage indexFile cacheFile where- mkAvailablePackage pkgid pkg =+ mkAvailablePackage pkgid pkgtxt pkg = SourcePackage { packageInfoId = pkgid, packageDescription = pkg,- packageSource = RepoTarballPackage repo pkgid Nothing+ packageSource = RepoTarballPackage repo pkgid Nothing,+ packageDescrOverride = Just pkgtxt } - handleNotFound action = catch action $ \e -> if isDoesNotExistError e+ handleNotFound action = catchIO action $ \e -> if isDoesNotExistError e then do case repoKind repo of Left remoteRepo -> warn verbosity $@@ -191,13 +191,11 @@ 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+ dt <- getFileAge indexFile+ when (dt >= isOldThreshold) $ case repoKind repo of Left remoteRepo -> warn verbosity $ "The package list for '" ++ remoteRepoName remoteRepo- ++ "' is " ++ show (tdDay diff) ++ " days old.\nRun "+ ++ "' is " ++ show dt ++ " days old.\nRun " ++ "'cabal update' to get the latest list of available packages." Right _localRepo -> return () @@ -342,7 +340,8 @@ ++ [ CachePackageId pkgid blockNo | (pkgid, _, blockNo) <- pkgs ] readPackageIndexCacheFile :: Package pkg- => (PackageId -> GenericPackageDescription -> pkg)+ => (PackageId -> ByteString+ -> GenericPackageDescription -> pkg) -> FilePath -> FilePath -> IO (PackageIndex pkg, [Dependency])@@ -353,7 +352,8 @@ packageIndexFromCache :: Package pkg- => (PackageId -> GenericPackageDescription -> pkg)+ => (PackageId -> ByteString+ -> GenericPackageDescription -> pkg) -> Handle -> [IndexCacheEntry] -> IO (PackageIndex pkg, [Dependency])@@ -371,20 +371,22 @@ -- The magic here is that we use lazy IO to read the .cabal file -- from the index tarball if it turns out that we need it. -- Most of the time we only need the package id.- pkg <- unsafeInterleaveIO $ do- getPackageDescription blockno- let srcpkg = mkPkg pkgid pkg+ ~(pkg, pkgtxt) <- unsafeInterleaveIO $ do+ pkgtxt <- getEntryContent blockno+ pkg <- readPackageDescription pkgtxt+ return (pkg, pkgtxt)++ let srcpkg = mkPkg pkgid pkgtxt pkg accum (srcpkg:srcpkgs) prefs entries accum srcpkgs prefs (CachePreference pref : entries) = accum srcpkgs (pref:prefs) entries - getPackageDescription blockno = do+ getEntryContent blockno = do hSeek hnd AbsoluteSeek (fromIntegral (blockno * 512)) header <- BS.hGet hnd 512 size <- getEntrySize header- content <- BS.hGet hnd (fromIntegral size)- readPackageDescription content+ BS.hGet hnd (fromIntegral size) getEntrySize header = case Tar.read header of
Distribution/Client/Init.hs view
@@ -67,7 +67,7 @@ import Distribution.Client.Init.Types ( InitFlags(..), PackageType(..), Category(..) ) import Distribution.Client.Init.Licenses- ( bsd3, gplv2, gplv3, lgpl2, lgpl3 )+ ( bsd3, gplv2, gplv3, lgpl2, lgpl3, apache20 ) import Distribution.Client.Init.Heuristics ( guessPackageName, guessAuthorNameMail, SourceFileEntry(..), scanForModules, neededBuildPrograms ) @@ -178,7 +178,7 @@ return $ flags { license = maybeToFlag lic } where listedLicenses =- knownLicenses \\ [GPL Nothing, LGPL Nothing, OtherLicense]+ knownLicenses \\ [GPL Nothing, LGPL Nothing, Apache Nothing, OtherLicense] -- | The author's name and email. Prompt, or try to guess from an existing -- darcs repo.@@ -494,6 +494,9 @@ Flag (LGPL (Just (Version {versionBranch = [3]}))) -> Just lgpl3++ Flag (Apache (Just (Version {versionBranch = [2, 0]})))+ -> Just apache20 _ -> Nothing
Distribution/Client/Init/Licenses.hs view
@@ -5,6 +5,7 @@ , gplv3 , lgpl2 , lgpl3+ , apache20 ) where @@ -1720,3 +1721,208 @@ , "Library." ] +apache20 :: License+apache20 = unlines+ [ ""+ , " Apache License"+ , " Version 2.0, January 2004"+ , " http://www.apache.org/licenses/"+ , ""+ , " TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION"+ , ""+ , " 1. Definitions."+ , ""+ , " \"License\" shall mean the terms and conditions for use, reproduction,"+ , " and distribution as defined by Sections 1 through 9 of this document."+ , ""+ , " \"Licensor\" shall mean the copyright owner or entity authorized by"+ , " the copyright owner that is granting the License."+ , ""+ , " \"Legal Entity\" shall mean the union of the acting entity and all"+ , " other entities that control, are controlled by, or are under common"+ , " control with that entity. For the purposes of this definition,"+ , " \"control\" means (i) the power, direct or indirect, to cause the"+ , " direction or management of such entity, whether by contract or"+ , " otherwise, or (ii) ownership of fifty percent (50%) or more of the"+ , " outstanding shares, or (iii) beneficial ownership of such entity."+ , ""+ , " \"You\" (or \"Your\") shall mean an individual or Legal Entity"+ , " exercising permissions granted by this License."+ , ""+ , " \"Source\" form shall mean the preferred form for making modifications,"+ , " including but not limited to software source code, documentation"+ , " source, and configuration files."+ , ""+ , " \"Object\" form shall mean any form resulting from mechanical"+ , " transformation or translation of a Source form, including but"+ , " not limited to compiled object code, generated documentation,"+ , " and conversions to other media types."+ , ""+ , " \"Work\" shall mean the work of authorship, whether in Source or"+ , " Object form, made available under the License, as indicated by a"+ , " copyright notice that is included in or attached to the work"+ , " (an example is provided in the Appendix below)."+ , ""+ , " \"Derivative Works\" shall mean any work, whether in Source or Object"+ , " form, that is based on (or derived from) the Work and for which the"+ , " editorial revisions, annotations, elaborations, or other modifications"+ , " represent, as a whole, an original work of authorship. For the purposes"+ , " of this License, Derivative Works shall not include works that remain"+ , " separable from, or merely link (or bind by name) to the interfaces of,"+ , " the Work and Derivative Works thereof."+ , ""+ , " \"Contribution\" shall mean any work of authorship, including"+ , " the original version of the Work and any modifications or additions"+ , " to that Work or Derivative Works thereof, that is intentionally"+ , " submitted to Licensor for inclusion in the Work by the copyright owner"+ , " or by an individual or Legal Entity authorized to submit on behalf of"+ , " the copyright owner. For the purposes of this definition, \"submitted\""+ , " means any form of electronic, verbal, or written communication sent"+ , " to the Licensor or its representatives, including but not limited to"+ , " communication on electronic mailing lists, source code control systems,"+ , " and issue tracking systems that are managed by, or on behalf of, the"+ , " Licensor for the purpose of discussing and improving the Work, but"+ , " excluding communication that is conspicuously marked or otherwise"+ , " designated in writing by the copyright owner as \"Not a Contribution.\""+ , ""+ , " \"Contributor\" shall mean Licensor and any individual or Legal Entity"+ , " on behalf of whom a Contribution has been received by Licensor and"+ , " subsequently incorporated within the Work."+ , ""+ , " 2. Grant of Copyright License. Subject to the terms and conditions of"+ , " this License, each Contributor hereby grants to You a perpetual,"+ , " worldwide, non-exclusive, no-charge, royalty-free, irrevocable"+ , " copyright license to reproduce, prepare Derivative Works of,"+ , " publicly display, publicly perform, sublicense, and distribute the"+ , " Work and such Derivative Works in Source or Object form."+ , ""+ , " 3. Grant of Patent License. Subject to the terms and conditions of"+ , " this License, each Contributor hereby grants to You a perpetual,"+ , " worldwide, non-exclusive, no-charge, royalty-free, irrevocable"+ , " (except as stated in this section) patent license to make, have made,"+ , " use, offer to sell, sell, import, and otherwise transfer the Work,"+ , " where such license applies only to those patent claims licensable"+ , " by such Contributor that are necessarily infringed by their"+ , " Contribution(s) alone or by combination of their Contribution(s)"+ , " with the Work to which such Contribution(s) was submitted. If You"+ , " institute patent litigation against any entity (including a"+ , " cross-claim or counterclaim in a lawsuit) alleging that the Work"+ , " or a Contribution incorporated within the Work constitutes direct"+ , " or contributory patent infringement, then any patent licenses"+ , " granted to You under this License for that Work shall terminate"+ , " as of the date such litigation is filed."+ , ""+ , " 4. Redistribution. You may reproduce and distribute copies of the"+ , " Work or Derivative Works thereof in any medium, with or without"+ , " modifications, and in Source or Object form, provided that You"+ , " meet the following conditions:"+ , ""+ , " (a) You must give any other recipients of the Work or"+ , " Derivative Works a copy of this License; and"+ , ""+ , " (b) You must cause any modified files to carry prominent notices"+ , " stating that You changed the files; and"+ , ""+ , " (c) You must retain, in the Source form of any Derivative Works"+ , " that You distribute, all copyright, patent, trademark, and"+ , " attribution notices from the Source form of the Work,"+ , " excluding those notices that do not pertain to any part of"+ , " the Derivative Works; and"+ , ""+ , " (d) If the Work includes a \"NOTICE\" text file as part of its"+ , " distribution, then any Derivative Works that You distribute must"+ , " include a readable copy of the attribution notices contained"+ , " within such NOTICE file, excluding those notices that do not"+ , " pertain to any part of the Derivative Works, in at least one"+ , " of the following places: within a NOTICE text file distributed"+ , " as part of the Derivative Works; within the Source form or"+ , " documentation, if provided along with the Derivative Works; or,"+ , " within a display generated by the Derivative Works, if and"+ , " wherever such third-party notices normally appear. The contents"+ , " of the NOTICE file are for informational purposes only and"+ , " do not modify the License. You may add Your own attribution"+ , " notices within Derivative Works that You distribute, alongside"+ , " or as an addendum to the NOTICE text from the Work, provided"+ , " that such additional attribution notices cannot be construed"+ , " as modifying the License."+ , ""+ , " You may add Your own copyright statement to Your modifications and"+ , " may provide additional or different license terms and conditions"+ , " for use, reproduction, or distribution of Your modifications, or"+ , " for any such Derivative Works as a whole, provided Your use,"+ , " reproduction, and distribution of the Work otherwise complies with"+ , " the conditions stated in this License."+ , ""+ , " 5. Submission of Contributions. Unless You explicitly state otherwise,"+ , " any Contribution intentionally submitted for inclusion in the Work"+ , " by You to the Licensor shall be under the terms and conditions of"+ , " this License, without any additional terms or conditions."+ , " Notwithstanding the above, nothing herein shall supersede or modify"+ , " the terms of any separate license agreement you may have executed"+ , " with Licensor regarding such Contributions."+ , ""+ , " 6. Trademarks. This License does not grant permission to use the trade"+ , " names, trademarks, service marks, or product names of the Licensor,"+ , " except as required for reasonable and customary use in describing the"+ , " origin of the Work and reproducing the content of the NOTICE file."+ , ""+ , " 7. Disclaimer of Warranty. Unless required by applicable law or"+ , " agreed to in writing, Licensor provides the Work (and each"+ , " Contributor provides its Contributions) on an \"AS IS\" BASIS,"+ , " WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or"+ , " implied, including, without limitation, any warranties or conditions"+ , " of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A"+ , " PARTICULAR PURPOSE. You are solely responsible for determining the"+ , " appropriateness of using or redistributing the Work and assume any"+ , " risks associated with Your exercise of permissions under this License."+ , ""+ , " 8. Limitation of Liability. In no event and under no legal theory,"+ , " whether in tort (including negligence), contract, or otherwise,"+ , " unless required by applicable law (such as deliberate and grossly"+ , " negligent acts) or agreed to in writing, shall any Contributor be"+ , " liable to You for damages, including any direct, indirect, special,"+ , " incidental, or consequential damages of any character arising as a"+ , " result of this License or out of the use or inability to use the"+ , " Work (including but not limited to damages for loss of goodwill,"+ , " work stoppage, computer failure or malfunction, or any and all"+ , " other commercial damages or losses), even if such Contributor"+ , " has been advised of the possibility of such damages."+ , ""+ , " 9. Accepting Warranty or Additional Liability. While redistributing"+ , " the Work or Derivative Works thereof, You may choose to offer,"+ , " and charge a fee for, acceptance of support, warranty, indemnity,"+ , " or other liability obligations and/or rights consistent with this"+ , " License. However, in accepting such obligations, You may act only"+ , " on Your own behalf and on Your sole responsibility, not on behalf"+ , " of any other Contributor, and only if You agree to indemnify,"+ , " defend, and hold each Contributor harmless for any liability"+ , " incurred by, or claims asserted against, such Contributor by reason"+ , " of your accepting any such warranty or additional liability."+ , ""+ , " END OF TERMS AND CONDITIONS"+ , ""+ , " APPENDIX: How to apply the Apache License to your work."+ , ""+ , " To apply the Apache License to your work, attach the following"+ , " boilerplate notice, with the fields enclosed by brackets \"[]\""+ , " replaced with your own identifying information. (Don't include"+ , " the brackets!) The text should be enclosed in the appropriate"+ , " comment syntax for the file format. We also recommend that a"+ , " file or class name and description of purpose be included on the"+ , " same \"printed page\" as the copyright notice for easier"+ , " identification within third-party archives."+ , ""+ , " Copyright [yyyy] [name of copyright owner]"+ , ""+ , " Licensed under the Apache License, Version 2.0 (the \"License\");"+ , " you may not use this file except in compliance with the License."+ , " You may obtain a copy of the License at"+ , ""+ , " http://www.apache.org/licenses/LICENSE-2.0"+ , ""+ , " Unless required by applicable law or agreed to in writing, software"+ , " distributed under the License is distributed on an \"AS IS\" BASIS,"+ , " WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied."+ , " See the License for the specific language governing permissions and"+ , " limitations under the License."+ ]
Distribution/Client/Install.hs view
@@ -22,8 +22,10 @@ ( unfoldr, nub, sort, (\\) ) import Data.Maybe ( isJust, fromMaybe, maybeToList )+import qualified Data.ByteString.Lazy.Char8 as BS+ ( unpack ) import Control.Exception as Exception- ( handleJust )+ ( bracket, handleJust ) #if MIN_VERSION_base(4,0,0) import Control.Exception as Exception ( Exception(toException), catches, Handler(Handler), IOException )@@ -42,7 +44,7 @@ import System.FilePath ( (</>), (<.>), takeDirectory ) import System.IO- ( openFile, IOMode(AppendMode), stdout, hFlush )+ ( openFile, IOMode(AppendMode), stdout, hFlush, hClose ) import System.IO.Error ( isDoesNotExistError, ioeGetFileName ) @@ -93,9 +95,9 @@ , toFlag, fromFlag, fromFlagOrDefault, flagToMaybe ) import qualified Distribution.Simple.Setup as Cabal ( installCommand, InstallFlags(..), emptyInstallFlags- , emptyTestFlags, testCommand )+ , emptyTestFlags, testCommand, Flag(..) ) import Distribution.Simple.Utils- ( rawSystemExit, comparing )+ ( rawSystemExit, comparing, writeFileAtomic ) import Distribution.Simple.InstallDirs as InstallDirs ( PathTemplate, fromPathTemplate, toPathTemplate, substPathTemplate , initialPathTemplateEnv, installDirsTemplateEnv )@@ -114,7 +116,7 @@ import Distribution.Simple.Utils as Utils ( notice, info, warn, die, intercalate, withTempDirectory ) import Distribution.Client.Utils- ( inDir, mergeBy, MergeResult(..) )+ ( numberOfProcessors, inDir, mergeBy, MergeResult(..) ) import Distribution.System ( Platform, buildPlatform, OS(Windows), buildOS ) import Distribution.Text@@ -732,6 +734,10 @@ libVersion :: Maybe Version } +-- | If logging is enabled, contains location of the log file and the verbosity+-- level for logging.+type UseLogFile = Maybe (PackageIdentifier -> FilePath, Verbosity)+ performInstallations :: Verbosity -> InstallContext -> PackageIndex@@ -746,27 +752,31 @@ else newSerialJobControl buildLimit <- newJobLimit numJobs fetchLimit <- newJobLimit (min numJobs numFetchJobs)- installLimit <- newJobLimit 1 --serialise installation+ installLock <- newLock -- serialise installation+ cacheLock <- newLock -- serialise access to setup exe cache - executeInstallPlan verbosity jobControl installPlan $ \cpkg ->+ executeInstallPlan verbosity jobControl useLogFile installPlan $ \cpkg -> installConfiguredPackage platform compid configFlags- cpkg $ \configFlags' src pkg ->+ cpkg $ \configFlags' src pkg pkgoverride -> fetchSourcePackage verbosity fetchLimit src $ \src' -> installLocalPackage verbosity buildLimit (packageId pkg) src' $ \mpath ->- installUnpackedPackage verbosity buildLimit installLimit- (setupScriptOptions installedPkgIndex)+ installUnpackedPackage verbosity buildLimit installLock numJobs+ (setupScriptOptions installedPkgIndex cacheLock) miscOptions configFlags' installFlags haddockFlags- compid pkg mpath useLogFile+ compid pkg pkgoverride mpath useLogFile where platform = InstallPlan.planPlatform installPlan compid = InstallPlan.planCompiler installPlan - numJobs = fromFlag (installNumJobs installFlags)+ numJobs = case installNumJobs installFlags of+ Cabal.NoFlag -> 1+ Cabal.Flag Nothing -> numberOfProcessors+ Cabal.Flag (Just n) -> n numFetchJobs = 2 parallelBuild = numJobs >= 2 - setupScriptOptions index = SetupScriptOptions {+ setupScriptOptions index lock = SetupScriptOptions { useCabalVersion = maybe anyVersion thisVersion (libVersion miscOptions), useCompiler = Just comp, -- Hack: we typically want to allow the UserPackageDB for finding the@@ -787,25 +797,55 @@ (configDistPref configFlags), useLoggingHandle = Nothing, useWorkingDir = Nothing,- forceExternalSetupMethod = parallelBuild+ forceExternalSetupMethod = parallelBuild,+ setupCacheLock = Just lock } reportingLevel = fromFlag (installBuildReports installFlags) logsDir = fromFlag (globalLogsDir globalFlags)- useLogFile :: Maybe (PackageIdentifier -> FilePath)- useLogFile = fmap substLogFileName logFileTemplate++ -- Should the build output be written to a log file instead of stdout?+ useLogFile :: UseLogFile+ useLogFile = fmap ((\f -> (f, loggingVerbosity)) . substLogFileName)+ logFileTemplate where+ installLogFile' = flagToMaybe $ installLogFile installFlags+ defaultTemplate = toPathTemplate $ logsDir </> "$pkgid" <.> "log"++ -- If the user has specified --remote-build-reporting=detailed, use the+ -- default log file location. If the --build-log option is set, use the+ -- provided location. Otherwise don't use logging, unless building in+ -- parallel (in which case the default location is used). logFileTemplate :: Maybe PathTemplate- logFileTemplate --TODO: separate policy from mechanism- | reportingLevel == DetailedReports- = Just $ toPathTemplate $ logsDir </> "$pkgid" <.> "log"- | otherwise- = flagToMaybe (installLogFile installFlags)+ logFileTemplate+ | useDefaultTemplate = Just defaultTemplate+ | otherwise = installLogFile' + -- If the user has specified --remote-build-reporting=detailed or+ -- --build-log, use more verbose logging.+ loggingVerbosity :: Verbosity+ loggingVerbosity | overrideVerbosity = max Verbosity.verbose verbosity+ | otherwise = verbosity++ useDefaultTemplate :: Bool+ useDefaultTemplate+ | reportingLevel == DetailedReports = True+ | isJust installLogFile' = False+ | parallelBuild = True+ | otherwise = False++ overrideVerbosity :: Bool+ overrideVerbosity+ | reportingLevel == DetailedReports = True+ | isJust installLogFile' = True+ | parallelBuild = False+ | otherwise = False+ substLogFileName :: PathTemplate -> PackageIdentifier -> FilePath 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.@@ -816,10 +856,11 @@ executeInstallPlan :: Verbosity -> JobControl IO (PackageId, BuildResult)+ -> UseLogFile -> InstallPlan -> (ConfiguredPackage -> IO BuildResult) -> IO InstallPlan-executeInstallPlan verbosity jobCtl plan0 installPkg =+executeInstallPlan verbosity jobCtl useLogFile plan0 installPkg = tryNewTasks 0 plan0 where tryNewTasks taskCount plan = do@@ -828,7 +869,7 @@ | otherwise -> waitForTasks taskCount plan pkgs -> do sequence_- [ do notice verbosity $ "Ready to install " ++ display pkgid+ [ do info verbosity $ "Ready to install " ++ display pkgid spawnJob jobCtl $ do buildResult <- installPkg pkg return (packageId pkg, buildResult)@@ -840,13 +881,14 @@ waitForTasks taskCount' plan' waitForTasks taskCount plan = do- notice verbosity $ "Waiting for install task to finish..."+ info verbosity $ "Waiting for install task to finish..." (pkgid, buildResult) <- collectJob jobCtl- notice verbosity $ "Collecting build result for " ++ display pkgid+ printBuildResult pkgid buildResult let taskCount' = taskCount-1 plan' = updatePlan pkgid buildResult plan tryNewTasks taskCount' plan' + updatePlan :: PackageIdentifier -> BuildResult -> InstallPlan -> InstallPlan updatePlan pkgid (Right buildSuccess) = InstallPlan.completed pkgid buildSuccess @@ -859,7 +901,28 @@ -- now cannot build, we mark as failing due to 'DependentFailed' -- which kind of means it was not their fault. + -- Print last 10 lines of the build log if something went wrong, and+ -- 'Installed $PKGID' otherwise.+ printBuildResult :: PackageId -> BuildResult -> IO ()+ printBuildResult pkgid buildResult = case buildResult of+ (Right _) -> notice verbosity $ "Installed " ++ display pkgid+ (Left _) -> do+ notice verbosity $ "Failed to install " ++ display pkgid+ case useLogFile of+ Nothing -> return ()+ Just (mkLogFileName, _) -> do+ let (logName, n) = (mkLogFileName pkgid, 10)+ notice verbosity $ "Last " ++ (show n)+ ++ " lines of the build log ( " ++ logName ++ " ):"+ printLastNLines logName n + printLastNLines :: FilePath -> Int -> IO ()+ printLastNLines path n = do+ lns <- fmap lines $ readFile path+ let len = length lns+ let toDrop = if len > n && n > 0 then (len - n) else 0+ mapM_ (notice verbosity) (drop toDrop lns)+ -- | Call an installer for an 'SourcePackage' but override the configure -- flags with the ones given by the 'ConfiguredPackage'. In particular the -- 'ConfiguredPackage' specifies an exact 'FlagAssignment' and exactly@@ -869,16 +932,17 @@ installConfiguredPackage :: Platform -> CompilerId -> ConfigFlags -> ConfiguredPackage -> (ConfigFlags -> PackageLocation (Maybe FilePath)- -> PackageDescription -> a)+ -> PackageDescription+ -> PackageDescriptionOverride -> a) -> a installConfiguredPackage platform comp configFlags- (ConfiguredPackage (SourcePackage _ gpkg source) flags stanzas deps)+ (ConfiguredPackage (SourcePackage _ gpkg source pkgoverride) flags stanzas deps) installPkg = installPkg configFlags { configConfigurationsFlags = flags, configConstraints = map thisPackageVersion deps, configBenchmarks = toFlag False, configTests = toFlag (TestStanzas `elem` stanzas)- } source pkg+ } source pkg pkgoverride where pkg = case finalizePackageDescription flags (const True)@@ -955,7 +1019,8 @@ installUnpackedPackage :: Verbosity -> JobLimit- -> JobLimit+ -> Lock+ -> Int -> SetupScriptOptions -> InstallMisc -> ConfigFlags@@ -963,20 +1028,36 @@ -> HaddockFlags -> CompilerId -> PackageDescription+ -> PackageDescriptionOverride -> Maybe FilePath -- ^ Directory to change to before starting the installation.- -> Maybe (PackageIdentifier -> FilePath) -- ^ File to log output to (if any)+ -> UseLogFile -- ^ File to log output to (if any) -> IO BuildResult-installUnpackedPackage verbosity buildLimit installLimit+installUnpackedPackage verbosity buildLimit installLock numJobs scriptOptions miscOptions configFlags installConfigFlags haddockFlags- compid pkg workingDir useLogFile =+ compid pkg pkgoverride workingDir useLogFile = do + -- Override the .cabal file if necessary+ case pkgoverride of+ Nothing -> return ()+ Just pkgtxt -> do+ let descFilePath = fromMaybe "." workingDir+ </> display (packageName pkgid) <.> "cabal"+ info verbosity $+ "Updating " ++ display (packageName pkgid) <.> "cabal"+ ++ " with the latest revision from the index."+ writeFileAtomic descFilePath (BS.unpack pkgtxt)+ -- Configure phase onFailure ConfigureFailed $ withJobLimit buildLimit $ do+ when (numJobs > 1) $ notice verbosity $+ "Configuring " ++ display pkgid ++ "..." setup configureCommand configureFlags -- Build phase onFailure BuildFailed $ do+ when (numJobs > 1) $ notice verbosity $+ "Building " ++ display pkgid ++ "..." setup buildCommand' buildFlags -- Doc generation phase@@ -996,7 +1077,7 @@ | otherwise = TestsNotTried -- Install phase- onFailure InstallFailed $ withJobLimit installLimit $+ onFailure InstallFailed $ criticalSection installLock $ withWin32SelfUpgrade verbosity configFlags compid pkg $ do case rootCmd miscOptions of (Just cmd) -> reexec cmd@@ -1004,6 +1085,7 @@ return (Right (BuildOk docsResult testsResult)) where+ pkgid = packageId pkg configureFlags = filterConfigureFlags configFlags { configVerbosity = toFlag verbosity' }@@ -1022,23 +1104,27 @@ 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)+ verbosity' = maybe verbosity snd useLogFile - setupWrapper verbosity- scriptOptions { useLoggingHandle = logFileHandle- , useWorkingDir = workingDir }- (Just pkg)- cmd flags []+ setup cmd flags = do+ Exception.bracket+ (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))+ (\mHandle -> case mHandle of+ Just handle -> hClose handle+ Nothing -> return ())+ (\logFileHandle ->+ 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:
Distribution/Client/InstallSymlink.hs view
@@ -67,9 +67,10 @@ import System.FilePath ( (</>), splitPath, joinPath, isAbsolute ) -import Prelude hiding (catch, ioError)+import Prelude hiding (ioError) import System.IO.Error- ( catch, isDoesNotExistError, ioError )+ ( isDoesNotExistError, ioError )+import Distribution.Compat.Exception ( catchIO ) import Control.Exception ( assert ) import Data.Maybe@@ -132,7 +133,7 @@ , PackageDescription.buildable (PackageDescription.buildInfo exe) ] pkgDescription :: ConfiguredPackage -> PackageDescription- pkgDescription (ConfiguredPackage (SourcePackage _ pkg _) flags stanzas _) =+ pkgDescription (ConfiguredPackage (SourcePackage _ pkg _ _) flags stanzas _) = case finalizePackageDescription flags (const True) platform compilerId [] (enableStanzas stanzas pkg) of@@ -209,7 +210,7 @@ else return NotOurFile where- handleNotExist action = catch action $ \ioexception ->+ handleNotExist action = catchIO action $ \ioexception -> -- If the target doesn't exist then there's no problem overwriting it! if isDoesNotExistError ioexception then return NotExists
Distribution/Client/JobControl.hs view
@@ -20,14 +20,16 @@ JobLimit, newJobLimit, withJobLimit,++ Lock,+ newLock,+ criticalSection ) where import Control.Monad import Control.Concurrent import Control.Exception-import Prelude hiding (catch) - data JobControl m a = JobControl { spawnJob :: m a -> m (), collectJob :: m a@@ -77,3 +79,11 @@ withJobLimit :: JobLimit -> IO a -> IO a withJobLimit (JobLimit sem) = bracket_ (waitQSem sem) (signalQSem sem)++newtype Lock = Lock (MVar ())++newLock :: IO Lock+newLock = fmap Lock $ newMVar ()++criticalSection :: Lock -> IO a -> IO a+criticalSection (Lock lck) act = bracket_ (takeMVar lck) (putMVar lck ()) act
Distribution/Client/Setup.hs view
@@ -475,13 +475,15 @@ data UnpackFlags = UnpackFlags { unpackDestDir :: Flag FilePath,- unpackVerbosity :: Flag Verbosity+ unpackVerbosity :: Flag Verbosity,+ unpackPristine :: Flag Bool } defaultUnpackFlags :: UnpackFlags defaultUnpackFlags = UnpackFlags { unpackDestDir = mempty,- unpackVerbosity = toFlag normal+ unpackVerbosity = toFlag normal,+ unpackPristine = toFlag False } unpackCommand :: CommandUI UnpackFlags@@ -498,14 +500,21 @@ "where to unpack the packages, defaults to the current directory." unpackDestDir (\v flags -> flags { unpackDestDir = v }) (reqArgFlag "PATH")++ , option [] ["pristine"]+ ("Unpack the original pristine tarball, rather than updating the "+ ++ ".cabal file with the latest revision from the package archive.")+ unpackPristine (\v flags -> flags { unpackPristine = v })+ trueArg ] } instance Monoid UnpackFlags where mempty = defaultUnpackFlags mappend a b = UnpackFlags {- unpackDestDir = combine unpackDestDir- ,unpackVerbosity = combine unpackVerbosity+ unpackDestDir = combine unpackDestDir,+ unpackVerbosity = combine unpackVerbosity,+ unpackPristine = combine unpackPristine } where combine field = field a `mappend` field b @@ -616,7 +625,7 @@ installBuildReports :: Flag ReportLevel, installSymlinkBinDir :: Flag FilePath, installOneShot :: Flag Bool,- installNumJobs :: Flag Int+ installNumJobs :: Flag (Maybe Int) } defaultInstallFlags :: InstallFlags@@ -640,7 +649,7 @@ installBuildReports = Flag NoReports, installSymlinkBinDir = mempty, installOneShot = Flag False,- installNumJobs = Flag 1+ installNumJobs = mempty } where docIndexFile = toPathTemplate ("$datadir" </> "doc" </> "index.html")@@ -792,9 +801,11 @@ , option "j" ["jobs"] "Run NUM jobs simultaneously." installNumJobs (\v flags -> flags { installNumJobs = v })- (reqArg "NUM" (readP_to_E (\_ -> "jobs should be a number")- (fmap toFlag (Parse.readS_to_P reads)))- (map show . flagToList))+ (optArg "NUM" (readP_to_E (\_ -> "jobs should be a number")+ (fmap (toFlag . Just)+ (Parse.readS_to_P reads)))+ (Flag Nothing)+ (map (fmap show) . flagToList)) ] ++ case showOrParseArgs of -- TODO: remove when "cabal install" avoids ParseArgs -> option [] ["only"]
Distribution/Client/SetupWrapper.hs view
@@ -20,9 +20,6 @@ defaultSetupScriptOptions, ) where -import Distribution.Client.Types- ( InstalledPackage )- import qualified Distribution.Make as Make import qualified Distribution.Simple as Simple import Distribution.Version@@ -41,10 +38,11 @@ import Distribution.Simple.Configure ( configCompiler ) import Distribution.Simple.Compiler- ( CompilerFlavor(GHC), Compiler, PackageDB(..), PackageDBStack )+ ( CompilerFlavor(GHC), Compiler, compilerVersion, showCompilerId+ , PackageDB(..), PackageDBStack ) import Distribution.Simple.Program ( ProgramConfiguration, emptyProgramConfiguration- , rawSystemProgramConf, ghcProgram )+ , getDbProgramOutput, runDbProgram, ghcProgram ) import Distribution.Simple.BuildPaths ( defaultDistPref, exeExtension ) import Distribution.Simple.Command@@ -53,21 +51,28 @@ ( ghcVerbosityOptions ) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.PackageIndex (PackageIndex)+import Distribution.Client.Config+ ( defaultCabalDir ) import Distribution.Client.IndexUtils ( getInstalledPackages )+import Distribution.Client.JobControl+ ( Lock, criticalSection ) import Distribution.Simple.Utils ( die, debug, info, cabalVersion, findPackageDesc, comparing- , createDirectoryIfMissingVerbose, rewriteFile, intercalate )+ , createDirectoryIfMissingVerbose, installExecutableFile+ , rewriteFile, intercalate ) import Distribution.Client.Utils ( moreRecentFile, inDir ) import Distribution.Text ( display ) import Distribution.Verbosity ( Verbosity )+import Distribution.Compat.Exception+ ( catchIO ) -import System.Directory ( doesFileExist, getCurrentDirectory )+import System.Directory ( doesFileExist ) import System.FilePath ( (</>), (<.>) )-import System.IO ( Handle )+import System.IO ( Handle, hPutStr ) import System.Exit ( ExitCode(..), exitWith ) import System.Process ( runProcess, waitForProcess ) import Control.Monad ( when, unless )@@ -84,7 +89,11 @@ useDistPref :: FilePath, useLoggingHandle :: Maybe Handle, useWorkingDir :: Maybe FilePath,- forceExternalSetupMethod :: Bool+ forceExternalSetupMethod :: Bool,++ -- Used only when calling setupWrapper from parallel code to serialise+ -- access to the setup cache; should be Nothing otherwise.+ setupCacheLock :: Maybe Lock } defaultSetupScriptOptions :: SetupScriptOptions@@ -97,7 +106,8 @@ useDistPref = defaultDistPref, useLoggingHandle = Nothing, useWorkingDir = Nothing,- forceExternalSetupMethod = False+ forceExternalSetupMethod = False,+ setupCacheLock = Nothing } setupWrapper :: Verbosity@@ -182,8 +192,10 @@ debug verbosity $ "Using Cabal library version " ++ display cabalLibVersion setupHs <- updateSetupScript cabalLibVersion bt debug verbosity $ "Using " ++ setupHs ++ " as setup script."- compileSetupExecutable options' cabalLibVersion setupHs- invokeSetupScript (mkargs cabalLibVersion)+ path <- case bt of+ Simple -> getCachedSetupExecutable options' cabalLibVersion setupHs+ _ -> compileSetupExecutable options' cabalLibVersion setupHs+ invokeSetupScript path (mkargs cabalLibVersion) where workingDir = case fromMaybe "" (useWorkingDir options) of@@ -191,7 +203,6 @@ dir -> dir setupDir = workingDir </> useDistPref options </> "setup" setupVersionFile = setupDir </> "setup" <.> "version"- setupProgFile = setupDir </> "setup" <.> exeExtension cabalLibVersionToUse :: IO (Version, SetupScriptOptions) cabalLibVersionToUse = do@@ -205,7 +216,7 @@ return (version, options') savedCabalVersion = do- versionString <- readFile setupVersionFile `catch` \_ -> return ""+ versionString <- readFile setupVersionFile `catchIO` \_ -> return "" case reads versionString of [(version,s)] | all isSpace s -> return (Just version) _ -> return Nothing@@ -279,51 +290,99 @@ Custom -> error "buildTypeScript Custom" UnknownBuildType _ -> error "buildTypeScript UnknownBuildType" + -- | Look up the setup executable in the cache; update the cache if the setup+ -- executable is not found.+ getCachedSetupExecutable :: SetupScriptOptions -> Version -> FilePath+ -> IO FilePath+ getCachedSetupExecutable options' cabalLibVersion setupHsFile = do+ cabalDir <- defaultCabalDir+ let setupCacheDir = cabalDir </> "setup-exe-cache"+ let setupProgFile = setupCacheDir+ </> ("setup-" ++ cabalVersionString ++ "-"+ ++ compilerVersionString)+ <.> exeExtension+ setupProgFileExists <- doesFileExist setupProgFile+ if setupProgFileExists+ then debug verbosity $+ "Found cached setup executable: " ++ setupProgFile+ else criticalSection' $ do+ -- The cache may have been populated while we were waiting.+ setupProgFileExists' <- doesFileExist setupProgFile+ if setupProgFileExists'+ then debug verbosity $+ "Found cached setup executable: " ++ setupProgFile+ else do+ debug verbosity $ "Setup executable not found in the cache."+ src <- compileSetupExecutable options' cabalLibVersion setupHsFile+ createDirectoryIfMissingVerbose verbosity True setupCacheDir+ installExecutableFile verbosity src setupProgFile+ return setupProgFile+ where+ cabalVersionString = "Cabal-" ++ (display cabalLibVersion)+ compilerVersionString = fromMaybe "nonexisting-compiler"+ (showCompilerId `fmap` useCompiler options')+ criticalSection' = fromMaybe id+ (fmap criticalSection $ setupCacheLock options')+ -- | If the Setup.hs is out of date wrt the executable then recompile it. -- Currently this is GHC only. It should really be generalised. --- compileSetupExecutable :: SetupScriptOptions -> Version -> FilePath -> IO ()+ compileSetupExecutable :: SetupScriptOptions -> Version -> FilePath+ -> IO FilePath compileSetupExecutable options' cabalLibVersion setupHsFile = do setupHsNewer <- setupHsFile `moreRecentFile` setupProgFile cabalVersionNewer <- setupVersionFile `moreRecentFile` setupProgFile let outOfDate = setupHsNewer || cabalVersionNewer when outOfDate $ do debug verbosity "Setup script is out of date, compiling..."- (_, conf, _) <- configureCompiler options'+ (compiler, conf, _) <- configureCompiler options' --TODO: get Cabal's GHC module to export a GhcOptions type and render func- rawSystemProgramConf verbosity ghcProgram conf $- ghcVerbosityOptions verbosity- ++ ["--make", setupHsFile, "-o", setupProgFile- ,"-odir", setupDir, "-hidir", setupDir- ,"-i", "-i" ++ workingDir ]- ++ ghcPackageDbOptions (usePackageDB options')- ++ if packageName pkg == PackageName "Cabal"- then []- else ["-package", display cabalPkgid]+ let ghcCmdLine =+ ghcVerbosityOptions verbosity+ ++ ["--make", setupHsFile, "-o", setupProgFile+ ,"-odir", setupDir, "-hidir", setupDir+ ,"-i", "-i" ++ workingDir ]+ ++ ghcPackageDbOptions compiler (usePackageDB options')+ ++ if packageName pkg == PackageName "Cabal"+ then []+ else ["-package", display cabalPkgid]+ case useLoggingHandle options of+ Nothing -> runDbProgram verbosity ghcProgram conf ghcCmdLine++ -- If build logging is enabled, redirect compiler output to the log file.+ (Just logHandle) -> do output <- getDbProgramOutput verbosity ghcProgram+ conf ghcCmdLine+ hPutStr logHandle output+ return setupProgFile where- cabalPkgid = PackageIdentifier (PackageName "Cabal") cabalLibVersion+ setupProgFile = setupDir </> "setup" <.> exeExtension+ cabalPkgid = PackageIdentifier (PackageName "Cabal") cabalLibVersion - ghcPackageDbOptions :: PackageDBStack -> [String]- ghcPackageDbOptions dbstack = case dbstack of+ ghcPackageDbOptions :: Compiler -> PackageDBStack -> [String]+ ghcPackageDbOptions compiler dbstack = case dbstack of (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs- (GlobalPackageDB:dbs) -> "-no-user-package-conf"+ (GlobalPackageDB:dbs) -> ("-no-user-" ++ packageDbFlag) : concatMap specific dbs _ -> ierror where- specific (SpecificPackageDB db) = [ "-package-conf", db ]+ specific (SpecificPackageDB db) = [ '-':packageDbFlag, db ] specific _ = ierror ierror = error "internal error: unexpected package db stack" + packageDbFlag+ | compilerVersion compiler < Version [7,5] []+ = "package-conf"+ | otherwise+ = "package-db" - invokeSetupScript :: [String] -> IO ()- invokeSetupScript args = do- info verbosity $ unwords (setupProgFile : args)+ invokeSetupScript :: FilePath -> [String] -> IO ()+ invokeSetupScript path args = do+ info verbosity $ unwords (path : args) case useLoggingHandle options of Nothing -> return () Just logHandle -> info verbosity $ "Redirecting build log to " ++ show logHandle- currentDir <- getCurrentDirectory- process <- runProcess (currentDir </> setupProgFile) args+ process <- runProcess path args (useWorkingDir options) Nothing Nothing (useLoggingHandle options) (useLoggingHandle options) exitCode <- waitForProcess process
Distribution/Client/Tar.hs view
@@ -87,8 +87,7 @@ ( setFileExecutable ) import System.Posix.Types ( FileMode )-import System.Time- ( ClockTime(..) )+import Distribution.Compat.Time import System.IO ( IOMode(ReadMode), openBinaryFile, hFileSize ) import System.IO.Unsafe (unsafeInterleaveIO)@@ -119,8 +118,6 @@ -- type FileSize = Int64--- | The number of seconds since the UNIX epoch-type EpochTime = Int64 type DevMajor = Int type DevMinor = Int type TypeCode = Char@@ -896,8 +893,3 @@ ignore ['.'] = True ignore ['.', '.'] = True ignore _ = False--getModTime :: FilePath -> IO EpochTime-getModTime path = do- (TOD s _) <- getModificationTime path- return $! fromIntegral s
Distribution/Client/Targets.hs view
@@ -472,9 +472,10 @@ pkg <- readPackageDescription verbosity =<< findPackageDesc dir return $ PackageTargetLocation $ SourcePackage {- packageInfoId = packageId pkg,- packageDescription = pkg,- packageSource = fmap Just location+ packageInfoId = packageId pkg,+ packageDescription = pkg,+ packageSource = fmap Just location,+ packageDescrOverride = Nothing } LocalTarballPackage tarballFile ->@@ -497,9 +498,10 @@ Just pkg -> return $ PackageTargetLocation $ SourcePackage {- packageInfoId = packageId pkg,- packageDescription = pkg,- packageSource = fmap Just location+ packageInfoId = packageId pkg,+ packageDescription = pkg,+ packageSource = fmap Just location,+ packageDescrOverride = Nothing } extractTarballPackageCabalFile :: FilePath -> String
Distribution/Client/Types.hs view
@@ -29,6 +29,7 @@ import Data.Map (Map) import Network.URI (URI)+import Data.ByteString.Lazy (ByteString) import Distribution.Compat.Exception ( SomeException ) @@ -94,11 +95,16 @@ -- | A package description along with the location of the package sources. -- data SourcePackage = SourcePackage {- packageInfoId :: PackageId,- packageDescription :: GenericPackageDescription,- packageSource :: PackageLocation (Maybe FilePath)+ packageInfoId :: PackageId,+ packageDescription :: GenericPackageDescription,+ packageSource :: PackageLocation (Maybe FilePath),+ packageDescrOverride :: PackageDescriptionOverride } deriving Show++-- | We sometimes need to override the .cabal file in the tarball with+-- the newer one from the package index.+type PackageDescriptionOverride = Maybe ByteString instance Package SourcePackage where packageId = packageInfoId
Distribution/Client/Unpack.hs view
@@ -19,11 +19,11 @@ ) where import Distribution.Package- ( PackageId, packageId )+ ( PackageId, packageId, packageName ) import Distribution.Simple.Setup ( fromFlag, fromFlagOrDefault ) import Distribution.Simple.Utils- ( notice, die )+ ( notice, die, info, writeFileAtomic ) import Distribution.Verbosity ( Verbosity ) import Distribution.Text(display)@@ -45,8 +45,9 @@ import Data.Monoid ( mempty ) import System.FilePath- ( (</>), addTrailingPathSeparator )-+ ( (</>), (<.>), addTrailingPathSeparator )+import qualified Data.ByteString.Lazy.Char8 as BS+ ( unpack ) unpack :: Verbosity -> [Repo]@@ -77,15 +78,17 @@ flip mapM_ pkgs $ \pkg -> do location <- fetchPackage verbosity (packageSource pkg) let pkgid = packageId pkg+ descOverride | usePristine = Nothing+ | otherwise = packageDescrOverride pkg case location of LocalTarballPackage tarballPath ->- unpackPackage verbosity prefix pkgid tarballPath+ unpackPackage verbosity prefix pkgid descOverride tarballPath RemoteTarballPackage _tarballURL tarballPath ->- unpackPackage verbosity prefix pkgid tarballPath+ unpackPackage verbosity prefix pkgid descOverride tarballPath RepoTarballPackage _repo _pkgid tarballPath ->- unpackPackage verbosity prefix pkgid tarballPath+ unpackPackage verbosity prefix pkgid descOverride tarballPath LocalUnpackedPackage _ -> error "Distribution.Client.Unpack.unpack: the impossible happened."@@ -97,6 +100,7 @@ standardInstallPolicy mempty sourcePkgDb pkgSpecifiers prefix = fromFlagOrDefault "" (unpackDestDir unpackFlags)+ usePristine = fromFlagOrDefault False (unpackPristine unpackFlags) checkTarget :: UserTarget -> IO () checkTarget target = case target of@@ -108,8 +112,10 @@ "The 'unpack' command is for tarball packages. " ++ "The target '" ++ t ++ "' is not a tarball." -unpackPackage :: Verbosity -> FilePath -> PackageId -> FilePath -> IO ()-unpackPackage verbosity prefix pkgid pkgPath = do+unpackPackage :: Verbosity -> FilePath -> PackageId+ -> PackageDescriptionOverride+ -> FilePath -> IO ()+unpackPackage verbosity prefix pkgid descOverride pkgPath = do let pkgdirname = display pkgid pkgdir = prefix </> pkgdirname pkgdir' = addTrailingPathSeparator pkgdir@@ -121,3 +127,12 @@ "A file \"" ++ pkgdir ++ "\" is in the way, not unpacking." notice verbosity $ "Unpacking to " ++ pkgdir' Tar.extractTarGzFile prefix pkgdirname pkgPath++ case descOverride of+ Nothing -> return ()+ Just pkgtxt -> do+ let descFilePath = pkgdir </> display (packageName pkgid) <.> "cabal"+ info verbosity $+ "Updating " ++ descFilePath+ ++ " with the latest revision from the index."+ writeFileAtomic descFilePath (BS.unpack pkgtxt)
Distribution/Client/Upload.hs view
@@ -15,10 +15,12 @@ import qualified Distribution.Client.BuildReports.Upload as BuildReport import Network.Browser- ( request )+ ( BrowserAction, request+ , Authority(..), addAuthority ) import Network.HTTP ( Header(..), HeaderName(..), findHeader , Request(..), RequestMethod(..), Response(..) )+import Network.TCP (HandleStream) import Network.URI (URI(uriPath), parseURI) import Data.Char (intToDigit)@@ -49,7 +51,12 @@ else targetRepoURI{uriPath = uriPath targetRepoURI `FilePath.Posix.combine` "upload"} Username username <- maybe promptUsername return mUsername Password password <- maybe promptPassword return mPassword- let auth = Just (username, password)+ let auth = addAuthority AuthBasic {+ auRealm = "Hackage",+ auUsername = username,+ auPassword = password,+ auSite = uploadURI+ } flip mapM_ paths $ \path -> do notice verbosity $ "Uploading " ++ path ++ "... " handlePackage verbosity uploadURI auth path@@ -75,9 +82,17 @@ report :: Verbosity -> [Repo] -> Maybe Username -> Maybe Password -> IO () report verbosity repos mUsername mPassword = do+ let uploadURI = if isOldHackageURI targetRepoURI+ then legacyUploadURI+ else targetRepoURI{uriPath = ""} Username username <- maybe promptUsername return mUsername Password password <- maybe promptPassword return mPassword- let auth = Just (username, password)+ let auth = addAuthority AuthBasic {+ auRealm = "Hackage",+ auUsername = username,+ auPassword = password,+ auSite = uploadURI+ } forM_ repos $ \repo -> case repoKind repo of Left remoteRepo -> do dotCabal <- defaultCabalDir@@ -96,14 +111,16 @@ cabalBrowse verbosity auth $ BuildReport.uploadReports (remoteRepoURI remoteRepo) [(report', Just buildLog)] return () Right{} -> return ()+ where+ targetRepoURI = remoteRepoURI $ last [ remoteRepo | Left remoteRepo <- map repoKind repos ] --FIXME: better error message when no repos are given check :: Verbosity -> [FilePath] -> IO () check verbosity paths = do flip mapM_ paths $ \path -> do notice verbosity $ "Checking " ++ path ++ "... "- handlePackage verbosity checkURI Nothing path+ handlePackage verbosity checkURI (return ()) path -handlePackage :: Verbosity -> URI -> Maybe (String, String)+handlePackage :: Verbosity -> URI -> BrowserAction (HandleStream String) () -> FilePath -> IO () handlePackage verbosity uri auth path = do req <- mkRequest uri path
Distribution/Client/Utils.hs view
@@ -1,10 +1,17 @@-module Distribution.Client.Utils where+{-# LANGUAGE ForeignFunctionInterface #-} +module Distribution.Client.Utils ( MergeResult(..)+ , mergeBy, duplicates, duplicatesBy+ , moreRecentFile, inDir, numberOfProcessors )+ where+ import Data.List ( sortBy, groupBy )+import Foreign.C.Types ( CInt(..) ) import System.Directory ( doesFileExist, getModificationTime , getCurrentDirectory, setCurrentDirectory )+import System.IO.Unsafe ( unsafePerformIO ) import qualified Control.Exception as Exception ( finally ) @@ -58,3 +65,10 @@ old <- getCurrentDirectory setCurrentDirectory d m `Exception.finally` setCurrentDirectory old++foreign import ccall "getNumberOfProcessors" c_getNumberOfProcessors :: IO CInt++-- The number of processors is not going to change during the duration of the+-- program, so unsafePerformIO is safe here.+numberOfProcessors :: Int+numberOfProcessors = fromEnum $ unsafePerformIO c_getNumberOfProcessors
Distribution/Client/World.hs view
@@ -40,6 +40,7 @@ import Distribution.Text ( Text(..), display, simpleParse ) import qualified Distribution.Compat.ReadP as Parse+import Distribution.Compat.Exception ( catchIO ) import qualified Text.PrettyPrint as Disp import Text.PrettyPrint ( (<>), (<+>) ) @@ -117,7 +118,7 @@ else die "Could not parse world file." where safelyReadFile :: FilePath -> IO B.ByteString- safelyReadFile file = B.readFile file `catch` handler+ safelyReadFile file = B.readFile file `catchIO` handler where handler e | isDoesNotExistError e = return B.empty | otherwise = ioError e
+ Distribution/Compat/Time.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}+module Distribution.Compat.Time where++import Data.Int (Int64)+import System.Directory (getModificationTime)++#if MIN_VERSION_directory(1,2,0)+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixDayLength)+import Data.Time (getCurrentTime, diffUTCTime)+#else+import System.Time (ClockTime(..), getClockTime, diffClockTimes, normalizeTimeDiff, tdDay)+#endif++-- | The number of seconds since the UNIX epoch+type EpochTime = Int64++getModTime :: FilePath -> IO EpochTime+getModTime path = do+#if MIN_VERSION_directory(1,2,0)+ (truncate . utcTimeToPOSIXSeconds) `fmap` getModificationTime path+#else+ (TOD s _) <- getModificationTime path+ return $! fromIntegral s+#endif++-- | Return age of given file in days.+getFileAge :: FilePath -> IO Int+getFileAge file = do+ t0 <- getModificationTime file+#if MIN_VERSION_directory(1,2,0)+ t1 <- getCurrentTime+ let days = truncate $ (t1 `diffUTCTime` t0) / posixDayLength+#else+ t1 <- getClockTime+ let days = (tdDay . normalizeTimeDiff) (t1 `diffClockTimes` t0)+#endif+ return days
Main.hs view
@@ -62,11 +62,12 @@ import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade import Distribution.Simple.Compiler- ( Compiler, PackageDB(..), PackageDBStack )+ ( Compiler, PackageDBStack ) import Distribution.Simple.Program ( ProgramConfiguration, defaultProgramConfiguration ) import Distribution.Simple.Command-import Distribution.Simple.Configure (configCompilerAux)+import Distribution.Simple.Configure+ ( configCompilerAux, interpretPackageDbFlags ) import Distribution.Simple.Utils ( cabalVersion, die, topHandler, intercalate ) import Distribution.Text@@ -386,24 +387,9 @@ -- Utils (transitionary) -- --- | Currently the user interface specifies the package dbs to use with just a--- single valued option, a 'PackageDB'. However internally we represent the--- stack of 'PackageDB's explictly as a list. This function converts encodes--- the package db stack implicit in a single packagedb.------ TODO: sort this out, make it consistent with the command line UI-implicitPackageDbStack :: Bool -> Maybe PackageDB -> PackageDBStack-implicitPackageDbStack userInstall packageDbFlag- | userInstall = GlobalPackageDB : UserPackageDB : extra- | otherwise = GlobalPackageDB : extra- where- extra = case packageDbFlag of- Just (SpecificPackageDB db) -> [SpecificPackageDB db]- _ -> []- configPackageDB' :: ConfigFlags -> PackageDBStack configPackageDB' cfg =- implicitPackageDbStack userInstall (flagToMaybe (configPackageDB cfg))+ interpretPackageDbFlags userInstall (configPackageDBs cfg) where userInstall = fromFlagOrDefault True (configUserInstall cfg)
bootstrap.sh view
@@ -47,16 +47,16 @@ # Versions of the packages to install. # The version regex says what existing installed versions are ok.-PARSEC_VER="3.1.2"; PARSEC_VER_REGEXP="[23]\." # == 2.* || == 3.*-DEEPSEQ_VER="1.3.0.0"; DEEPSEQ_VER_REGEXP="1\.[1-9]\." # >= 1.1 && < 2-TEXT_VER="0.11.2.0"; TEXT_VER_REGEXP="0\.([2-9]|(1[0-1]))\." # >= 0.2 && < 0.12-NETWORK_VER="2.3.0.11"; NETWORK_VER_REGEXP="2\." # == 2.*-CABAL_VER="1.14.0"; CABAL_VER_REGEXP="1\.(13\.3|14\.)" # >= 1.13.3 && < 1.15+PARSEC_VER="3.1.3"; PARSEC_VER_REGEXP="[23]\." # == 2.* || == 3.*+DEEPSEQ_VER="1.3.0.1"; DEEPSEQ_VER_REGEXP="1\.[1-9]\." # >= 1.1 && < 2+TEXT_VER="0.11.2.3"; TEXT_VER_REGEXP="0\.([2-9]|(1[0-1]))\." # >= 0.2 && < 0.12+NETWORK_VER="2.3.1.0"; NETWORK_VER_REGEXP="2\." # == 2.*+CABAL_VER="1.16.0"; CABAL_VER_REGEXP="1\.(13\.3|1[4-7]\.)" # >= 1.13.3 && < 1.18 TRANS_VER="0.3.0.0"; TRANS_VER_REGEXP="0\.[23]\." # >= 0.2.* && < 0.4.*-MTL_VER="2.1"; MTL_VER_REGEXP="[12]\." # == 1.* || == 2.*-HTTP_VER="4000.2.3"; HTTP_VER_REGEXP="4000\.[012]\." # == 4000.0.* || 4000.1.* || 4000.2.*-ZLIB_VER="0.5.3.3"; ZLIB_VER_REGEXP="0\.[45]\." # == 0.4.* || == 0.5.*-TIME_VER="1.4" TIME_VER_REGEXP="1\.[1234]\.?" # >= 1.1 && < 1.5+MTL_VER="2.1.2"; MTL_VER_REGEXP="[12]\." # == 1.* || == 2.*+HTTP_VER="4000.2.4"; HTTP_VER_REGEXP="4000\.[012]\." # == 4000.0.* || 4000.1.* || 4000.2.*+ZLIB_VER="0.5.4.0"; ZLIB_VER_REGEXP="0\.[45]\." # == 0.4.* || == 0.5.*+TIME_VER="1.4.0.1" TIME_VER_REGEXP="1\.[1234]\.?" # >= 1.1 && < 1.5 RANDOM_VER="1.0.1.1" RANDOM_VER_REGEXP="1\.0\." # >= 1 && < 1.1 HACKAGE_URL="http://hackage.haskell.org/packages/archive"
cabal-install.cabal view
@@ -1,12 +1,12 @@ Name: cabal-install-Version: 0.14.1+Version: 1.16.0 Synopsis: The command-line interface for Cabal and Hackage. Description: The \'cabal\' command-line program simplifies the process of managing Haskell software by automating the fetching, configuration, compilation and installation of Haskell libraries and programs. homepage: http://www.haskell.org/cabal/-bug-reports: http://hackage.haskell.org/trac/hackage/+bug-reports: https://github.com/haskell/cabal/issues License: BSD3 License-File: LICENSE Author: Lemmih <lemmih@gmail.com>@@ -86,7 +86,7 @@ Distribution.Client.Install Distribution.Client.InstallPlan Distribution.Client.InstallSymlink- Distribution.Client.JobControl + Distribution.Client.JobControl Distribution.Client.List Distribution.Client.PackageIndex Distribution.Client.PackageUtils@@ -104,12 +104,13 @@ Distribution.Client.Win32SelfUpgrade Distribution.Compat.Exception Distribution.Compat.FilePerms+ Distribution.Compat.Time Paths_cabal_install build-depends: base >= 2 && < 5,- Cabal >= 1.14.0 && < 1.15,+ Cabal >= 1.16.0 && < 1.18, filepath >= 1.0 && < 1.4,- network >= 1 && < 2.4,+ network >= 1 && < 3, HTTP >= 4000.0.2 && < 4001, zlib >= 0.4 && < 0.6, time >= 1.1 && < 1.5,@@ -120,10 +121,10 @@ else build-depends: base >= 3, process >= 1 && < 1.2,- directory >= 1 && < 1.2,+ directory >= 1 && < 1.3, pretty >= 1 && < 1.2, random >= 1 && < 1.1,- containers >= 0.1 && < 0.5,+ containers >= 0.1 && < 0.6, array >= 0.1 && < 0.5, old-time >= 1 && < 1.2 @@ -136,5 +137,6 @@ build-depends: Win32 >= 2 && < 3 cpp-options: -DWIN32 else- build-depends: unix >= 1.0 && < 2.6- extensions: CPP+ build-depends: unix >= 1.0 && < 2.7+ extensions: CPP, ForeignFunctionInterface+ c-sources: cbits/getnumcores.c
+ cbits/getnumcores.c view
@@ -0,0 +1,46 @@+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 612)+/* Since version 6.12, GHC's threaded RTS includes a getNumberOfProcessors+ function, so we try to use that if available. cabal-install is always built+ with -threaded nowadays. */+#define HAS_GET_NUMBER_OF_PROCESSORS+#endif+++#ifndef HAS_GET_NUMBER_OF_PROCESSORS++#ifdef _WIN32+#include <windows.h>+#elif MACOS+#include <sys/param.h>+#include <sys/sysctl.h>+#elif __linux__+#include <unistd.h>+#endif++int getNumberOfProcessors() {+#ifdef WIN32+ SYSTEM_INFO sysinfo;+ GetSystemInfo(&sysinfo);+ return sysinfo.dwNumberOfProcessors;+#elif MACOS+ int nm[2];+ size_t len = 4;+ uint32_t count;++ nm[0] = CTL_HW; nm[1] = HW_AVAILCPU;+ sysctl(nm, 2, &count, &len, NULL, 0);++ if(count < 1) {+ nm[1] = HW_NCPU;+ sysctl(nm, 2, &count, &len, NULL, 0);+ if(count < 1) { count = 1; }+ }+ return count;+#elif __linux__+ return sysconf(_SC_NPROCESSORS_ONLN);+#else+ return 1;+#endif+}++#endif /* HAS_GET_NUMBER_OF_PROCESSORS */