Commit 1a3ff039 authored by Andres Löh's avatar Andres Löh

choose default solver based on compiler version

GHC-6.12 has base-3 depending on base-4. This is a situation the
topdown solver is hacked to deal with, but the new modular solver
currently doesn't support it. We therefore switch back to the
topdown solver if a GHC version before 7 is detected, but switch
to the modular solver by default in all other situations.
parent cf195f32
......@@ -130,6 +130,7 @@ planLocalPackage :: Verbosity -> Compiler
planLocalPackage verbosity comp configFlags configExFlags installedPkgIndex
(SourcePackageDb _ packagePrefs) = do
pkg <- readPackageDescription verbosity =<< defaultPackageDesc verbosity
solver <- chooseSolver verbosity (fromFlag $ configSolver configExFlags) (compilerId comp)
let -- We create a local package and ask to resolve a dependency on it
localPkg = SourcePackage {
......@@ -138,8 +139,6 @@ planLocalPackage verbosity comp configFlags configExFlags installedPkgIndex
packageSource = LocalUnpackedPackage "."
}
solver = fromFlag $ configSolver configExFlags
testsEnabled = fromFlagOrDefault False $ configTests configFlags
benchmarksEnabled =
fromFlagOrDefault False $ configBenchmarks configFlags
......
......@@ -14,6 +14,7 @@
-----------------------------------------------------------------------------
module Distribution.Client.Dependency (
-- * The main package dependency resolver
chooseSolver,
resolveDependencies,
Progress(..),
foldProgress,
......@@ -64,7 +65,7 @@ import Distribution.Client.Types
( SourcePackageDb(SourcePackageDb)
, SourcePackage(..) )
import Distribution.Client.Dependency.Types
( Solver(..), DependencyResolver, PackageConstraint(..)
( PreSolver(..), Solver(..), DependencyResolver, PackageConstraint(..)
, PackagePreferences(..), InstalledPreference(..)
, PackagesPreferenceDefault(..)
, Progress(..), foldProgress )
......@@ -74,14 +75,17 @@ import Distribution.Package
( PackageName(..), PackageId, Package(..), packageVersion
, InstalledPackageId, Dependency(Dependency))
import Distribution.Version
( VersionRange, anyVersion, withinRange, simplifyVersionRange )
( Version(..), VersionRange, anyVersion, withinRange, simplifyVersionRange )
import Distribution.Compiler
( CompilerId(..) )
( CompilerId(..), CompilerFlavor(..) )
import Distribution.System
( Platform )
import Distribution.Simple.Utils (comparing)
import Distribution.Simple.Utils
( comparing, warn, info )
import Distribution.Text
( display )
import Distribution.Verbosity
( Verbosity )
import Data.List (maximumBy, foldl')
import Data.Maybe (fromMaybe)
......@@ -305,6 +309,17 @@ standardInstallPolicy
-- * Interface to the standard resolver
-- ------------------------------------------------------------
chooseSolver :: Verbosity -> PreSolver -> CompilerId -> IO Solver
chooseSolver _ AlwaysTopDown _ = return TopDown
chooseSolver _ AlwaysModular _ = return Modular
chooseSolver verbosity Choose (CompilerId f v) = do
let chosenSolver | f == GHC && v <= Version [7] [] = TopDown
| otherwise = Modular
msg TopDown = warn verbosity "Falling back to topdown solver for GHC < 7."
msg Modular = info verbosity "Choosing modular solver."
msg chosenSolver
return chosenSolver
runSolver :: Solver -> SolverConfig -> DependencyResolver
runSolver TopDown = const topDownResolver -- TODO: warn about unsuported options
runSolver Modular = modularResolver
......
......@@ -13,6 +13,7 @@
module Distribution.Client.Dependency.Types (
ExtDependency(..),
PreSolver(..),
Solver(..),
DependencyResolver,
......@@ -76,17 +77,23 @@ instance Text ExtDependency where
parse = (SourceDependency `fmap` parse) <++ (InstalledDependency `fmap` parse)
-- | All the solvers that can be selected.
data PreSolver = AlwaysTopDown | AlwaysModular | Choose
deriving (Eq, Ord, Show, Bounded, Enum)
-- | All the solvers that can be used.
data Solver = TopDown | Modular
deriving (Eq, Ord, Show, Bounded, Enum)
instance Text Solver where
disp TopDown = text "topdown"
disp Modular = text "modular"
instance Text PreSolver where
disp AlwaysTopDown = text "topdown"
disp AlwaysModular = text "modular"
disp Choose = text "choose"
parse = do
name <- Parse.munch1 isAlpha
case map toLower name of
"topdown" -> return TopDown
"modular" -> return Modular
"topdown" -> return AlwaysTopDown
"modular" -> return AlwaysModular
"choose" -> return Choose
_ -> Parse.pfail
-- | A dependency resolver is a function that works out an installation plan
......
......@@ -120,6 +120,7 @@ planPackages verbosity comp fetchFlags
installedPkgIndex sourcePkgDb pkgSpecifiers
| includeDependencies = do
solver <- chooseSolver verbosity (fromFlag (fetchSolver fetchFlags)) (compilerId comp)
notice verbosity "Resolving dependencies..."
installPlan <- foldProgress logMsg die return $
resolveDependencies
......@@ -159,7 +160,6 @@ planPackages verbosity comp fetchFlags
includeDependencies = fromFlag (fetchDeps fetchFlags)
logMsg message rest = debug verbosity message >> rest
solver = fromFlag (fetchSolver fetchFlags)
reorderGoals = fromFlag (fetchReorderGoals fetchFlags)
independentGoals = fromFlag (fetchIndependentGoals fetchFlags)
maxBackjumps = fromFlag (fetchMaxBackjumps fetchFlags)
......
......@@ -159,6 +159,8 @@ install verbosity packageDBs repos comp conf
installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
sourcePkgDb <- getSourcePackages verbosity repos
solver <- chooseSolver verbosity (fromFlag (configSolver configExFlags)) (compilerId comp)
let -- For install, if no target is given it means we use the
-- current directory as the single target
userTargets | null userTargets0 = [UserTargetLocalDir "."]
......@@ -172,7 +174,7 @@ install verbosity packageDBs repos comp conf
notice verbosity "Resolving dependencies..."
installPlan <- foldProgress logMsg die return $
planPackages
comp configFlags configExFlags installFlags
comp solver configFlags configExFlags installFlags
installedPkgIndex sourcePkgDb pkgSpecifiers
checkPrintPlan verbosity installedPkgIndex installPlan installFlags
......@@ -189,7 +191,6 @@ install verbosity packageDBs repos comp conf
globalFlags, configFlags, configExFlags, installFlags, haddockFlags)
dryRun = fromFlag (installDryRun installFlags)
solver = fromFlag (configSolver configExFlags)
logMsg message rest = debug verbosity message >> rest
......@@ -221,6 +222,7 @@ type InstallContext = ( PackageDBStack
-- ------------------------------------------------------------
planPackages :: Compiler
-> Solver
-> ConfigFlags
-> ConfigExFlags
-> InstallFlags
......@@ -228,7 +230,7 @@ planPackages :: Compiler
-> SourcePackageDb
-> [PackageSpecifier SourcePackage]
-> Progress String String InstallPlan
planPackages comp configFlags configExFlags installFlags
planPackages comp solver configFlags configExFlags installFlags
installedPkgIndex sourcePkgDb pkgSpecifiers =
resolveDependencies
......@@ -312,7 +314,6 @@ planPackages comp configFlags configExFlags installFlags
targetnames = map pkgSpecifierTarget pkgSpecifiers
solver = fromFlag (configSolver configExFlags)
reinstall = fromFlag (installReinstall installFlags)
reorderGoals = fromFlag (installReorderGoals installFlags)
independentGoals = fromFlag (installIndependentGoals installFlags)
......
......@@ -39,7 +39,7 @@ import Distribution.Client.Types
import Distribution.Client.BuildReports.Types
( ReportLevel(..) )
import Distribution.Client.Dependency.Types
( Solver(..) )
( PreSolver(..) )
import qualified Distribution.Client.Init.Types as IT
( InitFlags(..), PackageType(..) )
import Distribution.Client.Targets
......@@ -238,7 +238,7 @@ data ConfigExFlags = ConfigExFlags {
configCabalVersion :: Flag Version,
configExConstraints:: [UserConstraint],
configPreferences :: [Dependency],
configSolver :: Flag Solver
configSolver :: Flag PreSolver
}
defaultConfigExFlags :: ConfigExFlags
......@@ -306,7 +306,7 @@ data FetchFlags = FetchFlags {
-- fetchOutput :: Flag FilePath,
fetchDeps :: Flag Bool,
fetchDryRun :: Flag Bool,
fetchSolver :: Flag Solver,
fetchSolver :: Flag PreSolver,
fetchMaxBackjumps :: Flag Int,
fetchReorderGoals :: Flag Bool,
fetchIndependentGoals :: Flag Bool,
......@@ -640,11 +640,11 @@ defaultInstallFlags = InstallFlags {
defaultMaxBackjumps :: Int
defaultMaxBackjumps = 200
defaultSolver :: Solver
defaultSolver = TopDown
defaultSolver :: PreSolver
defaultSolver = Choose
allSolvers :: String
allSolvers = intercalate ", " (map display ([minBound .. maxBound] :: [Solver]))
allSolvers = intercalate ", " (map display ([minBound .. maxBound] :: [PreSolver]))
installCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
installCommand = CommandUI {
......@@ -1110,12 +1110,12 @@ liftOptions :: (b -> a) -> (a -> b -> b)
-> [OptionField a] -> [OptionField b]
liftOptions get set = map (liftOption get set)
optionSolver :: (flags -> Flag Solver)
-> (Flag Solver -> flags -> flags)
optionSolver :: (flags -> Flag PreSolver)
-> (Flag PreSolver -> flags -> flags)
-> OptionField flags
optionSolver get set =
option [] ["solver"]
("Select dependency solver to use (default: " ++ display defaultSolver ++ "). Choices: " ++ allSolvers ++ ".")
("Select dependency solver to use (default: " ++ display defaultSolver ++ "). Choices: " ++ allSolvers ++ ", where 'choose' chooses between 'topdown' and 'modular' based on compiler version.")
get set
(reqArg "SOLVER" (readP_to_E (const $ "solver must be one of: " ++ allSolvers)
(toFlag `fmap` parse))
......
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