Commit 0e27a4d9 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov

Add a --write-ghc-environment-files setting.

Fixes #4542.
parent 2a523a8c
......@@ -363,7 +363,9 @@ instance Semigroup SavedConfig where
configPreferences = lastNonEmpty configPreferences,
configSolver = combine configSolver,
configAllowNewer = combineMonoid savedConfigureExFlags configAllowNewer,
configAllowOlder = combineMonoid savedConfigureExFlags configAllowOlder
configAllowOlder = combineMonoid savedConfigureExFlags configAllowOlder,
configWriteGhcEnvironmentFilesPolicy
= combine configWriteGhcEnvironmentFilesPolicy
}
where
combine = combine' savedConfigureExFlags
......
......@@ -334,7 +334,9 @@ convertLegacyAllPackageFlags globalFlags configFlags
configPreferences = projectConfigPreferences,
configSolver = projectConfigSolver,
configAllowOlder = projectConfigAllowOlder,
configAllowNewer = projectConfigAllowNewer
configAllowNewer = projectConfigAllowNewer,
configWriteGhcEnvironmentFilesPolicy
= projectConfigWriteGhcEnvironmentFilesPolicy
} = configExFlags
InstallFlags {
......@@ -555,8 +557,9 @@ convertToLegacySharedConfig
configPreferences = projectConfigPreferences,
configSolver = projectConfigSolver,
configAllowOlder = projectConfigAllowOlder,
configAllowNewer = projectConfigAllowNewer
configAllowNewer = projectConfigAllowNewer,
configWriteGhcEnvironmentFilesPolicy
= projectConfigWriteGhcEnvironmentFilesPolicy
}
installFlags = InstallFlags {
......@@ -925,7 +928,7 @@ legacySharedConfigFieldDescrs =
(\v conf -> conf { configAllowNewer = fmap AllowNewer v })
]
. filterFields
[ "cabal-lib-version", "solver"
[ "cabal-lib-version", "solver", "write-ghc-environment-files"
-- not "constraint" or "preference", we use our own plural ones above
]
. commandOptionsToFields
......
......@@ -21,7 +21,8 @@ module Distribution.Client.ProjectConfig.Types (
) where
import Distribution.Client.Types
( RemoteRepo, AllowNewer(..), AllowOlder(..) )
( RemoteRepo, AllowNewer(..), AllowOlder(..)
, WriteGhcEnvironmentFilesPolicy )
import Distribution.Client.Dependency.Types
( PreSolver )
import Distribution.Client.Targets
......@@ -187,6 +188,8 @@ data ProjectConfigShared
projectConfigSolver :: Flag PreSolver,
projectConfigAllowOlder :: Maybe AllowOlder,
projectConfigAllowNewer :: Maybe AllowNewer,
projectConfigWriteGhcEnvironmentFilesPolicy
:: Flag WriteGhcEnvironmentFilesPolicy,
projectConfigMaxBackjumps :: Flag Int,
projectConfigReorderGoals :: Flag ReorderGoals,
projectConfigCountConflicts :: Flag CountConflicts,
......
......@@ -113,7 +113,8 @@ import Distribution.Client.ProjectPlanOutput
import Distribution.Client.Types
( GenericReadyPackage(..), UnresolvedSourcePackage
, PackageSpecifier(..)
, SourcePackageDb(..) )
, SourcePackageDb(..)
, WriteGhcEnvironmentFilesPolicy(..) )
import Distribution.Solver.Types.PackageIndex
( lookupPackageName )
import qualified Distribution.Client.InstallPlan as InstallPlan
......@@ -124,6 +125,8 @@ import Distribution.Client.TargetSelector
import Distribution.Client.DistDirLayout
import Distribution.Client.Config (getCabalDir)
import Distribution.Client.Setup hiding (packageName)
import Distribution.Compiler
( CompilerFlavor(GHC) )
import Distribution.Types.ComponentName
( componentNameString )
import Distribution.Types.UnqualComponentName
......@@ -138,6 +141,8 @@ import Distribution.PackageDescription
, diffFlagAssignment )
import Distribution.Simple.LocalBuildInfo
( ComponentName(..), pkgComponents )
import Distribution.Simple.Flag
( fromFlagOrDefault )
import qualified Distribution.Simple.Setup as Setup
import Distribution.Simple.Command (commandShowOptions)
import Distribution.Simple.Configure (computeEffectiveProfiling)
......@@ -145,9 +150,11 @@ import Distribution.Simple.Configure (computeEffectiveProfiling)
import Distribution.Simple.Utils
( die', warn, notice, noticeNoWrap, debugNoWrap )
import Distribution.Verbosity
import Distribution.Version
( mkVersion )
import Distribution.Text
import Distribution.Simple.Compiler
( showCompilerId
( compilerCompatVersion, showCompilerId
, OptimisationLevel(..))
import qualified Data.Monoid as Mon
......@@ -391,10 +398,27 @@ runProjectPostBuildPhase verbosity
pkgsBuildStatus
buildOutcomes
void $ writePlanGhcEnvironment (distProjectRootDirectory distDirLayout)
elaboratedPlanOriginal
elaboratedShared
postBuildStatus
-- Write the .ghc.environment file (if allowed by the env file write policy).
let writeGhcEnvFilesPolicy =
projectConfigWriteGhcEnvironmentFilesPolicy . projectConfigShared
$ projectConfig
shouldWriteGhcEnvironment =
case fromFlagOrDefault WriteGhcEnvironmentFilesOnlyForGhc844AndNewer
writeGhcEnvFilesPolicy
of
AlwaysWriteGhcEnvironmentFiles -> True
NeverWriteGhcEnvironmentFiles -> False
WriteGhcEnvironmentFilesOnlyForGhc844AndNewer ->
let compiler = pkgConfigCompiler elaboratedShared
ghcCompatVersion = compilerCompatVersion GHC compiler
in maybe False (>= mkVersion [8,4,4]) ghcCompatVersion
when shouldWriteGhcEnvironment $
void $ writePlanGhcEnvironment (distProjectRootDirectory distDirLayout)
elaboratedPlanOriginal
elaboratedShared
postBuildStatus
-- Finally if there were any build failures then report them and throw
-- an exception to terminate the program
......
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.Setup
......@@ -70,6 +71,7 @@ import Distribution.Client.Compat.Prelude hiding (get)
import Distribution.Client.Types
( Username(..), Password(..), RemoteRepo(..)
, AllowNewer(..), AllowOlder(..), RelaxDeps(..)
, WriteGhcEnvironmentFilesPolicy(..)
)
import Distribution.Client.BuildReports.Types
( ReportLevel(..) )
......@@ -637,12 +639,14 @@ configCompilerAux' configFlags =
-- | cabal configure takes some extra flags beyond runghc Setup configure
--
data ConfigExFlags = ConfigExFlags {
configCabalVersion :: Flag Version,
configExConstraints:: [(UserConstraint, ConstraintSource)],
configPreferences :: [PackageVersionConstraint],
configSolver :: Flag PreSolver,
configAllowNewer :: Maybe AllowNewer,
configAllowOlder :: Maybe AllowOlder
configCabalVersion :: Flag Version,
configExConstraints :: [(UserConstraint, ConstraintSource)],
configPreferences :: [PackageVersionConstraint],
configSolver :: Flag PreSolver,
configAllowNewer :: Maybe AllowNewer,
configAllowOlder :: Maybe AllowOlder,
configWriteGhcEnvironmentFilesPolicy
:: Flag WriteGhcEnvironmentFilesPolicy
}
deriving (Eq, Generic)
......@@ -707,9 +711,34 @@ configureExOptions _showOrParseArgs src =
(readP_to_E ("Cannot parse the list of packages: " ++) relaxDepsParser)
(Just RelaxDepsAll) relaxDepsPrinter)
, option [] ["write-ghc-environment-files"]
("Whether to create a .ghc.environment file after a successful build"
++ " (v2-build only)")
configWriteGhcEnvironmentFilesPolicy
(\v flags -> flags { configWriteGhcEnvironmentFilesPolicy = v})
(reqArg "always|never|ghc8.4.4+"
writeGhcEnvironmentFilesPolicyParser
writeGhcEnvironmentFilesPolicyPrinter)
]
writeGhcEnvironmentFilesPolicyParser :: ReadE (Flag WriteGhcEnvironmentFilesPolicy)
writeGhcEnvironmentFilesPolicyParser = ReadE $ \case
"always" -> Right $ Flag AlwaysWriteGhcEnvironmentFiles
"never" -> Right $ Flag NeverWriteGhcEnvironmentFiles
"ghc8.4.4+" -> Right $ Flag WriteGhcEnvironmentFilesOnlyForGhc844AndNewer
policy -> Left $ "Cannot parse the GHC environment file write policy '"
<> policy <> "'"
writeGhcEnvironmentFilesPolicyPrinter
:: Flag WriteGhcEnvironmentFilesPolicy -> [String]
writeGhcEnvironmentFilesPolicyPrinter = \case
(Flag AlwaysWriteGhcEnvironmentFiles) -> ["always"]
(Flag NeverWriteGhcEnvironmentFiles) -> ["never"]
(Flag WriteGhcEnvironmentFilesOnlyForGhc844AndNewer) -> ["ghc8.4.4+"]
NoFlag -> []
relaxDepsParser :: Parse.ReadP r (Maybe RelaxDeps)
relaxDepsParser =
(Just . RelaxDepsSome) `fmap` Parse.sepBy1 parse (Parse.char ',')
......
......@@ -591,3 +591,19 @@ instance Monoid AllowNewer where
instance Monoid AllowOlder where
mempty = AllowOlder mempty
mappend = (<>)
-- ------------------------------------------------------------
-- * --write-ghc-environment-file
-- ------------------------------------------------------------
-- | Whether 'v2-build' should write a .ghc.environment file after
-- success. Possible values: 'always', 'never', 'ghc8.4.4+' (the
-- default; GHC 8.4.4 is the earliest version that supports
-- '-pkg-env -').
data WriteGhcEnvironmentFilesPolicy
= AlwaysWriteGhcEnvironmentFiles
| NeverWriteGhcEnvironmentFiles
| WriteGhcEnvironmentFilesOnlyForGhc844AndNewer
deriving (Eq, Generic, Show)
instance Binary WriteGhcEnvironmentFilesPolicy
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment