Skip to content
Snippets Groups Projects
Commit d89fedd6 authored by Andres Löh's avatar Andres Löh
Browse files

handling the solver options properly in config file

parent d7fef65c
No related branches found
No related tags found
No related merge requests found
...@@ -346,7 +346,7 @@ configFieldDescriptions = ...@@ -346,7 +346,7 @@ configFieldDescriptions =
++ toSavedConfig liftConfigFlag ++ toSavedConfig liftConfigFlag
(configureOptions ParseArgs) (configureOptions ParseArgs)
(["builddir", "configure-option"] ++ map fieldName installDirsFields) (["builddir", "configure-option", "constraint"] ++ map fieldName installDirsFields)
--FIXME: this is only here because viewAsFieldDescr gives us a parser --FIXME: this is only here because viewAsFieldDescr gives us a parser
-- that only recognises 'ghc' etc, the case-sensitive flag names, not -- that only recognises 'ghc' etc, the case-sensitive flag names, not
...@@ -387,7 +387,7 @@ configFieldDescriptions = ...@@ -387,7 +387,7 @@ configFieldDescriptions =
++ toSavedConfig liftInstallFlag ++ toSavedConfig liftInstallFlag
(installOptions ParseArgs) (installOptions ParseArgs)
["dry-run", "reinstall", "only"] [] ["dry-run", "only"] []
++ toSavedConfig liftUploadFlag ++ toSavedConfig liftUploadFlag
(commandOptions uploadCommand ParseArgs) (commandOptions uploadCommand ParseArgs)
......
...@@ -53,7 +53,7 @@ import qualified Distribution.Simple.Setup as Cabal ...@@ -53,7 +53,7 @@ import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Setup import Distribution.Simple.Setup
( ConfigFlags(..), SDistFlags(..), HaddockFlags(..) ) ( ConfigFlags(..), SDistFlags(..), HaddockFlags(..) )
import Distribution.Simple.Setup import Distribution.Simple.Setup
( Flag(..), toFlag, fromFlag, flagToList ( Flag(..), toFlag, fromFlag, flagToMaybe, flagToList
, optionVerbosity, boolOpt, trueArg, falseArg ) , optionVerbosity, boolOpt, trueArg, falseArg )
import Distribution.Simple.InstallDirs import Distribution.Simple.InstallDirs
( PathTemplate, toPathTemplate, fromPathTemplate ) ( PathTemplate, toPathTemplate, fromPathTemplate )
...@@ -334,7 +334,7 @@ fetchCommand = CommandUI { ...@@ -334,7 +334,7 @@ fetchCommand = CommandUI {
commandDescription = Nothing, commandDescription = Nothing,
commandUsage = usagePackages "fetch", commandUsage = usagePackages "fetch",
commandDefaultFlags = defaultFetchFlags, commandDefaultFlags = defaultFetchFlags,
commandOptions = \_ -> [ commandOptions = \ showOrParseArgs -> [
optionVerbosity fetchVerbosity (\v flags -> flags { fetchVerbosity = v }) optionVerbosity fetchVerbosity (\v flags -> flags { fetchVerbosity = v })
-- , option "o" ["output"] -- , option "o" ["output"]
...@@ -360,7 +360,8 @@ fetchCommand = CommandUI { ...@@ -360,7 +360,8 @@ fetchCommand = CommandUI {
] ++ ] ++
optionSolver fetchSolver (\v flags -> flags { fetchSolver = v }) : optionSolver fetchSolver (\v flags -> flags { fetchSolver = v }) :
optionSolverFlags fetchMaxBackjumps (\v flags -> flags { fetchMaxBackjumps = v }) optionSolverFlags showOrParseArgs
fetchMaxBackjumps (\v flags -> flags { fetchMaxBackjumps = v })
fetchReorderGoals (\v flags -> flags { fetchReorderGoals = v }) fetchReorderGoals (\v flags -> flags { fetchReorderGoals = v })
fetchIndependentGoals (\v flags -> flags { fetchIndependentGoals = v }) fetchIndependentGoals (\v flags -> flags { fetchIndependentGoals = v })
fetchShadowPkgs (\v flags -> flags { fetchShadowPkgs = v }) fetchShadowPkgs (\v flags -> flags { fetchShadowPkgs = v })
...@@ -721,7 +722,8 @@ installOptions showOrParseArgs = ...@@ -721,7 +722,8 @@ installOptions showOrParseArgs =
trueArg trueArg
] ++ ] ++
optionSolverFlags installMaxBackjumps (\v flags -> flags { installMaxBackjumps = v }) optionSolverFlags showOrParseArgs
installMaxBackjumps (\v flags -> flags { installMaxBackjumps = v })
installReorderGoals (\v flags -> flags { installReorderGoals = v }) installReorderGoals (\v flags -> flags { installReorderGoals = v })
installIndependentGoals (\v flags -> flags { installIndependentGoals = v }) installIndependentGoals (\v flags -> flags { installIndependentGoals = v })
installShadowPkgs (\v flags -> flags { installShadowPkgs = v }) ++ installShadowPkgs (\v flags -> flags { installShadowPkgs = v }) ++
...@@ -729,28 +731,27 @@ installOptions showOrParseArgs = ...@@ -729,28 +731,27 @@ installOptions showOrParseArgs =
[ option [] ["reinstall"] [ option [] ["reinstall"]
"Install even if it means installing the same version again." "Install even if it means installing the same version again."
installReinstall (\v flags -> flags { installReinstall = v }) installReinstall (\v flags -> flags { installReinstall = v })
trueArg (yesNoOpt showOrParseArgs)
, option [] ["avoid-reinstalls"] , option [] ["avoid-reinstalls"]
"Do not select versions that would destructively overwrite installed packages." "Do not select versions that would destructively overwrite installed packages."
installAvoidReinstalls (\v flags -> flags { installAvoidReinstalls = v }) installAvoidReinstalls (\v flags -> flags { installAvoidReinstalls = v })
trueArg (yesNoOpt showOrParseArgs)
, option [] ["force-reinstalls"] , option [] ["force-reinstalls"]
"Reinstall packages even if they will most likely break other installed packages." "Reinstall packages even if they will most likely break other installed packages."
installOverrideReinstall (\v flags -> flags { installOverrideReinstall = v }) installOverrideReinstall (\v flags -> flags { installOverrideReinstall = v })
trueArg (yesNoOpt showOrParseArgs)
, option [] ["upgrade-dependencies"] , option [] ["upgrade-dependencies"]
"Pick the latest version for all dependencies, rather than trying to pick an installed version." "Pick the latest version for all dependencies, rather than trying to pick an installed version."
installUpgradeDeps (\v flags -> flags { installUpgradeDeps = v }) installUpgradeDeps (\v flags -> flags { installUpgradeDeps = v })
trueArg (yesNoOpt showOrParseArgs)
, option [] ["only-dependencies"] , option [] ["only-dependencies"]
"Install only the dependencies necessary to build the given packages" "Install only the dependencies necessary to build the given packages"
installOnlyDeps (\v flags -> flags { installOnlyDeps = v }) installOnlyDeps (\v flags -> flags { installOnlyDeps = v })
trueArg (yesNoOpt showOrParseArgs)
, option [] ["root-cmd"] , option [] ["root-cmd"]
"Command used to gain root privileges, when installing with --global." "Command used to gain root privileges, when installing with --global."
...@@ -784,7 +785,7 @@ installOptions showOrParseArgs = ...@@ -784,7 +785,7 @@ installOptions showOrParseArgs =
, option [] ["one-shot"] , option [] ["one-shot"]
"Do not record the packages in the world file." "Do not record the packages in the world file."
installOneShot (\v flags -> flags { installOneShot = v }) installOneShot (\v flags -> flags { installOneShot = v })
trueArg (yesNoOpt showOrParseArgs)
] ++ case showOrParseArgs of -- TODO: remove when "cabal install" avoids ] ++ case showOrParseArgs of -- TODO: remove when "cabal install" avoids
ParseArgs -> ParseArgs ->
option [] ["only"] option [] ["only"]
...@@ -1110,14 +1111,18 @@ instance Monoid SDistExFlags where ...@@ -1110,14 +1111,18 @@ instance Monoid SDistExFlags where
-- * GetOpt Utils -- * GetOpt Utils
-- ------------------------------------------------------------ -- ------------------------------------------------------------
reqArgFlag :: ArgPlaceHolder -> SFlags -> LFlags -> Description -> reqArgFlag :: ArgPlaceHolder ->
(b -> Flag String) -> (Flag String -> b -> b) -> OptDescr b MkOptDescr (b -> Flag String) (Flag String -> b -> b) b
reqArgFlag ad = reqArg ad (succeedReadE Flag) flagToList reqArgFlag ad = reqArg ad (succeedReadE Flag) flagToList
liftOptions :: (b -> a) -> (a -> b -> b) liftOptions :: (b -> a) -> (a -> b -> b)
-> [OptionField a] -> [OptionField b] -> [OptionField a] -> [OptionField b]
liftOptions get set = map (liftOption get set) liftOptions get set = map (liftOption get set)
yesNoOpt :: ShowOrParseArgs -> MkOptDescr (b -> Flag Bool) (Flag Bool -> (b -> b)) b
yesNoOpt ShowArgs sf lf = trueArg sf lf
yesNoOpt _ sf lf = boolOpt' flagToMaybe Flag (sf, lf) ([], map ("no-" ++) lf) sf lf
optionSolver :: (flags -> Flag PreSolver) optionSolver :: (flags -> Flag PreSolver)
-> (Flag PreSolver -> flags -> flags) -> (Flag PreSolver -> flags -> flags)
-> OptionField flags -> OptionField flags
...@@ -1129,12 +1134,13 @@ optionSolver get set = ...@@ -1129,12 +1134,13 @@ optionSolver get set =
(toFlag `fmap` parse)) (toFlag `fmap` parse))
(flagToList . fmap display)) (flagToList . fmap display))
optionSolverFlags :: (flags -> Flag Int ) -> (Flag Int -> flags -> flags) optionSolverFlags :: ShowOrParseArgs
-> (flags -> Flag Int ) -> (Flag Int -> flags -> flags)
-> (flags -> Flag Bool ) -> (Flag Bool -> flags -> flags) -> (flags -> Flag Bool ) -> (Flag Bool -> flags -> flags)
-> (flags -> Flag Bool ) -> (Flag Bool -> flags -> flags) -> (flags -> Flag Bool ) -> (Flag Bool -> flags -> flags)
-> (flags -> Flag Bool ) -> (Flag Bool -> flags -> flags) -> (flags -> Flag Bool ) -> (Flag Bool -> flags -> flags)
-> [OptionField flags] -> [OptionField flags]
optionSolverFlags getmbj setmbj getrg setrg getig setig getsip setsip = optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg _getig _setig getsip setsip =
[ option [] ["max-backjumps"] [ option [] ["max-backjumps"]
("Maximum number of backjumps allowed while solving (default: " ++ show defaultMaxBackjumps ++ "). Use a negative number to enable unlimited backtracking. Use 0 to disable backtracking completely.") ("Maximum number of backjumps allowed while solving (default: " ++ show defaultMaxBackjumps ++ "). Use a negative number to enable unlimited backtracking. Use 0 to disable backtracking completely.")
getmbj setmbj getmbj setmbj
...@@ -1144,11 +1150,14 @@ optionSolverFlags getmbj setmbj getrg setrg getig setig getsip setsip = ...@@ -1144,11 +1150,14 @@ optionSolverFlags getmbj setmbj getrg setrg getig setig getsip setsip =
, option [] ["reorder-goals"] , option [] ["reorder-goals"]
"Try to reorder goals according to certain heuristics. Slows things down on average, but may make backtracking faster for some packages." "Try to reorder goals according to certain heuristics. Slows things down on average, but may make backtracking faster for some packages."
getrg setrg getrg setrg
trueArg (yesNoOpt showOrParseArgs)
-- TODO: Disabled for now because it does not work as advertised (yet).
{-
, option [] ["independent-goals"] , option [] ["independent-goals"]
"Treat several goals on the command line as independent. If several goals depend on the same package, different versions can be chosen." "Treat several goals on the command line as independent. If several goals depend on the same package, different versions can be chosen."
getig setig getig setig
trueArg (yesNoOpt showOrParseArgs)
-}
, option [] ["shadow-installed-packages"] , option [] ["shadow-installed-packages"]
"If multiple package instances of the same version are installed, treat all but one as shadowed." "If multiple package instances of the same version are installed, treat all but one as shadowed."
getsip setsip getsip setsip
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment