Commit 221aecf5 authored by Oleg Grenrus's avatar Oleg Grenrus

Make withProjectOrGlobalConfig take ignoreProject flag - as it should always

parent d1631633
......@@ -24,7 +24,7 @@ import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), yesNoOpt )
import Distribution.Simple.Flag ( Flag(..), toFlag, fromFlag, fromFlagOrDefault )
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives, option )
( CommandUI(..), usageAlternatives, option, optionName )
import Distribution.Verbosity
( Verbosity, normal )
import Distribution.Simple.Utils
......@@ -67,12 +67,13 @@ buildCommand = CommandUI {
++ cmdCommonHelpTextNewBuildBeta
, commandDefaultFlags = defaultNixStyleFlags defaultBuildFlags
, commandOptions = nixStyleOptions $ \showOrParseArgs ->
, commandOptions = filter (\o -> optionName o /= "ignore-project")
. nixStyleOptions (\showOrParseArgs ->
[ option [] ["only-configure"]
"Instead of performing a full build just run the configure step"
buildOnlyConfigure (\v flags -> flags { buildOnlyConfigure = v })
(yesNoOpt showOrParseArgs)
]
])
}
data BuildFlags = BuildFlags
......
......@@ -24,7 +24,7 @@ import Distribution.Verbosity
( normal )
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
( CommandUI(..), usageAlternatives, optionName )
import Distribution.Simple.Utils
( wrapText, notice )
......@@ -68,7 +68,8 @@ configureCommand = CommandUI {
++ cmdCommonHelpTextNewBuildBeta
, commandDefaultFlags = defaultNixStyleFlags ()
, commandOptions = nixStyleOptions (const [])
, commandOptions = filter (\o -> optionName o /= "ignore-project")
. nixStyleOptions (const [])
}
-- | To a first approximation, the @configure@ just runs the first phase of
......
......@@ -48,7 +48,7 @@ import Distribution.Client.ProjectPlanning
, ElaboratedSharedConfig(..)
)
import Distribution.Simple.Command
( CommandUI(..)
( CommandUI(..), optionName
)
import Distribution.Simple.Program.Db
( modifyProgramSearchPath
......@@ -114,7 +114,8 @@ execCommand = CommandUI
++ " to choose an appropriate version of ghc and to include any"
++ " ghc-specific flags requested."
, commandNotes = Nothing
, commandOptions = nixStyleOptions (const [])
, commandOptions = filter (\o -> optionName o /= "ignore-project")
. nixStyleOptions (const [])
, commandDefaultFlags = defaultNixStyleFlags ()
}
......
......@@ -79,7 +79,7 @@ import Distribution.Client.IndexUtils
( getSourcePackages, getInstalledPackages )
import Distribution.Client.ProjectConfig
( projectConfigWithBuilderRepoContext
, resolveBuildTimeSettings, withProjectOrGlobalConfigIgn )
, resolveBuildTimeSettings, withProjectOrGlobalConfig )
import Distribution.Client.ProjectPlanning
( storePackageInstallDirs' )
import Distribution.Client.ProjectPlanning.Types
......@@ -305,11 +305,8 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe
return (packageSpecifiers, uris, packageTargets, projectConfig)
let
ignoreProject = fromFlagOrDefault False (flagIgnoreProject projectFlags)
(specs, uris, targetSelectors, config) <-
withProjectOrGlobalConfigIgn ignoreProject verbosity globalConfigFlag withProject withoutProject
withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag withProject withoutProject
let
ProjectConfig {
......@@ -404,6 +401,7 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe
where
configFlags' = disableTestsBenchsByDefault configFlags
verbosity = fromFlagOrDefault normal (configVerbosity configFlags')
ignoreProject = flagIgnoreProject projectFlags
cliConfig = commandLineFlagsToProjectConfig
globalFlags
flags { configFlags = configFlags' }
......
......@@ -30,7 +30,7 @@ import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.ProjectBuilding
( rebuildTargetsDryRun, improveInstallPlanWithUpToDatePackages )
import Distribution.Client.ProjectConfig
( ProjectConfig(..), withProjectOrGlobalConfigIgn
( ProjectConfig(..), withProjectOrGlobalConfig
, projectConfigConfigFile )
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectPlanning
......@@ -199,12 +199,11 @@ replCommand = Client.installCommand {
replAction :: NixStyleFlags (ReplFlags, EnvFlags) -> [String] -> GlobalFlags -> IO ()
replAction flags@NixStyleFlags { extraFlags = (replFlags, envFlags), ..} targetStrings globalFlags = do
let
ignoreProject = fromFlagOrDefault False (envIgnoreProject envFlags)
with = withProject cliConfig verbosity targetStrings
without config = withoutProject (config <> cliConfig) verbosity targetStrings
(baseCtx, targetSelectors, finalizer, replType) <-
withProjectOrGlobalConfigIgn ignoreProject verbosity globalConfigFlag with without
withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag with without
when (buildSettingOnlyDeps (buildSettings baseCtx)) $
die' verbosity $ "The repl command does not support '--only-dependencies'. "
......@@ -296,6 +295,7 @@ replAction flags@NixStyleFlags { extraFlags = (replFlags, envFlags), ..} targetS
finalizer
where
verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
ignoreProject = envIgnoreProject envFlags
cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here
globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)
......
......@@ -47,7 +47,7 @@ import Distribution.Simple.Utils
, createTempDirectory, handleDoesNotExist )
import Distribution.Client.ProjectConfig
( ProjectConfig(..), ProjectConfigShared(..)
, withProjectOrGlobalConfigIgn )
, withProjectOrGlobalConfig )
import Distribution.Client.ProjectPlanning
( ElaboratedConfiguredPackage(..)
, ElaboratedInstallPlan, binDirectoryFor )
......@@ -165,10 +165,7 @@ runAction flags@NixStyleFlags {extraFlags=clientRunFlags, ..} targetStrings glob
distDirLayout <- establishDummyDistDirLayout verbosity (config <> cliConfig) tmpDir
establishDummyProjectBaseContext verbosity (config <> cliConfig) distDirLayout [] OtherCommand
let
ignoreProject = fromFlagOrDefault False (crunIgnoreProject clientRunFlags)
baseCtx <- withProjectOrGlobalConfigIgn ignoreProject verbosity globalConfigFlag with without
baseCtx <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag with without
let
scriptOrError script err = do
......@@ -297,6 +294,7 @@ runAction flags@NixStyleFlags {extraFlags=clientRunFlags, ..} targetStrings glob
handleDoesNotExist () (removeDirectoryRecursive tmpDir)
where
verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
ignoreProject = crunIgnoreProject clientRunFlags
cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here
globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)
......
......@@ -29,7 +29,7 @@ import Distribution.Client.Types
import Distribution.Client.DistDirLayout
( DistDirLayout(..), ProjectRoot (..) )
import Distribution.Client.ProjectConfig
( ProjectConfig, withProjectOrGlobalConfigIgn, commandLineFlagsToProjectConfig, projectConfigConfigFile, projectConfigShared )
( ProjectConfig, withProjectOrGlobalConfig, commandLineFlagsToProjectConfig, projectConfigConfigFile, projectConfigShared )
import Distribution.Client.ProjectFlags
( ProjectFlags (..), defaultProjectFlags, projectFlagsOptions )
......@@ -150,7 +150,7 @@ sdistOptions showOrParseArgs =
sdistAction :: (ProjectFlags, SdistFlags) -> [String] -> GlobalFlags -> IO ()
sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do
(baseCtx, distDirLayout) <- withProjectOrGlobalConfigIgn ignoreProject verbosity globalConfigFlag withProject withoutProject
(baseCtx, distDirLayout) <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag withProject withoutProject
let localPkgs = localPackages baseCtx
......@@ -199,7 +199,7 @@ sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do
listSources = fromFlagOrDefault False sdistListSources
nulSeparated = fromFlagOrDefault False sdistNulSeparated
mOutputPath = flagToMaybe sdistOutputPath
ignoreProject = fromFlagOrDefault False flagIgnoreProject
ignoreProject = flagIgnoreProject
prjConfig :: ProjectConfig
prjConfig = commandLineFlagsToProjectConfig
......
......@@ -24,7 +24,7 @@ import Distribution.Client.ProjectConfig
( ProjectConfig(..)
, ProjectConfigShared(projectConfigConfigFile)
, projectConfigWithSolverRepoContext
, withProjectOrGlobalConfigIgn )
, withProjectOrGlobalConfig )
import Distribution.Client.ProjectFlags
( ProjectFlags (..) )
import Distribution.Client.Types
......@@ -120,9 +120,9 @@ instance Parsec UpdateRequest where
updateAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
updateAction flags@NixStyleFlags {..} extraArgs globalFlags = do
let ignoreProject = fromFlagOrDefault False (flagIgnoreProject projectFlags)
let ignoreProject = flagIgnoreProject projectFlags
projectConfig <- withProjectOrGlobalConfigIgn ignoreProject verbosity globalConfigFlag
projectConfig <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag
(projectConfig <$> establishProjectBaseContext verbosity cliConfig OtherCommand)
(\globalConfig -> return $ globalConfig <> cliConfig)
......
......@@ -29,7 +29,6 @@ module Distribution.Client.ProjectConfig (
readGlobalConfig,
readProjectLocalFreezeConfig,
withProjectOrGlobalConfig,
withProjectOrGlobalConfigIgn,
writeProjectLocalExtraConfig,
writeProjectLocalFreezeConfig,
writeProjectConfigFile,
......@@ -455,30 +454,26 @@ renderBadProjectRoot :: BadProjectRoot -> String
renderBadProjectRoot (BadProjectRootExplicitFile projectFile) =
"The given project file '" ++ projectFile ++ "' does not exist."
-- | Like 'withProjectOrGlobalConfig', with an additional boolean
-- which tells to ignore local project.
--
-- Used to implement -z / --ignore-project behaviour
--
withProjectOrGlobalConfigIgn
:: Bool -- ^ whether to ignore local project
-> Verbosity
-> Flag FilePath -- ^ global config file
-> IO a
-> (ProjectConfig -> IO a)
withProjectOrGlobalConfig
:: Verbosity -- ^ verbosity
-> Flag Bool -- ^ whether to ignore local project
-> Flag FilePath -- ^ @--cabal-config@
-> IO a -- ^ with project
-> (ProjectConfig -> IO a) -- ^ without projet
-> IO a
withProjectOrGlobalConfigIgn True verbosity gcf _with without = do
withProjectOrGlobalConfig verbosity (Flag True) gcf _with without = do
globalConfig <- runRebuild "" $ readGlobalConfig verbosity gcf
without globalConfig
withProjectOrGlobalConfigIgn False verbosity gcf with without =
withProjectOrGlobalConfig verbosity gcf with without
withProjectOrGlobalConfig :: Verbosity
-> Flag FilePath
-> IO a
-> (ProjectConfig -> IO a)
-> IO a
withProjectOrGlobalConfig verbosity globalConfigFlag with without = do
withProjectOrGlobalConfig verbosity _ignorePrj gcf with without =
withProjectOrGlobalConfig' verbosity gcf with without
withProjectOrGlobalConfig'
:: Verbosity
-> Flag FilePath
-> IO a
-> (ProjectConfig -> IO a)
-> IO a
withProjectOrGlobalConfig' verbosity globalConfigFlag with without = do
globalConfig <- runRebuild "" $ readGlobalConfig verbosity globalConfigFlag
let
......
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