diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Solver.hs b/cabal-install/Distribution/Client/Dependency/Modular/Solver.hs index 760f6b8f44aedfbbce727bd2beb0bd6eb2751caf..b78b4fccf2a74f3bfb574470ac2f597c8191e171 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Solver.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Solver.hs @@ -23,6 +23,7 @@ import Distribution.Client.Dependency.Modular.Package import qualified Distribution.Client.Dependency.Modular.Preference as P import Distribution.Client.Dependency.Modular.Validate import Distribution.Client.Dependency.Modular.Linking +import Distribution.Client.Types (BooleanFlag(..)) -- | Various options for the modular solver. data SolverConfig = SolverConfig { @@ -78,7 +79,7 @@ solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals = buildPhase where explorePhase = backjumpAndExplore (enableBackjumping sc) - heuristicsPhase = (if unReorderGoals (preferEasyGoalChoices sc) + heuristicsPhase = (if asBool (preferEasyGoalChoices sc) then P.preferEasyGoalChoices -- also leaves just one choice else P.firstGoal) . -- after doing goal-choice heuristics, commit to the first choice (saves space) P.deferWeakFlagChoices . @@ -91,7 +92,7 @@ solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals = P.enforceSingleInstanceRestriction . validateLinking idx . validateTree cinfo idx pkgConfigDB - prunePhase = (if unAvoidReinstalls (avoidReinstalls sc) then P.avoidReinstalls (const True) else id) . + prunePhase = (if asBool (avoidReinstalls sc) then P.avoidReinstalls (const True) else id) . -- packages that can never be "upgraded": P.requireInstalled (`elem` [ PackageName "base" , PackageName "ghc-prim" diff --git a/cabal-install/Distribution/Client/Dependency/Types.hs b/cabal-install/Distribution/Client/Dependency/Types.hs index 2b3d56728ced2c402c9922d64c7c155bb5fc4772..a7ee076b8f7e7beb93909ad15fc7c555209bee59 100644 --- a/cabal-install/Distribution/Client/Dependency/Types.hs +++ b/cabal-install/Distribution/Client/Dependency/Types.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Client.Dependency.Types @@ -60,7 +61,8 @@ import Data.Monoid import Distribution.Client.PkgConfigDb ( PkgConfigDb ) import Distribution.Client.Types - ( OptionalStanza(..), SourcePackage(..), SolverPackage ) + ( BooleanFlag(..), OptionalStanza(..), SourcePackage(..) + , SolverPackage ) import qualified Distribution.Compat.ReadP as Parse ( pfail, munch1 ) @@ -113,23 +115,23 @@ instance Text PreSolver where "choose" -> return Choose _ -> Parse.pfail -newtype ReorderGoals = ReorderGoals { unReorderGoals :: Bool } - deriving (Eq, Generic, Show) +newtype ReorderGoals = ReorderGoals Bool + deriving (BooleanFlag, Eq, Generic, Show) -newtype IndependentGoals = IndependentGoals { unIndependentGoals :: Bool } - deriving (Eq, Generic, Show) +newtype IndependentGoals = IndependentGoals Bool + deriving (BooleanFlag, Eq, Generic, Show) -newtype AvoidReinstalls = AvoidReinstalls { unAvoidReinstalls :: Bool } - deriving (Eq, Generic, Show) +newtype AvoidReinstalls = AvoidReinstalls Bool + deriving (BooleanFlag, Eq, Generic, Show) -newtype ShadowPkgs = ShadowPkgs { unShadowPkgs :: Bool } - deriving (Eq, Generic, Show) +newtype ShadowPkgs = ShadowPkgs Bool + deriving (BooleanFlag, Eq, Generic, Show) -newtype StrongFlags = StrongFlags { unStrongFlags :: Bool } - deriving (Eq, Generic, Show) +newtype StrongFlags = StrongFlags Bool + deriving (BooleanFlag, Eq, Generic, Show) newtype EnableBackjumping = EnableBackjumping Bool - deriving Show + deriving (BooleanFlag, Eq, Generic, Show) instance Binary ReorderGoals instance Binary IndependentGoals diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index db49e1fabed33ffa7043ff1c86bb6c19f5dc40f3..ab34b06c9b07f06d09463ec23ccfe091bbb56bdf 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -55,7 +55,7 @@ module Distribution.Client.Setup ) where import Distribution.Client.Types - ( Username(..), Password(..), RemoteRepo(..) ) + ( BooleanFlag(..), Username(..), Password(..), RemoteRepo(..) ) import Distribution.Client.BuildReports.Types ( ReportLevel(..) ) import Distribution.Client.Dependency.Types @@ -1329,7 +1329,7 @@ installOptions showOrParseArgs = , option [] ["avoid-reinstalls"] "Do not select versions that would destructively overwrite installed packages." - (fmap unAvoidReinstalls . installAvoidReinstalls) + (fmap asBool . installAvoidReinstalls) (\v flags -> flags { installAvoidReinstalls = fmap AvoidReinstalls v }) (yesNoOpt showOrParseArgs) @@ -2081,7 +2081,7 @@ optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg _getig _setig getsip (map show . flagToList)) , option [] ["reorder-goals"] "Try to reorder goals according to certain heuristics. Slows things down on average, but may make backtracking faster for some packages." - (fmap unReorderGoals . getrg) + (fmap asBool . getrg) (setrg . fmap ReorderGoals) (yesNoOpt showOrParseArgs) -- TODO: Disabled for now because it does not work as advertised (yet). @@ -2093,12 +2093,12 @@ optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg _getig _setig getsip -} , option [] ["shadow-installed-packages"] "If multiple package instances of the same version are installed, treat all but one as shadowed." - (fmap unShadowPkgs . getsip) + (fmap asBool . getsip) (setsip . fmap ShadowPkgs) (yesNoOpt showOrParseArgs) , option [] ["strong-flags"] "Do not defer flag choices (this used to be the default in cabal-install <= 1.20)." - (fmap unStrongFlags . getstrfl) + (fmap asBool . getstrfl) (setstrfl . fmap StrongFlags) (yesNoOpt showOrParseArgs) ] diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs index 79029dcbeaf6fd6921115b8c42acb52ea5921d1f..8f681e44cdf22dcdcc24a822d7509cd430f8a3ff 100644 --- a/cabal-install/Distribution/Client/Types.hs +++ b/cabal-install/Distribution/Client/Types.hs @@ -51,6 +51,13 @@ import Distribution.Compat.Binary (Binary(..)) newtype Username = Username { unUsername :: String } newtype Password = Password { unPassword :: String } +-- | Types that represent boolean flags. +class BooleanFlag a where + asBool :: a -> Bool + +instance BooleanFlag Bool where + asBool = id + -- | This is the information we get from a @00-index.tar.gz@ hackage index. -- data SourcePackageDb = SourcePackageDb {