{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Distribution.Solver.Types.Settings
    ( ReorderGoals(..)
    , IndependentGoals(..)
    , PreferOldest(..)
    , MinimizeConflictSet(..)
    , AvoidReinstalls(..)
    , ShadowPkgs(..)
    , StrongFlags(..)
    , AllowBootLibInstalls(..)
    , OnlyConstrained(..)
    , EnableBackjumping(..)
    , CountConflicts(..)
    , FineGrainedConflicts(..)
    , SolveExecutables(..)
    ) where

import Distribution.Solver.Compat.Prelude
import Prelude ()

import Distribution.Simple.Setup ( BooleanFlag(..) )
import Distribution.Pretty ( Pretty(pretty) )
import Distribution.Parsec ( Parsec(parsec) )

import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as PP

newtype ReorderGoals = ReorderGoals Bool
  deriving (ReorderGoals -> Bool
(ReorderGoals -> Bool) -> BooleanFlag ReorderGoals
forall a. (a -> Bool) -> BooleanFlag a
$casBool :: ReorderGoals -> Bool
asBool :: ReorderGoals -> Bool
BooleanFlag, ReorderGoals -> ReorderGoals -> Bool
(ReorderGoals -> ReorderGoals -> Bool)
-> (ReorderGoals -> ReorderGoals -> Bool) -> Eq ReorderGoals
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReorderGoals -> ReorderGoals -> Bool
== :: ReorderGoals -> ReorderGoals -> Bool
$c/= :: ReorderGoals -> ReorderGoals -> Bool
/= :: ReorderGoals -> ReorderGoals -> Bool
Eq, (forall x. ReorderGoals -> Rep ReorderGoals x)
-> (forall x. Rep ReorderGoals x -> ReorderGoals)
-> Generic ReorderGoals
forall x. Rep ReorderGoals x -> ReorderGoals
forall x. ReorderGoals -> Rep ReorderGoals x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReorderGoals -> Rep ReorderGoals x
from :: forall x. ReorderGoals -> Rep ReorderGoals x
$cto :: forall x. Rep ReorderGoals x -> ReorderGoals
to :: forall x. Rep ReorderGoals x -> ReorderGoals
Generic, Int -> ReorderGoals -> ShowS
[ReorderGoals] -> ShowS
ReorderGoals -> String
(Int -> ReorderGoals -> ShowS)
-> (ReorderGoals -> String)
-> ([ReorderGoals] -> ShowS)
-> Show ReorderGoals
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReorderGoals -> ShowS
showsPrec :: Int -> ReorderGoals -> ShowS
$cshow :: ReorderGoals -> String
show :: ReorderGoals -> String
$cshowList :: [ReorderGoals] -> ShowS
showList :: [ReorderGoals] -> ShowS
Show)

newtype CountConflicts = CountConflicts Bool
  deriving (CountConflicts -> Bool
(CountConflicts -> Bool) -> BooleanFlag CountConflicts
forall a. (a -> Bool) -> BooleanFlag a
$casBool :: CountConflicts -> Bool
asBool :: CountConflicts -> Bool
BooleanFlag, CountConflicts -> CountConflicts -> Bool
(CountConflicts -> CountConflicts -> Bool)
-> (CountConflicts -> CountConflicts -> Bool) -> Eq CountConflicts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CountConflicts -> CountConflicts -> Bool
== :: CountConflicts -> CountConflicts -> Bool
$c/= :: CountConflicts -> CountConflicts -> Bool
/= :: CountConflicts -> CountConflicts -> Bool
Eq, (forall x. CountConflicts -> Rep CountConflicts x)
-> (forall x. Rep CountConflicts x -> CountConflicts)
-> Generic CountConflicts
forall x. Rep CountConflicts x -> CountConflicts
forall x. CountConflicts -> Rep CountConflicts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CountConflicts -> Rep CountConflicts x
from :: forall x. CountConflicts -> Rep CountConflicts x
$cto :: forall x. Rep CountConflicts x -> CountConflicts
to :: forall x. Rep CountConflicts x -> CountConflicts
Generic, Int -> CountConflicts -> ShowS
[CountConflicts] -> ShowS
CountConflicts -> String
(Int -> CountConflicts -> ShowS)
-> (CountConflicts -> String)
-> ([CountConflicts] -> ShowS)
-> Show CountConflicts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CountConflicts -> ShowS
showsPrec :: Int -> CountConflicts -> ShowS
$cshow :: CountConflicts -> String
show :: CountConflicts -> String
$cshowList :: [CountConflicts] -> ShowS
showList :: [CountConflicts] -> ShowS
Show)

newtype FineGrainedConflicts = FineGrainedConflicts Bool
  deriving (FineGrainedConflicts -> Bool
(FineGrainedConflicts -> Bool) -> BooleanFlag FineGrainedConflicts
forall a. (a -> Bool) -> BooleanFlag a
$casBool :: FineGrainedConflicts -> Bool
asBool :: FineGrainedConflicts -> Bool
BooleanFlag, FineGrainedConflicts -> FineGrainedConflicts -> Bool
(FineGrainedConflicts -> FineGrainedConflicts -> Bool)
-> (FineGrainedConflicts -> FineGrainedConflicts -> Bool)
-> Eq FineGrainedConflicts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FineGrainedConflicts -> FineGrainedConflicts -> Bool
== :: FineGrainedConflicts -> FineGrainedConflicts -> Bool
$c/= :: FineGrainedConflicts -> FineGrainedConflicts -> Bool
/= :: FineGrainedConflicts -> FineGrainedConflicts -> Bool
Eq, (forall x. FineGrainedConflicts -> Rep FineGrainedConflicts x)
-> (forall x. Rep FineGrainedConflicts x -> FineGrainedConflicts)
-> Generic FineGrainedConflicts
forall x. Rep FineGrainedConflicts x -> FineGrainedConflicts
forall x. FineGrainedConflicts -> Rep FineGrainedConflicts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FineGrainedConflicts -> Rep FineGrainedConflicts x
from :: forall x. FineGrainedConflicts -> Rep FineGrainedConflicts x
$cto :: forall x. Rep FineGrainedConflicts x -> FineGrainedConflicts
to :: forall x. Rep FineGrainedConflicts x -> FineGrainedConflicts
Generic, Int -> FineGrainedConflicts -> ShowS
[FineGrainedConflicts] -> ShowS
FineGrainedConflicts -> String
(Int -> FineGrainedConflicts -> ShowS)
-> (FineGrainedConflicts -> String)
-> ([FineGrainedConflicts] -> ShowS)
-> Show FineGrainedConflicts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FineGrainedConflicts -> ShowS
showsPrec :: Int -> FineGrainedConflicts -> ShowS
$cshow :: FineGrainedConflicts -> String
show :: FineGrainedConflicts -> String
$cshowList :: [FineGrainedConflicts] -> ShowS
showList :: [FineGrainedConflicts] -> ShowS
Show)

newtype MinimizeConflictSet = MinimizeConflictSet Bool
  deriving (MinimizeConflictSet -> Bool
(MinimizeConflictSet -> Bool) -> BooleanFlag MinimizeConflictSet
forall a. (a -> Bool) -> BooleanFlag a
$casBool :: MinimizeConflictSet -> Bool
asBool :: MinimizeConflictSet -> Bool
BooleanFlag, MinimizeConflictSet -> MinimizeConflictSet -> Bool
(MinimizeConflictSet -> MinimizeConflictSet -> Bool)
-> (MinimizeConflictSet -> MinimizeConflictSet -> Bool)
-> Eq MinimizeConflictSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MinimizeConflictSet -> MinimizeConflictSet -> Bool
== :: MinimizeConflictSet -> MinimizeConflictSet -> Bool
$c/= :: MinimizeConflictSet -> MinimizeConflictSet -> Bool
/= :: MinimizeConflictSet -> MinimizeConflictSet -> Bool
Eq, (forall x. MinimizeConflictSet -> Rep MinimizeConflictSet x)
-> (forall x. Rep MinimizeConflictSet x -> MinimizeConflictSet)
-> Generic MinimizeConflictSet
forall x. Rep MinimizeConflictSet x -> MinimizeConflictSet
forall x. MinimizeConflictSet -> Rep MinimizeConflictSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MinimizeConflictSet -> Rep MinimizeConflictSet x
from :: forall x. MinimizeConflictSet -> Rep MinimizeConflictSet x
$cto :: forall x. Rep MinimizeConflictSet x -> MinimizeConflictSet
to :: forall x. Rep MinimizeConflictSet x -> MinimizeConflictSet
Generic, Int -> MinimizeConflictSet -> ShowS
[MinimizeConflictSet] -> ShowS
MinimizeConflictSet -> String
(Int -> MinimizeConflictSet -> ShowS)
-> (MinimizeConflictSet -> String)
-> ([MinimizeConflictSet] -> ShowS)
-> Show MinimizeConflictSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MinimizeConflictSet -> ShowS
showsPrec :: Int -> MinimizeConflictSet -> ShowS
$cshow :: MinimizeConflictSet -> String
show :: MinimizeConflictSet -> String
$cshowList :: [MinimizeConflictSet] -> ShowS
showList :: [MinimizeConflictSet] -> ShowS
Show)

newtype IndependentGoals = IndependentGoals Bool
  deriving (IndependentGoals -> Bool
(IndependentGoals -> Bool) -> BooleanFlag IndependentGoals
forall a. (a -> Bool) -> BooleanFlag a
$casBool :: IndependentGoals -> Bool
asBool :: IndependentGoals -> Bool
BooleanFlag, IndependentGoals -> IndependentGoals -> Bool
(IndependentGoals -> IndependentGoals -> Bool)
-> (IndependentGoals -> IndependentGoals -> Bool)
-> Eq IndependentGoals
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndependentGoals -> IndependentGoals -> Bool
== :: IndependentGoals -> IndependentGoals -> Bool
$c/= :: IndependentGoals -> IndependentGoals -> Bool
/= :: IndependentGoals -> IndependentGoals -> Bool
Eq, (forall x. IndependentGoals -> Rep IndependentGoals x)
-> (forall x. Rep IndependentGoals x -> IndependentGoals)
-> Generic IndependentGoals
forall x. Rep IndependentGoals x -> IndependentGoals
forall x. IndependentGoals -> Rep IndependentGoals x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IndependentGoals -> Rep IndependentGoals x
from :: forall x. IndependentGoals -> Rep IndependentGoals x
$cto :: forall x. Rep IndependentGoals x -> IndependentGoals
to :: forall x. Rep IndependentGoals x -> IndependentGoals
Generic, Int -> IndependentGoals -> ShowS
[IndependentGoals] -> ShowS
IndependentGoals -> String
(Int -> IndependentGoals -> ShowS)
-> (IndependentGoals -> String)
-> ([IndependentGoals] -> ShowS)
-> Show IndependentGoals
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndependentGoals -> ShowS
showsPrec :: Int -> IndependentGoals -> ShowS
$cshow :: IndependentGoals -> String
show :: IndependentGoals -> String
$cshowList :: [IndependentGoals] -> ShowS
showList :: [IndependentGoals] -> ShowS
Show)

newtype PreferOldest = PreferOldest Bool
  deriving (PreferOldest -> Bool
(PreferOldest -> Bool) -> BooleanFlag PreferOldest
forall a. (a -> Bool) -> BooleanFlag a
$casBool :: PreferOldest -> Bool
asBool :: PreferOldest -> Bool
BooleanFlag, PreferOldest -> PreferOldest -> Bool
(PreferOldest -> PreferOldest -> Bool)
-> (PreferOldest -> PreferOldest -> Bool) -> Eq PreferOldest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PreferOldest -> PreferOldest -> Bool
== :: PreferOldest -> PreferOldest -> Bool
$c/= :: PreferOldest -> PreferOldest -> Bool
/= :: PreferOldest -> PreferOldest -> Bool
Eq, (forall x. PreferOldest -> Rep PreferOldest x)
-> (forall x. Rep PreferOldest x -> PreferOldest)
-> Generic PreferOldest
forall x. Rep PreferOldest x -> PreferOldest
forall x. PreferOldest -> Rep PreferOldest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PreferOldest -> Rep PreferOldest x
from :: forall x. PreferOldest -> Rep PreferOldest x
$cto :: forall x. Rep PreferOldest x -> PreferOldest
to :: forall x. Rep PreferOldest x -> PreferOldest
Generic, Int -> PreferOldest -> ShowS
[PreferOldest] -> ShowS
PreferOldest -> String
(Int -> PreferOldest -> ShowS)
-> (PreferOldest -> String)
-> ([PreferOldest] -> ShowS)
-> Show PreferOldest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PreferOldest -> ShowS
showsPrec :: Int -> PreferOldest -> ShowS
$cshow :: PreferOldest -> String
show :: PreferOldest -> String
$cshowList :: [PreferOldest] -> ShowS
showList :: [PreferOldest] -> ShowS
Show)

newtype AvoidReinstalls = AvoidReinstalls Bool
  deriving (AvoidReinstalls -> Bool
(AvoidReinstalls -> Bool) -> BooleanFlag AvoidReinstalls
forall a. (a -> Bool) -> BooleanFlag a
$casBool :: AvoidReinstalls -> Bool
asBool :: AvoidReinstalls -> Bool
BooleanFlag, AvoidReinstalls -> AvoidReinstalls -> Bool
(AvoidReinstalls -> AvoidReinstalls -> Bool)
-> (AvoidReinstalls -> AvoidReinstalls -> Bool)
-> Eq AvoidReinstalls
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AvoidReinstalls -> AvoidReinstalls -> Bool
== :: AvoidReinstalls -> AvoidReinstalls -> Bool
$c/= :: AvoidReinstalls -> AvoidReinstalls -> Bool
/= :: AvoidReinstalls -> AvoidReinstalls -> Bool
Eq, (forall x. AvoidReinstalls -> Rep AvoidReinstalls x)
-> (forall x. Rep AvoidReinstalls x -> AvoidReinstalls)
-> Generic AvoidReinstalls
forall x. Rep AvoidReinstalls x -> AvoidReinstalls
forall x. AvoidReinstalls -> Rep AvoidReinstalls x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AvoidReinstalls -> Rep AvoidReinstalls x
from :: forall x. AvoidReinstalls -> Rep AvoidReinstalls x
$cto :: forall x. Rep AvoidReinstalls x -> AvoidReinstalls
to :: forall x. Rep AvoidReinstalls x -> AvoidReinstalls
Generic, Int -> AvoidReinstalls -> ShowS
[AvoidReinstalls] -> ShowS
AvoidReinstalls -> String
(Int -> AvoidReinstalls -> ShowS)
-> (AvoidReinstalls -> String)
-> ([AvoidReinstalls] -> ShowS)
-> Show AvoidReinstalls
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AvoidReinstalls -> ShowS
showsPrec :: Int -> AvoidReinstalls -> ShowS
$cshow :: AvoidReinstalls -> String
show :: AvoidReinstalls -> String
$cshowList :: [AvoidReinstalls] -> ShowS
showList :: [AvoidReinstalls] -> ShowS
Show)

newtype ShadowPkgs = ShadowPkgs Bool
  deriving (ShadowPkgs -> Bool
(ShadowPkgs -> Bool) -> BooleanFlag ShadowPkgs
forall a. (a -> Bool) -> BooleanFlag a
$casBool :: ShadowPkgs -> Bool
asBool :: ShadowPkgs -> Bool
BooleanFlag, ShadowPkgs -> ShadowPkgs -> Bool
(ShadowPkgs -> ShadowPkgs -> Bool)
-> (ShadowPkgs -> ShadowPkgs -> Bool) -> Eq ShadowPkgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShadowPkgs -> ShadowPkgs -> Bool
== :: ShadowPkgs -> ShadowPkgs -> Bool
$c/= :: ShadowPkgs -> ShadowPkgs -> Bool
/= :: ShadowPkgs -> ShadowPkgs -> Bool
Eq, (forall x. ShadowPkgs -> Rep ShadowPkgs x)
-> (forall x. Rep ShadowPkgs x -> ShadowPkgs) -> Generic ShadowPkgs
forall x. Rep ShadowPkgs x -> ShadowPkgs
forall x. ShadowPkgs -> Rep ShadowPkgs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ShadowPkgs -> Rep ShadowPkgs x
from :: forall x. ShadowPkgs -> Rep ShadowPkgs x
$cto :: forall x. Rep ShadowPkgs x -> ShadowPkgs
to :: forall x. Rep ShadowPkgs x -> ShadowPkgs
Generic, Int -> ShadowPkgs -> ShowS
[ShadowPkgs] -> ShowS
ShadowPkgs -> String
(Int -> ShadowPkgs -> ShowS)
-> (ShadowPkgs -> String)
-> ([ShadowPkgs] -> ShowS)
-> Show ShadowPkgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShadowPkgs -> ShowS
showsPrec :: Int -> ShadowPkgs -> ShowS
$cshow :: ShadowPkgs -> String
show :: ShadowPkgs -> String
$cshowList :: [ShadowPkgs] -> ShowS
showList :: [ShadowPkgs] -> ShowS
Show)

newtype StrongFlags = StrongFlags Bool
  deriving (StrongFlags -> Bool
(StrongFlags -> Bool) -> BooleanFlag StrongFlags
forall a. (a -> Bool) -> BooleanFlag a
$casBool :: StrongFlags -> Bool
asBool :: StrongFlags -> Bool
BooleanFlag, StrongFlags -> StrongFlags -> Bool
(StrongFlags -> StrongFlags -> Bool)
-> (StrongFlags -> StrongFlags -> Bool) -> Eq StrongFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StrongFlags -> StrongFlags -> Bool
== :: StrongFlags -> StrongFlags -> Bool
$c/= :: StrongFlags -> StrongFlags -> Bool
/= :: StrongFlags -> StrongFlags -> Bool
Eq, (forall x. StrongFlags -> Rep StrongFlags x)
-> (forall x. Rep StrongFlags x -> StrongFlags)
-> Generic StrongFlags
forall x. Rep StrongFlags x -> StrongFlags
forall x. StrongFlags -> Rep StrongFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StrongFlags -> Rep StrongFlags x
from :: forall x. StrongFlags -> Rep StrongFlags x
$cto :: forall x. Rep StrongFlags x -> StrongFlags
to :: forall x. Rep StrongFlags x -> StrongFlags
Generic, Int -> StrongFlags -> ShowS
[StrongFlags] -> ShowS
StrongFlags -> String
(Int -> StrongFlags -> ShowS)
-> (StrongFlags -> String)
-> ([StrongFlags] -> ShowS)
-> Show StrongFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StrongFlags -> ShowS
showsPrec :: Int -> StrongFlags -> ShowS
$cshow :: StrongFlags -> String
show :: StrongFlags -> String
$cshowList :: [StrongFlags] -> ShowS
showList :: [StrongFlags] -> ShowS
Show)

newtype AllowBootLibInstalls = AllowBootLibInstalls Bool
  deriving (AllowBootLibInstalls -> Bool
(AllowBootLibInstalls -> Bool) -> BooleanFlag AllowBootLibInstalls
forall a. (a -> Bool) -> BooleanFlag a
$casBool :: AllowBootLibInstalls -> Bool
asBool :: AllowBootLibInstalls -> Bool
BooleanFlag, AllowBootLibInstalls -> AllowBootLibInstalls -> Bool
(AllowBootLibInstalls -> AllowBootLibInstalls -> Bool)
-> (AllowBootLibInstalls -> AllowBootLibInstalls -> Bool)
-> Eq AllowBootLibInstalls
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AllowBootLibInstalls -> AllowBootLibInstalls -> Bool
== :: AllowBootLibInstalls -> AllowBootLibInstalls -> Bool
$c/= :: AllowBootLibInstalls -> AllowBootLibInstalls -> Bool
/= :: AllowBootLibInstalls -> AllowBootLibInstalls -> Bool
Eq, (forall x. AllowBootLibInstalls -> Rep AllowBootLibInstalls x)
-> (forall x. Rep AllowBootLibInstalls x -> AllowBootLibInstalls)
-> Generic AllowBootLibInstalls
forall x. Rep AllowBootLibInstalls x -> AllowBootLibInstalls
forall x. AllowBootLibInstalls -> Rep AllowBootLibInstalls x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AllowBootLibInstalls -> Rep AllowBootLibInstalls x
from :: forall x. AllowBootLibInstalls -> Rep AllowBootLibInstalls x
$cto :: forall x. Rep AllowBootLibInstalls x -> AllowBootLibInstalls
to :: forall x. Rep AllowBootLibInstalls x -> AllowBootLibInstalls
Generic, Int -> AllowBootLibInstalls -> ShowS
[AllowBootLibInstalls] -> ShowS
AllowBootLibInstalls -> String
(Int -> AllowBootLibInstalls -> ShowS)
-> (AllowBootLibInstalls -> String)
-> ([AllowBootLibInstalls] -> ShowS)
-> Show AllowBootLibInstalls
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AllowBootLibInstalls -> ShowS
showsPrec :: Int -> AllowBootLibInstalls -> ShowS
$cshow :: AllowBootLibInstalls -> String
show :: AllowBootLibInstalls -> String
$cshowList :: [AllowBootLibInstalls] -> ShowS
showList :: [AllowBootLibInstalls] -> ShowS
Show)

-- | Should we consider all packages we know about, or only those that
-- have constraints explicitly placed on them or which are goals?
data OnlyConstrained
  = OnlyConstrainedNone
  | OnlyConstrainedAll
  deriving (OnlyConstrained -> OnlyConstrained -> Bool
(OnlyConstrained -> OnlyConstrained -> Bool)
-> (OnlyConstrained -> OnlyConstrained -> Bool)
-> Eq OnlyConstrained
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OnlyConstrained -> OnlyConstrained -> Bool
== :: OnlyConstrained -> OnlyConstrained -> Bool
$c/= :: OnlyConstrained -> OnlyConstrained -> Bool
/= :: OnlyConstrained -> OnlyConstrained -> Bool
Eq, (forall x. OnlyConstrained -> Rep OnlyConstrained x)
-> (forall x. Rep OnlyConstrained x -> OnlyConstrained)
-> Generic OnlyConstrained
forall x. Rep OnlyConstrained x -> OnlyConstrained
forall x. OnlyConstrained -> Rep OnlyConstrained x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OnlyConstrained -> Rep OnlyConstrained x
from :: forall x. OnlyConstrained -> Rep OnlyConstrained x
$cto :: forall x. Rep OnlyConstrained x -> OnlyConstrained
to :: forall x. Rep OnlyConstrained x -> OnlyConstrained
Generic, Int -> OnlyConstrained -> ShowS
[OnlyConstrained] -> ShowS
OnlyConstrained -> String
(Int -> OnlyConstrained -> ShowS)
-> (OnlyConstrained -> String)
-> ([OnlyConstrained] -> ShowS)
-> Show OnlyConstrained
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OnlyConstrained -> ShowS
showsPrec :: Int -> OnlyConstrained -> ShowS
$cshow :: OnlyConstrained -> String
show :: OnlyConstrained -> String
$cshowList :: [OnlyConstrained] -> ShowS
showList :: [OnlyConstrained] -> ShowS
Show)

newtype EnableBackjumping = EnableBackjumping Bool
  deriving (EnableBackjumping -> Bool
(EnableBackjumping -> Bool) -> BooleanFlag EnableBackjumping
forall a. (a -> Bool) -> BooleanFlag a
$casBool :: EnableBackjumping -> Bool
asBool :: EnableBackjumping -> Bool
BooleanFlag, EnableBackjumping -> EnableBackjumping -> Bool
(EnableBackjumping -> EnableBackjumping -> Bool)
-> (EnableBackjumping -> EnableBackjumping -> Bool)
-> Eq EnableBackjumping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnableBackjumping -> EnableBackjumping -> Bool
== :: EnableBackjumping -> EnableBackjumping -> Bool
$c/= :: EnableBackjumping -> EnableBackjumping -> Bool
/= :: EnableBackjumping -> EnableBackjumping -> Bool
Eq, (forall x. EnableBackjumping -> Rep EnableBackjumping x)
-> (forall x. Rep EnableBackjumping x -> EnableBackjumping)
-> Generic EnableBackjumping
forall x. Rep EnableBackjumping x -> EnableBackjumping
forall x. EnableBackjumping -> Rep EnableBackjumping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnableBackjumping -> Rep EnableBackjumping x
from :: forall x. EnableBackjumping -> Rep EnableBackjumping x
$cto :: forall x. Rep EnableBackjumping x -> EnableBackjumping
to :: forall x. Rep EnableBackjumping x -> EnableBackjumping
Generic, Int -> EnableBackjumping -> ShowS
[EnableBackjumping] -> ShowS
EnableBackjumping -> String
(Int -> EnableBackjumping -> ShowS)
-> (EnableBackjumping -> String)
-> ([EnableBackjumping] -> ShowS)
-> Show EnableBackjumping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnableBackjumping -> ShowS
showsPrec :: Int -> EnableBackjumping -> ShowS
$cshow :: EnableBackjumping -> String
show :: EnableBackjumping -> String
$cshowList :: [EnableBackjumping] -> ShowS
showList :: [EnableBackjumping] -> ShowS
Show)

newtype SolveExecutables = SolveExecutables Bool
  deriving (SolveExecutables -> Bool
(SolveExecutables -> Bool) -> BooleanFlag SolveExecutables
forall a. (a -> Bool) -> BooleanFlag a
$casBool :: SolveExecutables -> Bool
asBool :: SolveExecutables -> Bool
BooleanFlag, SolveExecutables -> SolveExecutables -> Bool
(SolveExecutables -> SolveExecutables -> Bool)
-> (SolveExecutables -> SolveExecutables -> Bool)
-> Eq SolveExecutables
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SolveExecutables -> SolveExecutables -> Bool
== :: SolveExecutables -> SolveExecutables -> Bool
$c/= :: SolveExecutables -> SolveExecutables -> Bool
/= :: SolveExecutables -> SolveExecutables -> Bool
Eq, (forall x. SolveExecutables -> Rep SolveExecutables x)
-> (forall x. Rep SolveExecutables x -> SolveExecutables)
-> Generic SolveExecutables
forall x. Rep SolveExecutables x -> SolveExecutables
forall x. SolveExecutables -> Rep SolveExecutables x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SolveExecutables -> Rep SolveExecutables x
from :: forall x. SolveExecutables -> Rep SolveExecutables x
$cto :: forall x. Rep SolveExecutables x -> SolveExecutables
to :: forall x. Rep SolveExecutables x -> SolveExecutables
Generic, Int -> SolveExecutables -> ShowS
[SolveExecutables] -> ShowS
SolveExecutables -> String
(Int -> SolveExecutables -> ShowS)
-> (SolveExecutables -> String)
-> ([SolveExecutables] -> ShowS)
-> Show SolveExecutables
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SolveExecutables -> ShowS
showsPrec :: Int -> SolveExecutables -> ShowS
$cshow :: SolveExecutables -> String
show :: SolveExecutables -> String
$cshowList :: [SolveExecutables] -> ShowS
showList :: [SolveExecutables] -> ShowS
Show)

instance Binary ReorderGoals
instance Binary CountConflicts
instance Binary FineGrainedConflicts
instance Binary IndependentGoals
instance Binary PreferOldest
instance Binary MinimizeConflictSet
instance Binary AvoidReinstalls
instance Binary ShadowPkgs
instance Binary StrongFlags
instance Binary AllowBootLibInstalls
instance Binary OnlyConstrained
instance Binary SolveExecutables

instance Structured ReorderGoals
instance Structured CountConflicts
instance Structured FineGrainedConflicts
instance Structured IndependentGoals
instance Structured PreferOldest
instance Structured MinimizeConflictSet
instance Structured AvoidReinstalls
instance Structured ShadowPkgs
instance Structured StrongFlags
instance Structured AllowBootLibInstalls
instance Structured OnlyConstrained
instance Structured SolveExecutables

instance Pretty OnlyConstrained where
  pretty :: OnlyConstrained -> Doc
pretty OnlyConstrained
OnlyConstrainedAll  = String -> Doc
PP.text String
"all"
  pretty OnlyConstrained
OnlyConstrainedNone = String -> Doc
PP.text String
"none"

instance Parsec OnlyConstrained where
  parsec :: forall (m :: * -> *). CabalParsing m => m OnlyConstrained
parsec = [m OnlyConstrained] -> m OnlyConstrained
forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice
    [ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"all"  m String -> m OnlyConstrained -> m OnlyConstrained
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OnlyConstrained -> m OnlyConstrained
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return OnlyConstrained
OnlyConstrainedAll
    , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"none" m String -> m OnlyConstrained -> m OnlyConstrained
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OnlyConstrained -> m OnlyConstrained
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return OnlyConstrained
OnlyConstrainedNone
    ]