{-# LANGUAGE DeriveFunctor #-}
module Distribution.Solver.Modular.Flag
    ( FInfo(..)
    , Flag
    , FlagInfo
    , FN(..)
    , QFN
    , QSN
    , Stanza
    , SN(..)
    , WeakOrTrivial(..)
    , FlagValue(..)
    , mkFlag
    , showQFN
    , showQFNBool
    , showFlagValue
    , showQSN
    , showQSNBool
    , showSBool
    ) where

import Data.Map as M
import Prelude hiding (pi)

import qualified Distribution.PackageDescription as P -- from Cabal

import Distribution.Solver.Types.Flag
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PackagePath

-- | Flag name. Consists of a package instance and the flag identifier itself.
data FN qpn = FN qpn Flag
  deriving (FN qpn -> FN qpn -> Bool
(FN qpn -> FN qpn -> Bool)
-> (FN qpn -> FN qpn -> Bool) -> Eq (FN qpn)
forall qpn. Eq qpn => FN qpn -> FN qpn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FN qpn -> FN qpn -> Bool
$c/= :: forall qpn. Eq qpn => FN qpn -> FN qpn -> Bool
== :: FN qpn -> FN qpn -> Bool
$c== :: forall qpn. Eq qpn => FN qpn -> FN qpn -> Bool
Eq, Eq (FN qpn)
Eq (FN qpn)
-> (FN qpn -> FN qpn -> Ordering)
-> (FN qpn -> FN qpn -> Bool)
-> (FN qpn -> FN qpn -> Bool)
-> (FN qpn -> FN qpn -> Bool)
-> (FN qpn -> FN qpn -> Bool)
-> (FN qpn -> FN qpn -> FN qpn)
-> (FN qpn -> FN qpn -> FN qpn)
-> Ord (FN qpn)
FN qpn -> FN qpn -> Bool
FN qpn -> FN qpn -> Ordering
FN qpn -> FN qpn -> FN qpn
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall qpn. Ord qpn => Eq (FN qpn)
forall qpn. Ord qpn => FN qpn -> FN qpn -> Bool
forall qpn. Ord qpn => FN qpn -> FN qpn -> Ordering
forall qpn. Ord qpn => FN qpn -> FN qpn -> FN qpn
min :: FN qpn -> FN qpn -> FN qpn
$cmin :: forall qpn. Ord qpn => FN qpn -> FN qpn -> FN qpn
max :: FN qpn -> FN qpn -> FN qpn
$cmax :: forall qpn. Ord qpn => FN qpn -> FN qpn -> FN qpn
>= :: FN qpn -> FN qpn -> Bool
$c>= :: forall qpn. Ord qpn => FN qpn -> FN qpn -> Bool
> :: FN qpn -> FN qpn -> Bool
$c> :: forall qpn. Ord qpn => FN qpn -> FN qpn -> Bool
<= :: FN qpn -> FN qpn -> Bool
$c<= :: forall qpn. Ord qpn => FN qpn -> FN qpn -> Bool
< :: FN qpn -> FN qpn -> Bool
$c< :: forall qpn. Ord qpn => FN qpn -> FN qpn -> Bool
compare :: FN qpn -> FN qpn -> Ordering
$ccompare :: forall qpn. Ord qpn => FN qpn -> FN qpn -> Ordering
$cp1Ord :: forall qpn. Ord qpn => Eq (FN qpn)
Ord, Int -> FN qpn -> ShowS
[FN qpn] -> ShowS
FN qpn -> String
(Int -> FN qpn -> ShowS)
-> (FN qpn -> String) -> ([FN qpn] -> ShowS) -> Show (FN qpn)
forall qpn. Show qpn => Int -> FN qpn -> ShowS
forall qpn. Show qpn => [FN qpn] -> ShowS
forall qpn. Show qpn => FN qpn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FN qpn] -> ShowS
$cshowList :: forall qpn. Show qpn => [FN qpn] -> ShowS
show :: FN qpn -> String
$cshow :: forall qpn. Show qpn => FN qpn -> String
showsPrec :: Int -> FN qpn -> ShowS
$cshowsPrec :: forall qpn. Show qpn => Int -> FN qpn -> ShowS
Show, a -> FN b -> FN a
(a -> b) -> FN a -> FN b
(forall a b. (a -> b) -> FN a -> FN b)
-> (forall a b. a -> FN b -> FN a) -> Functor FN
forall a b. a -> FN b -> FN a
forall a b. (a -> b) -> FN a -> FN b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FN b -> FN a
$c<$ :: forall a b. a -> FN b -> FN a
fmap :: (a -> b) -> FN a -> FN b
$cfmap :: forall a b. (a -> b) -> FN a -> FN b
Functor)

-- | Flag identifier. Just a string.
type Flag = P.FlagName

-- | Stanza identifier.
type Stanza = OptionalStanza

unFlag :: Flag -> String
unFlag :: Flag -> String
unFlag = Flag -> String
P.unFlagName

mkFlag :: String -> Flag
mkFlag :: String -> Flag
mkFlag = String -> Flag
P.mkFlagName

-- | Flag info. Default value, whether the flag is manual, and
-- whether the flag is weak. Manual flags can only be set explicitly.
-- Weak flags are typically deferred by the solver.
data FInfo = FInfo { FInfo -> Bool
fdefault :: Bool, FInfo -> FlagType
fmanual :: FlagType, FInfo -> WeakOrTrivial
fweak :: WeakOrTrivial }
  deriving (FInfo -> FInfo -> Bool
(FInfo -> FInfo -> Bool) -> (FInfo -> FInfo -> Bool) -> Eq FInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FInfo -> FInfo -> Bool
$c/= :: FInfo -> FInfo -> Bool
== :: FInfo -> FInfo -> Bool
$c== :: FInfo -> FInfo -> Bool
Eq, Int -> FInfo -> ShowS
[FInfo] -> ShowS
FInfo -> String
(Int -> FInfo -> ShowS)
-> (FInfo -> String) -> ([FInfo] -> ShowS) -> Show FInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FInfo] -> ShowS
$cshowList :: [FInfo] -> ShowS
show :: FInfo -> String
$cshow :: FInfo -> String
showsPrec :: Int -> FInfo -> ShowS
$cshowsPrec :: Int -> FInfo -> ShowS
Show)

-- | Flag defaults.
type FlagInfo = Map Flag FInfo

-- | Qualified flag name.
type QFN = FN QPN

-- | Stanza name. Paired with a package name, much like a flag.
data SN qpn = SN qpn Stanza
  deriving (SN qpn -> SN qpn -> Bool
(SN qpn -> SN qpn -> Bool)
-> (SN qpn -> SN qpn -> Bool) -> Eq (SN qpn)
forall qpn. Eq qpn => SN qpn -> SN qpn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SN qpn -> SN qpn -> Bool
$c/= :: forall qpn. Eq qpn => SN qpn -> SN qpn -> Bool
== :: SN qpn -> SN qpn -> Bool
$c== :: forall qpn. Eq qpn => SN qpn -> SN qpn -> Bool
Eq, Eq (SN qpn)
Eq (SN qpn)
-> (SN qpn -> SN qpn -> Ordering)
-> (SN qpn -> SN qpn -> Bool)
-> (SN qpn -> SN qpn -> Bool)
-> (SN qpn -> SN qpn -> Bool)
-> (SN qpn -> SN qpn -> Bool)
-> (SN qpn -> SN qpn -> SN qpn)
-> (SN qpn -> SN qpn -> SN qpn)
-> Ord (SN qpn)
SN qpn -> SN qpn -> Bool
SN qpn -> SN qpn -> Ordering
SN qpn -> SN qpn -> SN qpn
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall qpn. Ord qpn => Eq (SN qpn)
forall qpn. Ord qpn => SN qpn -> SN qpn -> Bool
forall qpn. Ord qpn => SN qpn -> SN qpn -> Ordering
forall qpn. Ord qpn => SN qpn -> SN qpn -> SN qpn
min :: SN qpn -> SN qpn -> SN qpn
$cmin :: forall qpn. Ord qpn => SN qpn -> SN qpn -> SN qpn
max :: SN qpn -> SN qpn -> SN qpn
$cmax :: forall qpn. Ord qpn => SN qpn -> SN qpn -> SN qpn
>= :: SN qpn -> SN qpn -> Bool
$c>= :: forall qpn. Ord qpn => SN qpn -> SN qpn -> Bool
> :: SN qpn -> SN qpn -> Bool
$c> :: forall qpn. Ord qpn => SN qpn -> SN qpn -> Bool
<= :: SN qpn -> SN qpn -> Bool
$c<= :: forall qpn. Ord qpn => SN qpn -> SN qpn -> Bool
< :: SN qpn -> SN qpn -> Bool
$c< :: forall qpn. Ord qpn => SN qpn -> SN qpn -> Bool
compare :: SN qpn -> SN qpn -> Ordering
$ccompare :: forall qpn. Ord qpn => SN qpn -> SN qpn -> Ordering
$cp1Ord :: forall qpn. Ord qpn => Eq (SN qpn)
Ord, Int -> SN qpn -> ShowS
[SN qpn] -> ShowS
SN qpn -> String
(Int -> SN qpn -> ShowS)
-> (SN qpn -> String) -> ([SN qpn] -> ShowS) -> Show (SN qpn)
forall qpn. Show qpn => Int -> SN qpn -> ShowS
forall qpn. Show qpn => [SN qpn] -> ShowS
forall qpn. Show qpn => SN qpn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SN qpn] -> ShowS
$cshowList :: forall qpn. Show qpn => [SN qpn] -> ShowS
show :: SN qpn -> String
$cshow :: forall qpn. Show qpn => SN qpn -> String
showsPrec :: Int -> SN qpn -> ShowS
$cshowsPrec :: forall qpn. Show qpn => Int -> SN qpn -> ShowS
Show, a -> SN b -> SN a
(a -> b) -> SN a -> SN b
(forall a b. (a -> b) -> SN a -> SN b)
-> (forall a b. a -> SN b -> SN a) -> Functor SN
forall a b. a -> SN b -> SN a
forall a b. (a -> b) -> SN a -> SN b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SN b -> SN a
$c<$ :: forall a b. a -> SN b -> SN a
fmap :: (a -> b) -> SN a -> SN b
$cfmap :: forall a b. (a -> b) -> SN a -> SN b
Functor)

-- | Qualified stanza name.
type QSN = SN QPN

-- | A property of flag and stanza choices that determines whether the
-- choice should be deferred in the solving process.
--
-- A choice is called weak if we do want to defer it. This is the
-- case for flags that should be implied by what's currently installed on
-- the system, as opposed to flags that are used to explicitly enable or
-- disable some functionality.
--
-- A choice is called trivial if it clearly does not matter. The
-- special case of triviality we actually consider is if there are no new
-- dependencies introduced by the choice.
newtype WeakOrTrivial = WeakOrTrivial { WeakOrTrivial -> Bool
unWeakOrTrivial :: Bool }
  deriving (WeakOrTrivial -> WeakOrTrivial -> Bool
(WeakOrTrivial -> WeakOrTrivial -> Bool)
-> (WeakOrTrivial -> WeakOrTrivial -> Bool) -> Eq WeakOrTrivial
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WeakOrTrivial -> WeakOrTrivial -> Bool
$c/= :: WeakOrTrivial -> WeakOrTrivial -> Bool
== :: WeakOrTrivial -> WeakOrTrivial -> Bool
$c== :: WeakOrTrivial -> WeakOrTrivial -> Bool
Eq, Eq WeakOrTrivial
Eq WeakOrTrivial
-> (WeakOrTrivial -> WeakOrTrivial -> Ordering)
-> (WeakOrTrivial -> WeakOrTrivial -> Bool)
-> (WeakOrTrivial -> WeakOrTrivial -> Bool)
-> (WeakOrTrivial -> WeakOrTrivial -> Bool)
-> (WeakOrTrivial -> WeakOrTrivial -> Bool)
-> (WeakOrTrivial -> WeakOrTrivial -> WeakOrTrivial)
-> (WeakOrTrivial -> WeakOrTrivial -> WeakOrTrivial)
-> Ord WeakOrTrivial
WeakOrTrivial -> WeakOrTrivial -> Bool
WeakOrTrivial -> WeakOrTrivial -> Ordering
WeakOrTrivial -> WeakOrTrivial -> WeakOrTrivial
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WeakOrTrivial -> WeakOrTrivial -> WeakOrTrivial
$cmin :: WeakOrTrivial -> WeakOrTrivial -> WeakOrTrivial
max :: WeakOrTrivial -> WeakOrTrivial -> WeakOrTrivial
$cmax :: WeakOrTrivial -> WeakOrTrivial -> WeakOrTrivial
>= :: WeakOrTrivial -> WeakOrTrivial -> Bool
$c>= :: WeakOrTrivial -> WeakOrTrivial -> Bool
> :: WeakOrTrivial -> WeakOrTrivial -> Bool
$c> :: WeakOrTrivial -> WeakOrTrivial -> Bool
<= :: WeakOrTrivial -> WeakOrTrivial -> Bool
$c<= :: WeakOrTrivial -> WeakOrTrivial -> Bool
< :: WeakOrTrivial -> WeakOrTrivial -> Bool
$c< :: WeakOrTrivial -> WeakOrTrivial -> Bool
compare :: WeakOrTrivial -> WeakOrTrivial -> Ordering
$ccompare :: WeakOrTrivial -> WeakOrTrivial -> Ordering
$cp1Ord :: Eq WeakOrTrivial
Ord, Int -> WeakOrTrivial -> ShowS
[WeakOrTrivial] -> ShowS
WeakOrTrivial -> String
(Int -> WeakOrTrivial -> ShowS)
-> (WeakOrTrivial -> String)
-> ([WeakOrTrivial] -> ShowS)
-> Show WeakOrTrivial
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WeakOrTrivial] -> ShowS
$cshowList :: [WeakOrTrivial] -> ShowS
show :: WeakOrTrivial -> String
$cshow :: WeakOrTrivial -> String
showsPrec :: Int -> WeakOrTrivial -> ShowS
$cshowsPrec :: Int -> WeakOrTrivial -> ShowS
Show)

-- | Value shown for a flag in a solver log message. The message can refer to
-- only the true choice, only the false choice, or both choices.
data FlagValue = FlagTrue | FlagFalse | FlagBoth
  deriving (FlagValue -> FlagValue -> Bool
(FlagValue -> FlagValue -> Bool)
-> (FlagValue -> FlagValue -> Bool) -> Eq FlagValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlagValue -> FlagValue -> Bool
$c/= :: FlagValue -> FlagValue -> Bool
== :: FlagValue -> FlagValue -> Bool
$c== :: FlagValue -> FlagValue -> Bool
Eq, Int -> FlagValue -> ShowS
[FlagValue] -> ShowS
FlagValue -> String
(Int -> FlagValue -> ShowS)
-> (FlagValue -> String)
-> ([FlagValue] -> ShowS)
-> Show FlagValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlagValue] -> ShowS
$cshowList :: [FlagValue] -> ShowS
show :: FlagValue -> String
$cshow :: FlagValue -> String
showsPrec :: Int -> FlagValue -> ShowS
$cshowsPrec :: Int -> FlagValue -> ShowS
Show)

showQFNBool :: QFN -> Bool -> String
showQFNBool :: QFN -> Bool -> String
showQFNBool qfn :: QFN
qfn@(FN QPN
qpn Flag
_f) Bool
b = QPN -> String
showQPN QPN
qpn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ QFN -> Bool -> String
forall qpn. FN qpn -> Bool -> String
showFBool QFN
qfn Bool
b

showQSNBool :: QSN -> Bool -> String
showQSNBool :: QSN -> Bool -> String
showQSNBool (SN QPN
qpn Stanza
s) Bool
b = QPN -> String
showQPN QPN
qpn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Stanza -> Bool -> String
showSBool Stanza
s Bool
b

showFBool :: FN qpn -> Bool -> String
showFBool :: FN qpn -> Bool -> String
showFBool (FN qpn
_ Flag
f) Bool
v = (Flag, Bool) -> String
P.showFlagValue (Flag
f, Bool
v)

-- | String representation of a flag-value pair.
showFlagValue :: P.FlagName -> FlagValue -> String
showFlagValue :: Flag -> FlagValue -> String
showFlagValue Flag
f FlagValue
FlagTrue  = Char
'+' Char -> ShowS
forall a. a -> [a] -> [a]
: Flag -> String
unFlag Flag
f
showFlagValue Flag
f FlagValue
FlagFalse = Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Flag -> String
unFlag Flag
f
showFlagValue Flag
f FlagValue
FlagBoth  = String
"+/-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Flag -> String
unFlag Flag
f

showSBool :: Stanza -> Bool -> String
showSBool :: Stanza -> Bool -> String
showSBool Stanza
s Bool
True  = String
"*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Stanza -> String
showStanza Stanza
s
showSBool Stanza
s Bool
False = String
"!" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Stanza -> String
showStanza Stanza
s

showQFN :: QFN -> String
showQFN :: QFN -> String
showQFN (FN QPN
qpn Flag
f) = QPN -> String
showQPN QPN
qpn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Flag -> String
unFlag Flag
f

showQSN :: QSN -> String
showQSN :: QSN -> String
showQSN (SN QPN
qpn Stanza
s) = QPN -> String
showQPN QPN
qpn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Stanza -> String
showStanza Stanza
s