{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Distribution.Solver.Types.Settings
    ( ReorderGoals(..)
    , IndependentGoals(..)
    , 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
asBool :: ReorderGoals -> Bool
$casBool :: ReorderGoals -> Bool
BooleanFlag, ReorderGoals -> ReorderGoals -> Bool
(ReorderGoals -> ReorderGoals -> Bool)
-> (ReorderGoals -> ReorderGoals -> Bool) -> Eq ReorderGoals
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReorderGoals -> ReorderGoals -> Bool
$c/= :: ReorderGoals -> ReorderGoals -> Bool
== :: ReorderGoals -> ReorderGoals -> Bool
$c== :: 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
$cto :: forall x. Rep ReorderGoals x -> ReorderGoals
$cfrom :: forall x. ReorderGoals -> Rep ReorderGoals x
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
showList :: [ReorderGoals] -> ShowS
$cshowList :: [ReorderGoals] -> ShowS
show :: ReorderGoals -> String
$cshow :: ReorderGoals -> String
showsPrec :: Int -> ReorderGoals -> ShowS
$cshowsPrec :: Int -> ReorderGoals -> ShowS
Show)

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

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

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

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

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

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

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

newtype AllowBootLibInstalls = AllowBootLibInstalls Bool
  deriving (AllowBootLibInstalls -> Bool
(AllowBootLibInstalls -> Bool) -> BooleanFlag AllowBootLibInstalls
forall a. (a -> Bool) -> BooleanFlag a
asBool :: AllowBootLibInstalls -> Bool
$casBool :: AllowBootLibInstalls -> Bool
BooleanFlag, AllowBootLibInstalls -> AllowBootLibInstalls -> Bool
(AllowBootLibInstalls -> AllowBootLibInstalls -> Bool)
-> (AllowBootLibInstalls -> AllowBootLibInstalls -> Bool)
-> Eq AllowBootLibInstalls
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllowBootLibInstalls -> AllowBootLibInstalls -> Bool
$c/= :: AllowBootLibInstalls -> AllowBootLibInstalls -> Bool
== :: AllowBootLibInstalls -> AllowBootLibInstalls -> Bool
$c== :: 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
$cto :: forall x. Rep AllowBootLibInstalls x -> AllowBootLibInstalls
$cfrom :: forall x. AllowBootLibInstalls -> Rep AllowBootLibInstalls x
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
showList :: [AllowBootLibInstalls] -> ShowS
$cshowList :: [AllowBootLibInstalls] -> ShowS
show :: AllowBootLibInstalls -> String
$cshow :: AllowBootLibInstalls -> String
showsPrec :: Int -> AllowBootLibInstalls -> ShowS
$cshowsPrec :: Int -> 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
/= :: OnlyConstrained -> OnlyConstrained -> Bool
$c/= :: OnlyConstrained -> OnlyConstrained -> Bool
== :: OnlyConstrained -> OnlyConstrained -> Bool
$c== :: 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
$cto :: forall x. Rep OnlyConstrained x -> OnlyConstrained
$cfrom :: forall x. OnlyConstrained -> Rep OnlyConstrained x
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
showList :: [OnlyConstrained] -> ShowS
$cshowList :: [OnlyConstrained] -> ShowS
show :: OnlyConstrained -> String
$cshow :: OnlyConstrained -> String
showsPrec :: Int -> OnlyConstrained -> ShowS
$cshowsPrec :: Int -> OnlyConstrained -> ShowS
Show)

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

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

instance Binary ReorderGoals
instance Binary CountConflicts
instance Binary FineGrainedConflicts
instance Binary IndependentGoals
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 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 :: 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OnlyConstrained -> m OnlyConstrained
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OnlyConstrained -> m OnlyConstrained
forall (m :: * -> *) a. Monad m => a -> m a
return OnlyConstrained
OnlyConstrainedNone
    ]