Commit 741ac13e authored by Andres Löh's avatar Andres Löh

make solver configurable via command-line flag

parent 9348f6f8
......@@ -15,6 +15,8 @@ module Distribution.Client.Configure (
) where
import Distribution.Client.Dependency
import Distribution.Client.Dependency.Types
( Solver(..) )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Client.IndexUtils as IndexUtils
......@@ -158,7 +160,7 @@ planLocalPackage verbosity comp configFlags configExFlags installedPkgIndex
(SourcePackageDb mempty packagePrefs)
[SpecificSourcePackage localPkg]
return (resolveDependencies buildPlatform (compilerId comp) resolverParams)
return (resolveDependencies buildPlatform (compilerId comp) Modular resolverParams)
-- | Call an installer for an 'SourcePackage' but override the configure
......
......@@ -64,7 +64,7 @@ import Distribution.Client.Types
( SourcePackageDb(SourcePackageDb)
, SourcePackage(..) )
import Distribution.Client.Dependency.Types
( DependencyResolver, PackageConstraint(..)
( Solver(..), DependencyResolver, PackageConstraint(..)
, PackagePreferences(..), InstalledPreference(..)
, PackagesPreferenceDefault(..)
, Progress(..), foldProgress )
......@@ -305,8 +305,9 @@ standardInstallPolicy
-- * Interface to the standard resolver
-- ------------------------------------------------------------
defaultResolver :: SolverConfig -> DependencyResolver
defaultResolver = modularResolver -- const topDownResolver
runSolver :: Solver -> SolverConfig -> DependencyResolver
runSolver TopDown = const topDownResolver -- TODO: warn about unsuported options
runSolver Modular = modularResolver
-- | Run the dependency solver.
--
......@@ -316,20 +317,21 @@ defaultResolver = modularResolver -- const topDownResolver
--
resolveDependencies :: Platform
-> CompilerId
-> Solver
-> DepResolverParams
-> Progress String String InstallPlan
--TODO: is this needed here? see dontUpgradeBasePackage
resolveDependencies platform comp params
resolveDependencies platform comp _solver params
| null (depResolverTargets params)
= return (mkInstallPlan platform comp [])
resolveDependencies platform comp params =
resolveDependencies platform comp solver params =
fmap (mkInstallPlan platform comp)
$ defaultResolver (SolverConfig reorderGoals indGoals noReinstalls maxBkjumps)
platform comp installedPkgIndex sourcePkgIndex
preferences constraints targets
$ runSolver solver (SolverConfig reorderGoals indGoals noReinstalls maxBkjumps)
platform comp installedPkgIndex sourcePkgIndex
preferences constraints targets
where
DepResolverParams
targets constraints
......
......@@ -13,6 +13,7 @@
module Distribution.Client.Dependency.Types (
ExtDependency(..),
Solver(..),
DependencyResolver,
PackageConstraint(..),
......@@ -27,16 +28,20 @@ module Distribution.Client.Dependency.Types (
import Control.Applicative
( Applicative(..), Alternative(..) )
import Data.Char
( isAlpha, toLower )
import Data.Monoid
( Monoid(..) )
import Distribution.Client.Types
( SourcePackage(..), InstalledPackage )
( SourcePackage(..) )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Compat.ReadP
( (<++) )
import qualified Distribution.Compat.ReadP as Parse
( pfail, munch1 )
import Distribution.PackageDescription
( FlagAssignment )
import qualified Distribution.Client.PackageIndex as PackageIndex
......@@ -54,6 +59,9 @@ import Distribution.System
import Distribution.Text
( Text(..) )
import Text.PrettyPrint
( text )
import Prelude hiding (fail)
-- | Covers source dependencies and installed dependencies in
......@@ -67,6 +75,20 @@ instance Text ExtDependency where
parse = (SourceDependency `fmap` parse) <++ (InstalledDependency `fmap` parse)
-- | All the solvers that can be selected.
data Solver = TopDown | Modular
deriving (Eq, Ord, Show, Bounded, Enum)
instance Text Solver where
disp TopDown = text "topdown"
disp Modular = text "modular"
parse = do
name <- Parse.munch1 isAlpha
case map toLower name of
"topdown" -> return TopDown
"modular" -> return Modular
_ -> Parse.pfail
-- | A dependency resolver is a function that works out an installation plan
-- given the set of installed and available packages and a set of deps to
-- solve for.
......
......@@ -19,6 +19,8 @@ import Distribution.Client.Types
import Distribution.Client.Targets
import Distribution.Client.FetchUtils hiding (fetchPackage)
import Distribution.Client.Dependency
import Distribution.Client.Dependency.Types
( Solver(..) )
import Distribution.Client.IndexUtils as IndexUtils
( getSourcePackages, getInstalledPackages )
import qualified Distribution.Client.InstallPlan as InstallPlan
......@@ -124,6 +126,7 @@ planPackages verbosity comp fetchFlags
installPlan <- foldProgress logMsg die return $
resolveDependencies
buildPlatform (compilerId comp)
Modular
resolverParams
-- The packages we want to fetch are those packages the 'InstallPlan'
......
......@@ -87,15 +87,15 @@ getInstalledPackages verbosity comp packageDbs conf =
verbosity' = lessVerbose verbosity
convert :: InstalledPackageIndex.PackageIndex -> PackageIndex InstalledPackage
convert index = PackageIndex.fromList
convert index' = PackageIndex.fromList
-- There can be multiple installed instances of each package version,
-- like when the same package is installed in the global & user dbs.
-- InstalledPackageIndex.allPackagesByName gives us the installed
-- packages with the most preferred instances first, so by picking the
-- first we should get the user one. This is almost but not quite the
-- same as what ghc does.
[ InstalledPackage ipkg (sourceDeps index ipkg)
| ipkgs <- InstalledPackageIndex.allPackagesByName index
[ InstalledPackage ipkg (sourceDeps index' ipkg)
| ipkgs <- InstalledPackageIndex.allPackagesByName index'
, (ipkg:_) <- groupBy (equating packageVersion) ipkgs ]
where
-- The InstalledPackageInfo only lists dependencies by the
......
......@@ -228,6 +228,7 @@ planPackages comp configFlags configExFlags installFlags
resolveDependencies
buildPlatform (compilerId comp)
solver
resolverParams
>>= if onlyDeps then adjustPlanOnlyDeps else return
......@@ -320,6 +321,7 @@ planPackages comp configFlags configExFlags installFlags
, depid <- depids
, packageName depid `elem` targetnames ]
solver = fromFlag (installSolver installFlags)
reinstall = fromFlag (installReinstall installFlags)
reorderGoals = fromFlag (installReorderGoals installFlags)
independentGoals = fromFlag (installIndependentGoals installFlags)
......
......@@ -38,6 +38,8 @@ import Distribution.Client.Types
( Username(..), Password(..), Repo(..), RemoteRepo(..), LocalRepo(..) )
import Distribution.Client.BuildReports.Types
( ReportLevel(..) )
import Distribution.Client.Dependency.Types
( Solver(..) )
import qualified Distribution.Client.Init.Types as IT
( InitFlags(..), PackageType(..) )
import Distribution.Client.Targets
......@@ -73,6 +75,8 @@ import Distribution.Simple.Utils
import Data.Char
( isSpace, isAlphaNum )
import Data.List
( intercalate )
import Data.Maybe
( listToMaybe, maybeToList, fromMaybe )
import Data.Monoid
......@@ -573,6 +577,7 @@ data InstallFlags = InstallFlags {
installDocumentation :: Flag Bool,
installHaddockIndex :: Flag PathTemplate,
installDryRun :: Flag Bool,
installSolver :: Flag Solver,
installReinstall :: Flag Bool,
installAvoidReinstalls :: Flag Bool,
installOverrideReinstall :: Flag Bool,
......@@ -595,6 +600,7 @@ defaultInstallFlags = InstallFlags {
installDocumentation = Flag False,
installHaddockIndex = Flag docIndexFile,
installDryRun = Flag False,
installSolver = Flag defaultSolver,
installReinstall = Flag False,
installAvoidReinstalls = Flag False,
installOverrideReinstall = Flag False,
......@@ -617,6 +623,12 @@ defaultInstallFlags = InstallFlags {
defaultMaxBackjumps :: Int
defaultMaxBackjumps = 200
defaultSolver :: Solver
defaultSolver = TopDown
allSolvers :: String
allSolvers = intercalate ", " (map display ([minBound .. maxBound] :: [Solver]))
installCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
installCommand = CommandUI {
commandName = "install",
......@@ -686,6 +698,13 @@ installOptions showOrParseArgs =
installDryRun (\v flags -> flags { installDryRun = v })
trueArg
, option [] ["solver"]
("Select dependency solver to use (default: " ++ display defaultSolver ++ "). Choices: " ++ allSolvers ++ ".")
installSolver (\v flags -> flags { installSolver = v })
(reqArg "SOLVER" (readP_to_E (const $ "solver must be one of: " ++ allSolvers)
(toFlag `fmap` parse))
(flagToList . fmap display))
, option [] ["reinstall"]
"Install even if it means installing the same version again."
installReinstall (\v flags -> flags { installReinstall = v })
......@@ -776,6 +795,7 @@ instance Monoid InstallFlags where
installDocumentation = mempty,
installHaddockIndex = mempty,
installDryRun = mempty,
installSolver = mempty,
installReinstall = mempty,
installAvoidReinstalls = mempty,
installOverrideReinstall = mempty,
......@@ -796,6 +816,7 @@ instance Monoid InstallFlags where
installDocumentation = combine installDocumentation,
installHaddockIndex = combine installHaddockIndex,
installDryRun = combine installDryRun,
installSolver = combine installSolver,
installReinstall = combine installReinstall,
installAvoidReinstalls = combine installAvoidReinstalls,
installOverrideReinstall = combine installOverrideReinstall,
......
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