Skip to content

Commit

Permalink
SetupWrapper: Allow Setup version based filtering of extra arguments
Browse files Browse the repository at this point in the history
  • Loading branch information
alexbiehl authored and 23Skidoo committed Jun 8, 2018
1 parent 7375628 commit 9d230da
Show file tree
Hide file tree
Showing 8 changed files with 62 additions and 34 deletions.
4 changes: 2 additions & 2 deletions cabal-install/Distribution/Client/Configure.hs
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
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
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
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
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
| 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
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
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
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

0 comments on commit 9d230da

Please sign in to comment.