Permalink
Browse files

Merge branch 'master' of git://github.com/haskell/cabal

  • Loading branch information...
2 parents 0cad9d1 + 5c0fa59 commit 56d5a2b14743ba4b9a2461d455d07d9c17418814 @igfoo igfoo committed Oct 25, 2012
@@ -632,7 +632,7 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
rawSystemExitWithEnv verbosity "sh" args' env'
where
- args = "configure" : configureArgs backwardsCompatHack flags
+ args = "./configure" : configureArgs backwardsCompatHack flags
appendToEnvironment (key, val) [] = [(key, val)]
appendToEnvironment (key, val) (kv@(k, v) : rest)
@@ -73,9 +73,9 @@ generate pkg_descr lbi =
"\n"++
foreign_imports++
"import qualified Control.Exception as Exception\n"++
- "import Data.Version (Version(..))\n"++
+ "import Data.Version (Version(Version, versionBranch, versionTags))\n"++
"import System.Environment (getEnv)\n"++
- "import Prelude\n"++
+ "import Prelude ((++), FilePath, IO, return)\n"++
"\n"++
"catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"++
"catchIO = Exception.catch\n" ++

Large diffs are not rendered by default.

Oops, something went wrong.
@@ -17,9 +17,7 @@ import System.Exit
-- | A list of GHC extensions that are deliberately not registered,
-- e.g. due to being experimental and not ready for public consumption
--
-exceptions = map readExtension
- [ "PArr" -- still classed as experimental, will be renamed and registered
- ]
+exceptions = map readExtension []
checkProblems :: [Extension] -> [String]
checkProblems implemented =
@@ -44,8 +44,6 @@ import Distribution.Client.Setup
, UploadFlags(..), uploadCommand
, ReportFlags(..), reportCommand
, showRepo, parseRepo )
-import Distribution.Client.Utils
- ( numberOfProcessors )
import Distribution.Simple.Compiler
( OptimisationLevel(..) )
@@ -211,8 +209,8 @@ initialSavedConfig = do
},
savedInstallFlags = mempty {
installSummaryFile = [toPathTemplate (logsDir </> "build.log")],
- installBuildReports= toFlag AnonymousReports,
- installNumJobs = toFlag (Just numberOfProcessors)
+ installBuildReports= toFlag AnonymousReports
+ --installNumJobs = toFlag (Just numberOfProcessors)
}
}
@@ -22,8 +22,6 @@ import Data.List
( unfoldr, nub, sort, (\\) )
import Data.Maybe
( isJust, fromMaybe, maybeToList )
-import qualified Data.ByteString.Lazy.Char8 as BS
- ( unpack )
import Control.Exception as Exception
( bracket, handleJust )
#if MIN_VERSION_base(4,0,0)
@@ -123,7 +121,7 @@ import Distribution.System
import Distribution.Text
( display )
import Distribution.Verbosity as Verbosity
- ( Verbosity, showForCabal, verbose, deafening )
+ ( Verbosity, showForCabal, normal, verbose, deafening )
import Distribution.Simple.BuildPaths ( exeExtension )
--TODO:
@@ -934,20 +932,21 @@ executeInstallPlan verbosity jobCtl useLogFile plan0 installPkg =
(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
+ when (verbosity >= normal) $
+ case useLogFile of
+ Nothing -> return ()
+ Just (mkLogFileName, _) -> do
+ let (logName, n) = (mkLogFileName pkgid, 10)
+ putStr $ "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)
+ mapM_ putStr (drop toDrop lns)
-- | Call an installer for an 'SourcePackage' but override the configure
-- flags with the ones given by the 'ConfiguredPackage'. In particular the
@@ -51,6 +51,7 @@ newSerialJobControl = do
collect = join . readChan
newParallelJobControl :: IO (JobControl IO a)
+#if MIN_VERSION_base(4,3,0)
newParallelJobControl = do
resultVar <- newEmptyMVar
return JobControl {
@@ -68,7 +69,9 @@ newParallelJobControl = do
collect :: MVar (Either SomeException a) -> IO a
collect resultVar =
takeMVar resultVar >>= either throw return
-
+#else
+newParallelJobControl = newSerialJobControl
+#endif
data JobLimit = JobLimit QSem
@@ -15,11 +15,13 @@ module Distribution.Client.PackageEnvironment (
, readPackageEnvironmentFile
, showPackageEnvironment
, showPackageEnvironmentWithComments
+ , setPackageDB
, basePackageEnvironment
, initialPackageEnvironment
, commentPackageEnvironment
- , defaultPackageEnvironmentFileName
+ , sandboxPackageEnvironmentFile
+ , userPackageEnvironmentFile
) where
import Distribution.Client.Config ( SavedConfig(..), commentSavedConfig,
@@ -56,6 +58,7 @@ import qualified Distribution.Compat.ReadP as Parse
import qualified Distribution.ParseUtils as ParseUtils ( Field(..) )
import qualified Distribution.Text as Text
+
--
-- * Configuration saved in the package environment file
--
@@ -80,13 +83,20 @@ instance Monoid PackageEnvironment where
where
combine f = f a `mappend` f b
-defaultPackageEnvironmentFileName :: FilePath
-defaultPackageEnvironmentFileName = "pkgenv"
+-- | The automatically-created package environment file that should not be
+-- touched by the user.
+sandboxPackageEnvironmentFile :: FilePath
+sandboxPackageEnvironmentFile = "cabal.sandbox.config"
+
+-- | Optional package environment file that can be used to customize the default
+-- settings. Created by the user.
+userPackageEnvironmentFile :: FilePath
+userPackageEnvironmentFile = "cabal.config"
-- | Defaults common to 'initialPackageEnvironment' and
-- 'commentPackageEnvironment'.
commonPackageEnvironmentConfig :: FilePath -> SavedConfig
-commonPackageEnvironmentConfig pkgEnvDir =
+commonPackageEnvironmentConfig sandboxDir =
mempty {
savedConfigureFlags = mempty {
configUserInstall = toFlag False,
@@ -95,20 +105,20 @@ commonPackageEnvironmentConfig pkgEnvDir =
savedUserInstallDirs = sandboxInstallDirs,
savedGlobalInstallDirs = sandboxInstallDirs,
savedGlobalFlags = mempty {
- globalLogsDir = toFlag $ pkgEnvDir </> "logs",
+ globalLogsDir = toFlag $ sandboxDir </> "logs",
-- Is this right? cabal-dev uses the global world file.
- globalWorldFile = toFlag $ pkgEnvDir </> "world"
+ globalWorldFile = toFlag $ sandboxDir </> "world"
}
}
where
- sandboxInstallDirs = mempty { prefix = toFlag (toPathTemplate pkgEnvDir) }
+ sandboxInstallDirs = mempty { prefix = toFlag (toPathTemplate sandboxDir) }
-- | These are the absolute basic defaults, the fields that must be
-- initialised. When we load the package environment from the file we layer the
-- loaded values over these ones.
basePackageEnvironment :: FilePath -> PackageEnvironment
-basePackageEnvironment pkgEnvDir = do
- let baseConf = commonPackageEnvironmentConfig pkgEnvDir in
+basePackageEnvironment sandboxDir = do
+ let baseConf = commonPackageEnvironmentConfig sandboxDir in
mempty {
pkgEnvSavedConfig = baseConf {
savedConfigureFlags = (savedConfigureFlags baseConf) {
@@ -119,67 +129,84 @@ basePackageEnvironment pkgEnvDir = do
}
-- | Initial configuration that we write out to the package environment file if
--- it does not exist. When the package environment gets loaded it gets layered
--- on top of 'basePackageEnvironment'.
+-- it does not exist. When the package environment gets loaded this
+-- configuration gets layered on top of 'basePackageEnvironment'.
initialPackageEnvironment :: FilePath -> Compiler -> IO PackageEnvironment
-initialPackageEnvironment pkgEnvDir compiler = do
+initialPackageEnvironment sandboxDir compiler = do
initialConf' <- initialSavedConfig
- let baseConf = commonPackageEnvironmentConfig pkgEnvDir
+ let baseConf = commonPackageEnvironmentConfig sandboxDir
let initialConf = initialConf' `mappend` baseConf
return $ mempty {
pkgEnvSavedConfig = initialConf {
savedGlobalFlags = (savedGlobalFlags initialConf) {
- globalLocalRepos = [pkgEnvDir </> "packages"]
+ globalLocalRepos = [sandboxDir </> "packages"]
},
- savedConfigureFlags = setPackageDB pkgEnvDir compiler
+ savedConfigureFlags = setPackageDB sandboxDir compiler
(savedConfigureFlags initialConf),
savedInstallFlags = (savedInstallFlags initialConf) {
- installSummaryFile = [toPathTemplate (pkgEnvDir </>
+ installSummaryFile = [toPathTemplate (sandboxDir </>
"logs" </> "build.log")]
}
}
}
-- | Use the package DB location specific for this compiler.
setPackageDB :: FilePath -> Compiler -> ConfigFlags -> ConfigFlags
-setPackageDB pkgEnvDir compiler configFlags =
+setPackageDB sandboxDir compiler configFlags =
configFlags {
- configPackageDBs = [Just (SpecificPackageDB $ pkgEnvDir
+ configPackageDBs = [Just (SpecificPackageDB $ sandboxDir
</> (showCompilerId compiler ++
"-packages.conf.d"))]
}
-- | Default values that get used if no value is given. Used here to include in
-- comments when we write out the initial package environment.
commentPackageEnvironment :: FilePath -> IO PackageEnvironment
-commentPackageEnvironment pkgEnvDir = do
+commentPackageEnvironment sandboxDir = do
commentConf <- commentSavedConfig
- let baseConf = commonPackageEnvironmentConfig pkgEnvDir
+ let baseConf = commonPackageEnvironmentConfig sandboxDir
return $ mempty {
pkgEnvSavedConfig = commentConf `mappend` baseConf
}
--- | Given a package environment loaded from a file, layer it on top of the base
--- package environment.
-addBasePkgEnv :: Verbosity -> FilePath -> PackageEnvironment
- -> IO PackageEnvironment
-addBasePkgEnv verbosity pkgEnvDir extra = do
- let base = basePackageEnvironment pkgEnvDir
+-- | Return the base package environment: settings from the config file this
+-- package environment optionally inherits from layered on top of
+-- `basePackageEnvironment`.
+basePkgEnv :: Verbosity -> FilePath -> (Flag FilePath) -> IO PackageEnvironment
+basePkgEnv verbosity sandboxDir inheritConfig = do
+ let base = basePackageEnvironment sandboxDir
baseConf = pkgEnvSavedConfig base
-- Does this package environment inherit from some config file?
- case pkgEnvInherit extra of
- NoFlag ->
- return $ base `mappend` extra
+ case inheritConfig of
+ NoFlag -> return base
(Flag confPath) -> do
conf <- loadConfig verbosity (Flag confPath) NoFlag
- let conf' = baseConf `mappend` conf `mappend` (pkgEnvSavedConfig extra)
- return $ extra { pkgEnvSavedConfig = conf' }
+ return $ base { pkgEnvSavedConfig = baseConf `mappend` conf }
+
+-- | Load the user package environment if it exists (the optional "cabal.config"
+-- file).
+userPkgEnv :: Verbosity -> FilePath -> IO PackageEnvironment
+userPkgEnv verbosity pkgEnvDir = do
+ let path = pkgEnvDir </> userPackageEnvironmentFile
+ minp <- readPackageEnvironmentFile mempty path
+ case minp of
+ Nothing -> return mempty
+ Just (ParseOk warns parseResult) -> do
+ when (not $ null warns) $ warn verbosity $
+ unlines (map (showPWarning path) warns)
+ return parseResult
+ Just (ParseFailed err) -> do
+ let (line, msg) = locatedErrorMsg err
+ warn verbosity $ "Error parsing user package environment file " ++ path
+ ++ maybe "" (\n -> ":" ++ show n) line ++ ":\n" ++ msg
+ return mempty
-- | Try to load a package environment file, exiting with error if it doesn't
-- exist.
-tryLoadPackageEnvironment :: Verbosity -> FilePath -> IO PackageEnvironment
-tryLoadPackageEnvironment verbosity pkgEnvDir = do
- let path = pkgEnvDir </> defaultPackageEnvironmentFileName
+tryLoadPackageEnvironment :: Verbosity -> FilePath -> FilePath
+ -> IO PackageEnvironment
+tryLoadPackageEnvironment verbosity sandboxDir pkgEnvDir = do
+ let path = pkgEnvDir </> sandboxPackageEnvironmentFile
minp <- readPackageEnvironmentFile mempty path
pkgEnv <- case minp of
Nothing -> die $
@@ -192,61 +219,38 @@ tryLoadPackageEnvironment verbosity pkgEnvDir = do
let (line, msg) = locatedErrorMsg err
die $ "Error parsing package environment file " ++ path
++ maybe "" (\n -> ":" ++ show n) line ++ ":\n" ++ msg
- addBasePkgEnv verbosity pkgEnvDir pkgEnv
+ user <- userPkgEnv verbosity pkgEnvDir
+ base <- basePkgEnv verbosity sandboxDir (pkgEnvInherit pkgEnv)
+ return $ base `mappend` user `mappend` pkgEnv
-- | Load a package environment file, creating one if it doesn't exist. Note
-- that the path parameter should be a name of an existing directory.
-loadOrCreatePackageEnvironment :: Verbosity -> FilePath
- -> ConfigFlags -> Compiler
+loadOrCreatePackageEnvironment :: Verbosity -> FilePath -> FilePath -> Compiler
-> IO PackageEnvironment
-loadOrCreatePackageEnvironment verbosity pkgEnvDir configFlags compiler = do
- let path = pkgEnvDir </> defaultPackageEnvironmentFileName
+loadOrCreatePackageEnvironment verbosity sandboxDir pkgEnvDir compiler = do
+ let path = pkgEnvDir </> sandboxPackageEnvironmentFile
minp <- readPackageEnvironmentFile mempty path
pkgEnv <- case minp of
Nothing -> do
notice verbosity $ "Writing default package environment to " ++ path
- commentPkgEnv <- commentPackageEnvironment pkgEnvDir
- initialPkgEnv <- initialPackageEnvironment pkgEnvDir compiler
- let pkgEnv = updateConfigFlags initialPkgEnv
- (\flags -> flags `mappend` configFlags)
- writePackageEnvironmentFile path commentPkgEnv pkgEnv
+ commentPkgEnv <- commentPackageEnvironment sandboxDir
+ initialPkgEnv <- initialPackageEnvironment sandboxDir compiler
+ writePackageEnvironmentFile path commentPkgEnv initialPkgEnv
return initialPkgEnv
Just (ParseOk warns parseResult) -> do
when (not $ null warns) $ warn verbosity $
unlines (map (showPWarning path) warns)
-
- -- Update the package environment file in case the user has changed some
- -- settings via the command-line (otherwise 'configure -w compiler-B' will
- -- fail for a sandbox already configured to use compiler-A).
- notice verbosity $ "Writing the updated package environment to " ++ path
- commentPkgEnv <- commentPackageEnvironment pkgEnvDir
- let pkgEnv = updateConfigFlags parseResult
- (\flags ->
- setPackageDB pkgEnvDir compiler flags
- `mappend` configFlags)
- writePackageEnvironmentFile path commentPkgEnv pkgEnv
-
- return pkgEnv
+ return parseResult
Just (ParseFailed err) -> do
let (line, msg) = locatedErrorMsg err
warn verbosity $
"Error parsing package environment file " ++ path
++ maybe "" (\n -> ":" ++ show n) line ++ ":\n" ++ msg
- warn verbosity $ "Using default package environment."
- initialPackageEnvironment pkgEnvDir compiler
- addBasePkgEnv verbosity pkgEnvDir pkgEnv
-
- where
- updateConfigFlags :: PackageEnvironment -> (ConfigFlags -> ConfigFlags)
- -> PackageEnvironment
- updateConfigFlags pkgEnv f =
- let pkgEnvConfig = pkgEnvSavedConfig pkgEnv
- pkgEnvConfigFlags = savedConfigureFlags pkgEnvConfig
- in pkgEnv {
- pkgEnvSavedConfig = pkgEnvConfig {
- savedConfigureFlags = f pkgEnvConfigFlags
- }
- }
+ warn verbosity $ "Using the default package environment."
+ initialPackageEnvironment sandboxDir compiler
+ user <- userPkgEnv verbosity pkgEnvDir
+ base <- basePkgEnv verbosity sandboxDir (pkgEnvInherit pkgEnv)
+ return $ base `mappend` user `mappend` pkgEnv
-- | Descriptions of all fields in the package environment file.
pkgEnvFieldDescrs :: [FieldDescr PackageEnvironment]
@@ -355,6 +359,9 @@ writePackageEnvironmentFile path comments pkgEnv = do
where
explanation = unlines
["-- This is a Cabal package environment file."
+ ,"-- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY."
+ ,"-- Please create a 'cabal.config' file in the same directory"
+ ,"-- if you want to change the default settings for this sandbox."
,""
,"-- The available configuration options are listed below."
,"-- Some of them have default values listed."
Oops, something went wrong.

0 comments on commit 56d5a2b

Please sign in to comment.