Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

SetupWrapper: Filtering for Setup arguments #5261

Merged
merged 1 commit into from
Jun 8, 2018
Merged

SetupWrapper: Filtering for Setup arguments #5261

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions cabal-install/Distribution/Client/Configure.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -134,7 +134,7 @@ configure verbosity packageDBs repoCtxt comp platform progdb
++ message
++ "\nTrying configure anyway."
setupWrapper verbosity (setupScriptOptions installedPkgIndex Nothing)
Nothing configureCommand (const configFlags) extraArgs
Nothing configureCommand (const configFlags) (const extraArgs)

Right installPlan0 ->
let installPlan = InstallPlan.configureInstallPlan configFlags installPlan0
Expand Down Expand Up @@ -387,7 +387,7 @@ configurePackage verbosity platform comp scriptOptions configFlags
extraArgs =

setupWrapper verbosity
scriptOptions (Just pkg) configureCommand configureFlags extraArgs
scriptOptions (Just pkg) configureCommand configureFlags (const extraArgs)

where
gpkg = packageDescription spkg
Expand Down
2 changes: 1 addition & 1 deletion cabal-install/Distribution/Client/Install.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1551,7 +1551,7 @@ installUnpackedPackage verbosity installLock numJobs
scriptOptions { useLoggingHandle = logFileHandle
, useWorkingDir = workingDir }
(Just pkg)
cmd flags [])
cmd flags (const []))


-- helper
Expand Down
33 changes: 18 additions & 15 deletions cabal-install/Distribution/Client/ProjectBuilding.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -60,7 +60,9 @@ import Distribution.Client.JobControl
import Distribution.Client.FetchUtils
import Distribution.Client.GlobalFlags (RepoContext)
import qualified Distribution.Client.Tar as Tar
import Distribution.Client.Setup (filterConfigureFlags)
import Distribution.Client.Setup
( filterConfigureFlags, filterHaddockArgs
, filterHaddockFlags )
import Distribution.Client.SourceFiles
import Distribution.Client.SrcDist (allPackageSourceFiles)
import Distribution.Client.Utils (removeExistingFile)
Expand Down Expand Up @@ -1039,7 +1041,7 @@ buildAndInstallUnpackedPackage verbosity
configureFlags v = flip filterConfigureFlags v $
setupHsConfigureFlags rpkg pkgshared
verbosity builddir
configureArgs = setupHsConfigureArgs pkg
configureArgs _ = setupHsConfigureArgs pkg

buildCommand = Cabal.buildCommand defaultProgramDb
buildFlags _ = setupHsBuildFlags pkg pkgshared verbosity builddir
Expand All @@ -1065,9 +1067,9 @@ buildAndInstallUnpackedPackage verbosity
isParallelBuild cacheLock

setup :: CommandUI flags -> (Version -> flags) -> IO ()
setup cmd flags = setup' cmd flags []
setup cmd flags = setup' cmd flags (const [])

setup' :: CommandUI flags -> (Version -> flags) -> [String] -> IO ()
setup' :: CommandUI flags -> (Version -> flags) -> (Version -> [String]) -> IO ()
setup' cmd flags args =
withLogging $ \mLogFileHandle ->
setupWrapper
Expand Down Expand Up @@ -1283,46 +1285,48 @@ buildInplaceUnpackedPackage verbosity
configureFlags v = flip filterConfigureFlags v $
setupHsConfigureFlags rpkg pkgshared
verbosity builddir
configureArgs = setupHsConfigureArgs pkg
configureArgs _ = setupHsConfigureArgs pkg

buildCommand = Cabal.buildCommand defaultProgramDb
buildFlags _ = setupHsBuildFlags pkg pkgshared
verbosity builddir
buildArgs = setupHsBuildArgs pkg
buildArgs _ = setupHsBuildArgs pkg

testCommand = Cabal.testCommand -- defaultProgramDb
testFlags _ = setupHsTestFlags pkg pkgshared
verbosity builddir
testArgs = setupHsTestArgs pkg
testArgs _ = setupHsTestArgs pkg

benchCommand = Cabal.benchmarkCommand
benchFlags _ = setupHsBenchFlags pkg pkgshared
verbosity builddir
benchArgs = setupHsBenchArgs pkg
benchArgs _ = setupHsBenchArgs pkg

replCommand = Cabal.replCommand defaultProgramDb
replFlags _ = setupHsReplFlags pkg pkgshared
verbosity builddir
replArgs = setupHsReplArgs pkg
replArgs _ = setupHsReplArgs pkg

haddockCommand = Cabal.haddockCommand
haddockFlags _ = setupHsHaddockFlags pkg pkgshared
haddockFlags v = flip filterHaddockFlags v $
setupHsHaddockFlags pkg pkgshared
verbosity builddir
haddockArgs = setupHsHaddockArgs pkg
haddockArgs v = flip filterHaddockArgs v $
setupHsHaddockArgs pkg

scriptOptions = setupHsScriptOptions rpkg plan pkgshared
srcdir builddir
isParallelBuild cacheLock

setupInteractive :: CommandUI flags
-> (Version -> flags) -> [String] -> IO ()
-> (Version -> flags) -> (Version -> [String]) -> IO ()
setupInteractive cmd flags args =
setupWrapper verbosity
scriptOptions { isInteractive = True }
(Just (elabPkgDescription pkg))
cmd flags args

setup :: CommandUI flags -> (Version -> flags) -> [String] -> IO ()
setup :: CommandUI flags -> (Version -> flags) -> (Version -> [String]) -> IO ()
setup cmd flags args =
setupWrapper verbosity
scriptOptions
Expand All @@ -1337,7 +1341,7 @@ buildInplaceUnpackedPackage verbosity
pkg pkgshared
verbosity builddir
pkgConfDest
setup Cabal.registerCommand registerFlags []
setup Cabal.registerCommand registerFlags (const [])

withTempInstalledPackageInfoFile :: Verbosity -> FilePath
-> (FilePath -> IO ())
Expand Down Expand Up @@ -1397,4 +1401,3 @@ annotateFailure mlogFile annotate action =
where
handler :: Exception e => e -> IO a
handler = throwIO . BuildFailure mlogFile . annotate . toException

2 changes: 0 additions & 2 deletions cabal-install/Distribution/Client/ProjectPlanning.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3426,8 +3426,6 @@ setupHsHaddockFlags :: ElaboratedConfiguredPackage
-> Verbosity
-> FilePath
-> Cabal.HaddockFlags
-- TODO: reconsider whether or not Executables/TestSuites/...
-- needed for component
setupHsHaddockFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir =
Cabal.HaddockFlags {
haddockProgramPaths = mempty, --unused, set at configure time
Expand Down
25 changes: 25 additions & 0 deletions cabal-install/Distribution/Client/Setup.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@ module Distribution.Client.Setup
, replCommand, testCommand, benchmarkCommand
, configureExOptions, reconfigureCommand
, installCommand, InstallFlags(..), installOptions, defaultInstallFlags
, filterHaddockArgs, filterHaddockFlags
, defaultSolver, defaultMaxBackjumps
, listCommand, ListFlags(..)
, updateCommand, UpdateFlags(..), defaultUpdateFlags
Expand Down Expand Up @@ -1648,6 +1649,30 @@ installCommand = CommandUI {
get3 (_,_,c,_) = c; set3 c (a,b,_,d) = (a,b,c,d)
get4 (_,_,_,d) = d; set4 d (a,b,c,_) = (a,b,c,d)

filterHaddockArgs :: [String] -> Version -> [String]
filterHaddockArgs args cabalLibVersion
| cabalLibVersion >= mkVersion [2,3,0] = args_latest
| cabalLibVersion < mkVersion [2,3,0] = args_2_3_0
| otherwise = args_latest
where
args_latest = args

-- Cabal < 2.3 doesn't know about per-component haddock
args_2_3_0 = []

filterHaddockFlags :: HaddockFlags -> Version -> HaddockFlags
filterHaddockFlags flags cabalLibVersion
Copy link
Member Author

@alexbiehl alexbiehl Apr 15, 2018 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@harpocrates I think #5236 needs proper version gating for --haddock-quickjump on older Cabal's too! (@hvr, right?)

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Doesn't this PR solve the problem for quickjump too (via filterHaddockFlags)? Assuming the quickjump PR makes it into 2.3 too, --quickjump should also only be let through on Cabal >=2.3.0, right?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Correct

| cabalLibVersion >= mkVersion [2,3,0] = flags_latest
| cabalLibVersion < mkVersion [2,3,0] = flags_2_3_0
| otherwise = flags_latest
where
flags_latest = flags

flags_2_3_0 = flags_latest {
-- Cabal < 2.3 doesn't know about per-component haddock
haddockArgs = []
}

haddockOptions :: ShowOrParseArgs -> [OptionField HaddockFlags]
haddockOptions showOrParseArgs
= [ opt { optionName = "haddock-" ++ name,
Expand Down
8 changes: 5 additions & 3 deletions cabal-install/Distribution/Client/SetupWrapper.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -392,7 +392,7 @@ verbosityHack ver args0
runSetupCommand :: Verbosity -> Setup
-> CommandUI flags -- ^ command definition
-> flags -- ^ command flags
-> [String] -- ^ extra command-line arguments
-> [String] -- ^ extra command-line arguments
-> IO ()
runSetupCommand verbosity setup cmd flags extraArgs = do
let args = commandName cmd : commandShowOptions cmd flags ++ extraArgs
Expand All @@ -406,11 +406,13 @@ setupWrapper :: Verbosity
-> CommandUI flags
-> (Version -> flags)
-- ^ produce command flags given the Cabal library version
-> [String]
-> (Version -> [String])
-> IO ()
setupWrapper verbosity options mpkg cmd flags extraArgs = do
setup <- getSetup verbosity options mpkg
runSetupCommand verbosity setup cmd (flags $ setupVersion setup) extraArgs
runSetupCommand verbosity setup
cmd (flags $ setupVersion setup)
(extraArgs $ setupVersion setup)

-- ------------------------------------------------------------
-- * Internal SetupMethod
Expand Down
4 changes: 2 additions & 2 deletions cabal-install/Distribution/Client/SrcDist.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,7 @@ sdist flags exflags = do
-- Run 'setup sdist --output-directory=tmpDir' (or
-- '--list-source'/'--output-directory=someOtherDir') in case we were passed
-- those options.
setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags') []
setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags') (const [])

-- Unless we were given --list-sources or --output-directory ourselves,
-- create an archive.
Expand Down Expand Up @@ -176,7 +176,7 @@ allPackageSourceFiles verbosity setupOpts0 packageDir = do

doListSources :: IO [FilePath]
doListSources = do
setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags) []
setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags) (const [])
fmap lines . readFile $ file

onFailedListSources :: IOException -> IO ()
Expand Down
18 changes: 9 additions & 9 deletions cabal-install/main/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -358,7 +358,7 @@ wrapperAction command verbosityFlag distPrefFlag =
distPref <- findSavedDistPref config (distPrefFlag flags)
let setupScriptOptions = defaultSetupScriptOptions { useDistPref = distPref }
setupWrapper verbosity setupScriptOptions Nothing
command (const flags) extraArgs
command (const flags) (const extraArgs)

configureAction :: (ConfigFlags, ConfigExFlags)
-> [String] -> Action
Expand Down Expand Up @@ -455,7 +455,7 @@ buildAction (buildFlags, buildExFlags) extraArgs globalFlags = do
build :: Verbosity -> SavedConfig -> FilePath -> BuildFlags -> [String] -> IO ()
build verbosity config distPref buildFlags extraArgs =
setupWrapper verbosity setupOptions Nothing
(Cabal.buildCommand progDb) mkBuildFlags extraArgs
(Cabal.buildCommand progDb) mkBuildFlags (const extraArgs)
where
progDb = defaultProgramDb
setupOptions = defaultSetupScriptOptions { useDistPref = distPref }
Expand Down Expand Up @@ -521,7 +521,7 @@ replAction (replFlags, buildExFlags) extraArgs globalFlags = do
nixShell verbosity distPref globalFlags config $ do
maybeWithSandboxDirOnSearchPath useSandbox $
setupWrapper verbosity setupOptions Nothing
(Cabal.replCommand progDb) (const replFlags') extraArgs
(Cabal.replCommand progDb) (const replFlags') (const extraArgs)

-- No .cabal file in the current directory: just start the REPL (possibly
-- using the sandbox package DB).
Expand Down Expand Up @@ -549,7 +549,7 @@ installAction (configFlags, _, installFlags, _) _ globalFlags
nixShellIfSandboxed verb dist globalFlags config useSandbox $
setupWrapper
verb setupOpts Nothing
installCommand (const mempty) []
installCommand (const mempty) (const [])

installAction
(configFlags, configExFlags, installFlags, haddockFlags)
Expand Down Expand Up @@ -679,7 +679,7 @@ testAction (testFlags, buildFlags, buildExFlags) extraArgs globalFlags = do

maybeWithSandboxDirOnSearchPath useSandbox $
setupWrapper verbosity setupOptions Nothing
Cabal.testCommand (const testFlags') extraArgs'
Cabal.testCommand (const testFlags') (const extraArgs')

data ComponentNames = ComponentNamesUnknown
| ComponentNames [LBI.ComponentName]
Expand Down Expand Up @@ -762,7 +762,7 @@ benchmarkAction

maybeWithSandboxDirOnSearchPath useSandbox $
setupWrapper verbosity setupOptions Nothing
Cabal.benchmarkCommand (const benchmarkFlags') extraArgs'
Cabal.benchmarkCommand (const benchmarkFlags') (const extraArgs')

haddockAction :: HaddockFlags -> [String] -> Action
haddockAction haddockFlags extraArgs globalFlags = do
Expand All @@ -780,7 +780,7 @@ haddockAction haddockFlags extraArgs globalFlags = do
setupScriptOptions = defaultSetupScriptOptions
{ useDistPref = distPref }
setupWrapper verbosity setupScriptOptions Nothing
haddockCommand (const haddockFlags') extraArgs
haddockCommand (const haddockFlags') (const extraArgs)
when (haddockForHackage haddockFlags == Flag ForHackage) $ do
pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)
let dest = distPref </> name <.> "tar.gz"
Expand All @@ -794,7 +794,7 @@ doctestAction doctestFlags extraArgs _globalFlags = do
let verbosity = fromFlag (doctestVerbosity doctestFlags)

setupWrapper verbosity defaultSetupScriptOptions Nothing
doctestCommand (const doctestFlags) extraArgs
doctestCommand (const doctestFlags) (const extraArgs)

cleanAction :: CleanFlags -> [String] -> Action
cleanAction cleanFlags extraArgs globalFlags = do
Expand All @@ -807,7 +807,7 @@ cleanAction cleanFlags extraArgs globalFlags = do
}
cleanFlags' = cleanFlags { cleanDistPref = toFlag distPref }
setupWrapper verbosity setupScriptOptions Nothing
cleanCommand (const cleanFlags') extraArgs
cleanCommand (const cleanFlags') (const extraArgs)
where
verbosity = fromFlagOrDefault normal (cleanVerbosity cleanFlags)

Expand Down