cabal-install-solver/src/Distribution/Solver/Modular/Flag.hs

   1 {-# LANGUAGE DeriveFunctor #-}
   2 module Distribution.Solver.Modular.Flag
   3     ( FInfo(..)
   4     , Flag
   5     , FlagInfo
   6     , FN(..)
   7     , QFN
   8     , QSN
   9     , Stanza
  10     , SN(..)
  11     , WeakOrTrivial(..)
  12     , FlagValue(..)
  13     , mkFlag
  14     , showQFN
  15     , showQFNBool
  16     , showFlagValue
  17     , showQSN
  18     , showQSNBool
  19     , showSBool
  20     ) where
  21
  22 import Data.Map as M
  23 import Prelude hiding (pi)
  24
  25 import qualified Distribution.PackageDescription as P -- from Cabal
  26
  27 import Distribution.Solver.Types.Flag
  28 import Distribution.Solver.Types.OptionalStanza
  29 import Distribution.Solver.Types.PackagePath
  30
  31 -- | Flag name. Consists of a package instance and the flag identifier itself.
  32 data FN qpn = FN qpn Flag
  33   deriving (Eq, Ord, Show, Functor)
  34
  35 -- | Flag identifier. Just a string.
  36 type Flag = P.FlagName
  37
  38 -- | Stanza identifier.
  39 type Stanza = OptionalStanza
  40
  41 unFlag :: Flag -> String
  42 unFlag = P.unFlagName
  43
  44 mkFlag :: String -> Flag
  45 mkFlag = P.mkFlagName
  46
  47 -- | Flag info. Default value, whether the flag is manual, and
  48 -- whether the flag is weak. Manual flags can only be set explicitly.
  49 -- Weak flags are typically deferred by the solver.
  50 data FInfo = FInfo { fdefault :: Bool, fmanual :: FlagType, fweak :: WeakOrTrivial }
  51   deriving (Eq, Show)
  52
  53 -- | Flag defaults.
  54 type FlagInfo = Map Flag FInfo
  55
  56 -- | Qualified flag name.
  57 type QFN = FN QPN
  58
  59 -- | Stanza name. Paired with a package name, much like a flag.
  60 data SN qpn = SN qpn Stanza
  61   deriving (Eq, Ord, Show, Functor)
  62
  63 -- | Qualified stanza name.
  64 type QSN = SN QPN
  65
  66 -- | A property of flag and stanza choices that determines whether the
  67 -- choice should be deferred in the solving process.
  68 --
  69 -- A choice is called weak if we do want to defer it. This is the
  70 -- case for flags that should be implied by what's currently installed on
  71 -- the system, as opposed to flags that are used to explicitly enable or
  72 -- disable some functionality.
  73 --
  74 -- A choice is called trivial if it clearly does not matter. The
  75 -- special case of triviality we actually consider is if there are no new
  76 -- dependencies introduced by the choice.
  77 newtype WeakOrTrivial = WeakOrTrivial { unWeakOrTrivial :: Bool }
  78   deriving (Eq, Ord, Show)
  79
  80 -- | Value shown for a flag in a solver log message. The message can refer to
  81 -- only the true choice, only the false choice, or both choices.
  82 data FlagValue = FlagTrue | FlagFalse | FlagBoth
  83   deriving (Eq, Show)
  84
  85 showQFNBool :: QFN -> Bool -> String
  86 showQFNBool qfn@(FN qpn _f) b = showQPN qpn ++ ":" ++ showFBool qfn b
  87
  88 showQSNBool :: QSN -> Bool -> String
  89 showQSNBool (SN qpn s) b = showQPN qpn ++ ":" ++ showSBool s b
  90
  91 showFBool :: FN qpn -> Bool -> String
  92 showFBool (FN _ f) v = P.showFlagValue (f, v)
  93
  94 -- | String representation of a flag-value pair.
  95 showFlagValue :: P.FlagName -> FlagValue -> String
  96 showFlagValue f FlagTrue  = '+' : unFlag f
  97 showFlagValue f FlagFalse = '-' : unFlag f
  98 showFlagValue f FlagBoth  = "+/-" ++ unFlag f
  99
 100 showSBool :: Stanza -> Bool -> String
 101 showSBool s True  = "*" ++ showStanza s
 102 showSBool s False = "!" ++ showStanza s
 103
 104 showQFN :: QFN -> String
 105 showQFN (FN qpn f) = showQPN qpn ++ ":" ++ unFlag f
 106
 107 showQSN :: QSN -> String
 108 showQSN (SN qpn s) = showQPN qpn ++ ":" ++ showStanza s