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

newtype AvoidReinstalls = AvoidReinstalls Bool
  deriving (AvoidReinstalls -> Bool
forall a. (a -> Bool) -> BooleanFlag a
asBool :: AvoidReinstalls -> Bool
$casBool :: AvoidReinstalls -> Bool
BooleanFlag, AvoidReinstalls -> AvoidReinstalls -> Bool
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. 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
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
forall a. (a -> Bool) -> BooleanFlag a
asBool :: ShadowPkgs -> Bool
$casBool :: ShadowPkgs -> Bool
BooleanFlag, ShadowPkgs -> ShadowPkgs -> Bool
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. 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
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
forall a. (a -> Bool) -> BooleanFlag a
asBool :: StrongFlags -> Bool
$casBool :: StrongFlags -> Bool
BooleanFlag, StrongFlags -> StrongFlags -> Bool
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. 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
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
forall a. (a -> Bool) -> BooleanFlag a
asBool :: AllowBootLibInstalls -> Bool
$casBool :: AllowBootLibInstalls -> Bool
BooleanFlag, AllowBootLibInstalls -> AllowBootLibInstalls -> Bool
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. 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
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
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. 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
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
forall a. (a -> Bool) -> BooleanFlag a
asBool :: EnableBackjumping -> Bool
$casBool :: EnableBackjumping -> Bool
BooleanFlag, EnableBackjumping -> EnableBackjumping -> Bool
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. 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
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
forall a. (a -> Bool) -> BooleanFlag a
asBool :: SolveExecutables -> Bool
$casBool :: SolveExecutables -> Bool
BooleanFlag, SolveExecutables -> SolveExecutables -> Bool
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. 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
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 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 = forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice
    [ forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"all"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return OnlyConstrained
OnlyConstrainedAll
    , forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"none" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return OnlyConstrained
OnlyConstrainedNone
    ]