{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Distribution.Types.Flag (
    Flag(..),
    emptyFlag,
    FlagName,
    mkFlagName,
    unFlagName,
    FlagAssignment,
    mkFlagAssignment,
    unFlagAssignment,
    lookupFlagAssignment,
    insertFlagAssignment,
    diffFlagAssignment,
    findDuplicateFlagAssignments,
    nullFlagAssignment,
    showFlagValue,
    dispFlagAssignment,
    parsecFlagAssignment,
    ) where

import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Utils.ShortText
import Distribution.Utils.Generic (lowercase)

import Distribution.Parsec
import Distribution.Pretty

import qualified Data.Map as Map
import qualified Text.PrettyPrint as Disp
import qualified Distribution.Compat.CharParsing as P

-- -----------------------------------------------------------------------------
-- The Flag' type

-- | A flag can represent a feature to be included, or a way of linking
--   a target against its dependencies, or in fact whatever you can think of.
data Flag = MkFlag
    { Flag -> FlagName
flagName        :: FlagName
    , Flag -> String
flagDescription :: String
    , Flag -> Bool
flagDefault     :: Bool
    , Flag -> Bool
flagManual      :: Bool
    }
    deriving (Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
(Int -> Flag -> ShowS)
-> (Flag -> String) -> ([Flag] -> ShowS) -> Show Flag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> String
$cshow :: Flag -> String
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
External instance of the constraint type Show Char
External instance of the constraint type Show Bool
External instance of the constraint type Show Bool
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show FlagName
Show, Flag -> Flag -> Bool
(Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Eq Bool
External instance of the constraint type Eq Bool
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
Instance of class: Eq of the constraint type Eq FlagName
Eq, Typeable, Typeable Flag
DataType
Constr
Typeable Flag
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Flag -> c Flag)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Flag)
-> (Flag -> Constr)
-> (Flag -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Flag))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Flag))
-> ((forall b. Data b => b -> b) -> Flag -> Flag)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Flag -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Flag -> r)
-> (forall u. (forall d. Data d => d -> u) -> Flag -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Flag -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Flag -> m Flag)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Flag -> m Flag)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Flag -> m Flag)
-> Data Flag
Flag -> DataType
Flag -> Constr
(forall b. Data b => b -> b) -> Flag -> Flag
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Flag -> c Flag
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Flag
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Flag -> u
forall u. (forall d. Data d => d -> u) -> Flag -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Flag -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Flag -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Flag -> m Flag
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Flag -> m Flag
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Flag
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Flag -> c Flag
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Flag)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Flag)
$cMkFlag :: Constr
$tFlag :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Flag -> m Flag
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Flag -> m Flag
gmapMp :: (forall d. Data d => d -> m d) -> Flag -> m Flag
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Flag -> m Flag
gmapM :: (forall d. Data d => d -> m d) -> Flag -> m Flag
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Flag -> m Flag
gmapQi :: Int -> (forall d. Data d => d -> u) -> Flag -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Flag -> u
gmapQ :: (forall d. Data d => d -> u) -> Flag -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Flag -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Flag -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Flag -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Flag -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Flag -> r
gmapT :: (forall b. Data b => b -> b) -> Flag -> Flag
$cgmapT :: (forall b. Data b => b -> b) -> Flag -> Flag
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Flag)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Flag)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Flag)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Flag)
dataTypeOf :: Flag -> DataType
$cdataTypeOf :: Flag -> DataType
toConstr :: Flag -> Constr
$ctoConstr :: Flag -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Flag
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Flag
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Flag -> c Flag
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Flag -> c Flag
External instance of the constraint type Data Char
External instance of the constraint type Data Char
External instance of the constraint type Data Bool
External instance of the constraint type Data Char
External instance of the constraint type forall a. Data a => Data [a]
External instance of the constraint type Data Bool
External instance of the constraint type Data Bool
Instance of class: Data of the constraint type Data FlagName
Data, (forall x. Flag -> Rep Flag x)
-> (forall x. Rep Flag x -> Flag) -> Generic Flag
forall x. Rep Flag x -> Flag
forall x. Flag -> Rep Flag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Flag x -> Flag
$cfrom :: forall x. Flag -> Rep Flag x
Generic)

instance Binary Flag
instance Structured Flag

instance NFData Flag where rnf :: Flag -> ()
rnf = Flag -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
Instance of class: NFData of the constraint type NFData FlagName
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type NFData Char
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData Bool
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData Bool
Instance of class: Generic of the constraint type Generic Flag
genericRnf

-- | A 'Flag' initialized with default parameters.
emptyFlag :: FlagName -> Flag
emptyFlag :: FlagName -> Flag
emptyFlag FlagName
name = MkFlag :: FlagName -> String -> Bool -> Bool -> Flag
MkFlag
    { flagName :: FlagName
flagName        = FlagName
name
    , flagDescription :: String
flagDescription = String
""
    , flagDefault :: Bool
flagDefault     = Bool
True
    , flagManual :: Bool
flagManual      = Bool
False
    }

-- | A 'FlagName' is the name of a user-defined configuration flag
--
-- Use 'mkFlagName' and 'unFlagName' to convert from/to a 'String'.
--
-- This type is opaque since @Cabal-2.0@
--
-- @since 2.0.0.2
newtype FlagName = FlagName ShortText
    deriving (FlagName -> FlagName -> Bool
(FlagName -> FlagName -> Bool)
-> (FlagName -> FlagName -> Bool) -> Eq FlagName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlagName -> FlagName -> Bool
$c/= :: FlagName -> FlagName -> Bool
== :: FlagName -> FlagName -> Bool
$c== :: FlagName -> FlagName -> Bool
External instance of the constraint type Eq ShortText
Eq, (forall x. FlagName -> Rep FlagName x)
-> (forall x. Rep FlagName x -> FlagName) -> Generic FlagName
forall x. Rep FlagName x -> FlagName
forall x. FlagName -> Rep FlagName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlagName x -> FlagName
$cfrom :: forall x. FlagName -> Rep FlagName x
Generic, Eq FlagName
Eq FlagName
-> (FlagName -> FlagName -> Ordering)
-> (FlagName -> FlagName -> Bool)
-> (FlagName -> FlagName -> Bool)
-> (FlagName -> FlagName -> Bool)
-> (FlagName -> FlagName -> Bool)
-> (FlagName -> FlagName -> FlagName)
-> (FlagName -> FlagName -> FlagName)
-> Ord FlagName
FlagName -> FlagName -> Bool
FlagName -> FlagName -> Ordering
FlagName -> FlagName -> FlagName
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 :: FlagName -> FlagName -> FlagName
$cmin :: FlagName -> FlagName -> FlagName
max :: FlagName -> FlagName -> FlagName
$cmax :: FlagName -> FlagName -> FlagName
>= :: FlagName -> FlagName -> Bool
$c>= :: FlagName -> FlagName -> Bool
> :: FlagName -> FlagName -> Bool
$c> :: FlagName -> FlagName -> Bool
<= :: FlagName -> FlagName -> Bool
$c<= :: FlagName -> FlagName -> Bool
< :: FlagName -> FlagName -> Bool
$c< :: FlagName -> FlagName -> Bool
compare :: FlagName -> FlagName -> Ordering
$ccompare :: FlagName -> FlagName -> Ordering
External instance of the constraint type Ord ShortText
Instance of class: Eq of the constraint type Eq FlagName
Instance of class: Eq of the constraint type Eq FlagName
Ord, Int -> FlagName -> ShowS
[FlagName] -> ShowS
FlagName -> String
(Int -> FlagName -> ShowS)
-> (FlagName -> String) -> ([FlagName] -> ShowS) -> Show FlagName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlagName] -> ShowS
$cshowList :: [FlagName] -> ShowS
show :: FlagName -> String
$cshow :: FlagName -> String
showsPrec :: Int -> FlagName -> ShowS
$cshowsPrec :: Int -> FlagName -> ShowS
External instance of the constraint type Show ShortText
External instance of the constraint type Ord Int
Show, ReadPrec [FlagName]
ReadPrec FlagName
Int -> ReadS FlagName
ReadS [FlagName]
(Int -> ReadS FlagName)
-> ReadS [FlagName]
-> ReadPrec FlagName
-> ReadPrec [FlagName]
-> Read FlagName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FlagName]
$creadListPrec :: ReadPrec [FlagName]
readPrec :: ReadPrec FlagName
$creadPrec :: ReadPrec FlagName
readList :: ReadS [FlagName]
$creadList :: ReadS [FlagName]
readsPrec :: Int -> ReadS FlagName
$creadsPrec :: Int -> ReadS FlagName
External instance of the constraint type Read ShortText
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read FlagName
Read, Typeable, Typeable FlagName
DataType
Constr
Typeable FlagName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FlagName -> c FlagName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FlagName)
-> (FlagName -> Constr)
-> (FlagName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FlagName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FlagName))
-> ((forall b. Data b => b -> b) -> FlagName -> FlagName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FlagName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FlagName -> r)
-> (forall u. (forall d. Data d => d -> u) -> FlagName -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> FlagName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FlagName -> m FlagName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FlagName -> m FlagName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FlagName -> m FlagName)
-> Data FlagName
FlagName -> DataType
FlagName -> Constr
(forall b. Data b => b -> b) -> FlagName -> FlagName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FlagName -> c FlagName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FlagName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FlagName -> u
forall u. (forall d. Data d => d -> u) -> FlagName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FlagName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FlagName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FlagName -> m FlagName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FlagName -> m FlagName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FlagName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FlagName -> c FlagName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FlagName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FlagName)
$cFlagName :: Constr
$tFlagName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> FlagName -> m FlagName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FlagName -> m FlagName
gmapMp :: (forall d. Data d => d -> m d) -> FlagName -> m FlagName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FlagName -> m FlagName
gmapM :: (forall d. Data d => d -> m d) -> FlagName -> m FlagName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FlagName -> m FlagName
gmapQi :: Int -> (forall d. Data d => d -> u) -> FlagName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FlagName -> u
gmapQ :: (forall d. Data d => d -> u) -> FlagName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FlagName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FlagName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FlagName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FlagName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FlagName -> r
gmapT :: (forall b. Data b => b -> b) -> FlagName -> FlagName
$cgmapT :: (forall b. Data b => b -> b) -> FlagName -> FlagName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FlagName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FlagName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FlagName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FlagName)
dataTypeOf :: FlagName -> DataType
$cdataTypeOf :: FlagName -> DataType
toConstr :: FlagName -> Constr
$ctoConstr :: FlagName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FlagName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FlagName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FlagName -> c FlagName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FlagName -> c FlagName
External instance of the constraint type Data ShortText
Data, FlagName -> ()
(FlagName -> ()) -> NFData FlagName
forall a. (a -> ()) -> NFData a
rnf :: FlagName -> ()
$crnf :: FlagName -> ()
External instance of the constraint type NFData ShortText
NFData)

-- | Construct a 'FlagName' from a 'String'
--
-- 'mkFlagName' is the inverse to 'unFlagName'
--
-- Note: No validations are performed to ensure that the resulting
-- 'FlagName' is valid
--
-- @since 2.0.0.2
mkFlagName :: String -> FlagName
mkFlagName :: String -> FlagName
mkFlagName = ShortText -> FlagName
FlagName (ShortText -> FlagName)
-> (String -> ShortText) -> String -> FlagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShortText
toShortText

-- | 'mkFlagName'
--
-- @since 2.0.0.2
instance IsString FlagName where
    fromString :: String -> FlagName
fromString = String -> FlagName
mkFlagName

-- | Convert 'FlagName' to 'String'
--
-- @since 2.0.0.2
unFlagName :: FlagName -> String
unFlagName :: FlagName -> String
unFlagName (FlagName ShortText
s) = ShortText -> String
fromShortText ShortText
s

instance Binary FlagName
instance Structured FlagName

instance Pretty FlagName where
    pretty :: FlagName -> Doc
pretty = String -> Doc
Disp.text (String -> Doc) -> (FlagName -> String) -> FlagName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagName -> String
unFlagName

instance Parsec FlagName where
    -- Note:  we don't check that FlagName doesn't have leading dash,
    -- cabal check will do that.
    parsec :: m FlagName
parsec = String -> FlagName
mkFlagName (String -> FlagName) -> ShowS -> String -> FlagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
lowercase (String -> FlagName) -> m String -> m FlagName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m String
parsec'
      where
        parsec' :: m String
parsec' = (:) (Char -> ShowS) -> m Char -> m ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m Char
lead m ShowS -> m String -> m String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<*> m String
rest
        lead :: m Char
lead = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.satisfy (\Char
c ->  Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'_')
        rest :: m String
rest = (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.munch (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'-')

-- | A 'FlagAssignment' is a total or partial mapping of 'FlagName's to
-- 'Bool' flag values. It represents the flags chosen by the user or
-- discovered during configuration. For example @--flags=foo --flags=-bar@
-- becomes @[("foo", True), ("bar", False)]@
--
newtype FlagAssignment
  = FlagAssignment { FlagAssignment -> Map FlagName (Int, Bool)
getFlagAssignment :: Map.Map FlagName (Int, Bool) }
  deriving (Get FlagAssignment
[FlagAssignment] -> Put
FlagAssignment -> Put
(FlagAssignment -> Put)
-> Get FlagAssignment
-> ([FlagAssignment] -> Put)
-> Binary FlagAssignment
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [FlagAssignment] -> Put
$cputList :: [FlagAssignment] -> Put
get :: Get FlagAssignment
$cget :: Get FlagAssignment
put :: FlagAssignment -> Put
$cput :: FlagAssignment -> Put
External instance of the constraint type Binary Bool
External instance of the constraint type Binary Int
External instance of the constraint type Binary Bool
External instance of the constraint type Binary Int
External instance of the constraint type Binary Int
External instance of the constraint type Binary Bool
External instance of the constraint type Binary Int
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
External instance of the constraint type Binary Int
External instance of the constraint type Binary Bool
Instance of class: Binary of the constraint type Binary FlagName
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
External instance of the constraint type Binary Int
External instance of the constraint type Binary Bool
Instance of class: Binary of the constraint type Binary FlagName
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
External instance of the constraint type Binary Int
External instance of the constraint type Binary Bool
Instance of class: Binary of the constraint type Binary FlagName
External instance of the constraint type forall k e. (Binary k, Binary e) => Binary (Map k e)
External instance of the constraint type Binary Bool
Instance of class: Binary of the constraint type Binary FlagName
Binary, (forall x. FlagAssignment -> Rep FlagAssignment x)
-> (forall x. Rep FlagAssignment x -> FlagAssignment)
-> Generic FlagAssignment
forall x. Rep FlagAssignment x -> FlagAssignment
forall x. FlagAssignment -> Rep FlagAssignment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlagAssignment x -> FlagAssignment
$cfrom :: forall x. FlagAssignment -> Rep FlagAssignment x
Generic, FlagAssignment -> ()
(FlagAssignment -> ()) -> NFData FlagAssignment
forall a. (a -> ()) -> NFData a
rnf :: FlagAssignment -> ()
$crnf :: FlagAssignment -> ()
External instance of the constraint type NFData Int
External instance of the constraint type NFData Bool
External instance of the constraint type NFData Int
External instance of the constraint type forall a b. (NFData a, NFData b) => NFData (a, b)
External instance of the constraint type forall a b. (NFData a, NFData b) => NFData (a, b)
External instance of the constraint type NFData Int
External instance of the constraint type NFData Bool
Instance of class: NFData of the constraint type NFData FlagName
External instance of the constraint type forall k a. (NFData k, NFData a) => NFData (Map k a)
External instance of the constraint type NFData Bool
Instance of class: NFData of the constraint type NFData FlagName
NFData, Typeable)

instance Structured FlagAssignment

instance Eq FlagAssignment where
  == :: FlagAssignment -> FlagAssignment -> Bool
(==) (FlagAssignment Map FlagName (Int, Bool)
m1) (FlagAssignment Map FlagName (Int, Bool)
m2)
    = ((Int, Bool) -> Bool)
-> Map FlagName (Int, Bool) -> Map FlagName Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall k. Functor (Map k)
fmap (Int, Bool) -> Bool
forall a b. (a, b) -> b
snd Map FlagName (Int, Bool)
m1 Map FlagName Bool -> Map FlagName Bool -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall k a. (Eq k, Eq a) => Eq (Map k a)
Instance of class: Eq of the constraint type Eq FlagName
External instance of the constraint type Eq Bool
== ((Int, Bool) -> Bool)
-> Map FlagName (Int, Bool) -> Map FlagName Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall k. Functor (Map k)
fmap (Int, Bool) -> Bool
forall a b. (a, b) -> b
snd Map FlagName (Int, Bool)
m2

instance Ord FlagAssignment where
  compare :: FlagAssignment -> FlagAssignment -> Ordering
compare (FlagAssignment Map FlagName (Int, Bool)
m1) (FlagAssignment Map FlagName (Int, Bool)
m2)
    = ((Int, Bool) -> Bool)
-> Map FlagName (Int, Bool) -> Map FlagName Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall k. Functor (Map k)
fmap (Int, Bool) -> Bool
forall a b. (a, b) -> b
snd Map FlagName (Int, Bool)
m1 Map FlagName Bool -> Map FlagName Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type forall k v. (Ord k, Ord v) => Ord (Map k v)
Instance of class: Ord of the constraint type Ord FlagName
External instance of the constraint type Ord Bool
`compare` ((Int, Bool) -> Bool)
-> Map FlagName (Int, Bool) -> Map FlagName Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall k. Functor (Map k)
fmap (Int, Bool) -> Bool
forall a b. (a, b) -> b
snd Map FlagName (Int, Bool)
m2

-- | Combines pairs of values contained in the 'FlagAssignment' Map.
--
-- The last flag specified takes precedence, and we record the number
-- of times we have seen the flag.
--
combineFlagValues :: (Int, Bool) -> (Int, Bool) -> (Int, Bool)
combineFlagValues :: (Int, Bool) -> (Int, Bool) -> (Int, Bool)
combineFlagValues (Int
c1, Bool
_) (Int
c2, Bool
b2) = (Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
c2, Bool
b2)

-- The 'Semigroup' instance currently is right-biased.
--
-- If duplicate flags are specified, we want the last flag specified to
-- take precedence and we want to know how many times the flag has been
-- specified so that we have the option of warning the user about
-- supplying duplicate flags.
instance Semigroup FlagAssignment where
  <> :: FlagAssignment -> FlagAssignment -> FlagAssignment
(<>) (FlagAssignment Map FlagName (Int, Bool)
m1) (FlagAssignment Map FlagName (Int, Bool)
m2)
    = Map FlagName (Int, Bool) -> FlagAssignment
FlagAssignment (((Int, Bool) -> (Int, Bool) -> (Int, Bool))
-> Map FlagName (Int, Bool)
-> Map FlagName (Int, Bool)
-> Map FlagName (Int, Bool)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Instance of class: Ord of the constraint type Ord FlagName
Map.unionWith (Int, Bool) -> (Int, Bool) -> (Int, Bool)
combineFlagValues Map FlagName (Int, Bool)
m1 Map FlagName (Int, Bool)
m2)

instance Monoid FlagAssignment where
  mempty :: FlagAssignment
mempty = Map FlagName (Int, Bool) -> FlagAssignment
FlagAssignment Map FlagName (Int, Bool)
forall k a. Map k a
Map.empty
  mappend :: FlagAssignment -> FlagAssignment -> FlagAssignment
mappend = FlagAssignment -> FlagAssignment -> FlagAssignment
forall a. Semigroup a => a -> a -> a
Instance of class: Semigroup of the constraint type Semigroup FlagAssignment
(<>)

-- | Construct a 'FlagAssignment' from a list of flag/value pairs.
--
-- If duplicate flags occur in the input list, the later entries
-- in the list will take precedence.
--
-- @since 2.2.0
mkFlagAssignment :: [(FlagName, Bool)] -> FlagAssignment
mkFlagAssignment :: [(FlagName, Bool)] -> FlagAssignment
mkFlagAssignment =
  Map FlagName (Int, Bool) -> FlagAssignment
FlagAssignment (Map FlagName (Int, Bool) -> FlagAssignment)
-> ([(FlagName, Bool)] -> Map FlagName (Int, Bool))
-> [(FlagName, Bool)]
-> FlagAssignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ((Int, Bool) -> (Int, Bool) -> (Int, Bool))
-> [(FlagName, (Int, Bool))] -> Map FlagName (Int, Bool)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Instance of class: Ord of the constraint type Ord FlagName
Map.fromListWith (((Int, Bool) -> (Int, Bool) -> (Int, Bool))
-> (Int, Bool) -> (Int, Bool) -> (Int, Bool)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int, Bool) -> (Int, Bool) -> (Int, Bool)
combineFlagValues) ([(FlagName, (Int, Bool))] -> Map FlagName (Int, Bool))
-> ([(FlagName, Bool)] -> [(FlagName, (Int, Bool))])
-> [(FlagName, Bool)]
-> Map FlagName (Int, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FlagName, Bool) -> (FlagName, (Int, Bool)))
-> [(FlagName, Bool)] -> [(FlagName, (Int, Bool))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor []
fmap ((Bool -> (Int, Bool))
-> (FlagName, Bool) -> (FlagName, (Int, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall a. Functor ((,) a)
fmap (\Bool
b -> (Int
1, Bool
b)))

-- | Deconstruct a 'FlagAssignment' into a list of flag/value pairs.
--
-- @ 'null' ('findDuplicateFlagAssignments' fa) ==> ('mkFlagAssignment' . 'unFlagAssignment') fa == fa @
--
-- @since 2.2.0
unFlagAssignment :: FlagAssignment -> [(FlagName, Bool)]
unFlagAssignment :: FlagAssignment -> [(FlagName, Bool)]
unFlagAssignment = ((FlagName, (Int, Bool)) -> (FlagName, Bool))
-> [(FlagName, (Int, Bool))] -> [(FlagName, Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor []
fmap (((Int, Bool) -> Bool)
-> (FlagName, (Int, Bool)) -> (FlagName, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall a. Functor ((,) a)
fmap (Int, Bool) -> Bool
forall a b. (a, b) -> b
snd) ([(FlagName, (Int, Bool))] -> [(FlagName, Bool)])
-> (FlagAssignment -> [(FlagName, (Int, Bool))])
-> FlagAssignment
-> [(FlagName, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FlagName (Int, Bool) -> [(FlagName, (Int, Bool))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map FlagName (Int, Bool) -> [(FlagName, (Int, Bool))])
-> (FlagAssignment -> Map FlagName (Int, Bool))
-> FlagAssignment
-> [(FlagName, (Int, Bool))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagAssignment -> Map FlagName (Int, Bool)
getFlagAssignment

-- | Test whether 'FlagAssignment' is empty.
--
-- @since 2.2.0
nullFlagAssignment :: FlagAssignment -> Bool
nullFlagAssignment :: FlagAssignment -> Bool
nullFlagAssignment = Map FlagName (Int, Bool) -> Bool
forall k a. Map k a -> Bool
Map.null (Map FlagName (Int, Bool) -> Bool)
-> (FlagAssignment -> Map FlagName (Int, Bool))
-> FlagAssignment
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagAssignment -> Map FlagName (Int, Bool)
getFlagAssignment

-- | Lookup the value for a flag
--
-- Returns 'Nothing' if the flag isn't contained in the 'FlagAssignment'.
--
-- @since 2.2.0
lookupFlagAssignment :: FlagName -> FlagAssignment -> Maybe Bool
lookupFlagAssignment :: FlagName -> FlagAssignment -> Maybe Bool
lookupFlagAssignment FlagName
fn = ((Int, Bool) -> Bool) -> Maybe (Int, Bool) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor Maybe
fmap (Int, Bool) -> Bool
forall a b. (a, b) -> b
snd (Maybe (Int, Bool) -> Maybe Bool)
-> (FlagAssignment -> Maybe (Int, Bool))
-> FlagAssignment
-> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagName -> Map FlagName (Int, Bool) -> Maybe (Int, Bool)
forall k a. Ord k => k -> Map k a -> Maybe a
Instance of class: Ord of the constraint type Ord FlagName
Map.lookup FlagName
fn (Map FlagName (Int, Bool) -> Maybe (Int, Bool))
-> (FlagAssignment -> Map FlagName (Int, Bool))
-> FlagAssignment
-> Maybe (Int, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagAssignment -> Map FlagName (Int, Bool)
getFlagAssignment

-- | Insert or update the boolean value of a flag.
--
-- If the flag is already present in the 'FlagAssigment', the
-- value will be updated and the fact that multiple values have
-- been provided for that flag will be recorded so that a
-- warning can be generated later on.
--
-- @since 2.2.0
insertFlagAssignment :: FlagName -> Bool -> FlagAssignment -> FlagAssignment
-- TODO: this currently just shadows prior values for an existing
-- flag; rather than enforcing uniqueness at construction, it's
-- verified later on via `D.C.Dependency.configuredPackageProblems`
insertFlagAssignment :: FlagName -> Bool -> FlagAssignment -> FlagAssignment
insertFlagAssignment FlagName
flag Bool
val =
  Map FlagName (Int, Bool) -> FlagAssignment
FlagAssignment (Map FlagName (Int, Bool) -> FlagAssignment)
-> (FlagAssignment -> Map FlagName (Int, Bool))
-> FlagAssignment
-> FlagAssignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ((Int, Bool) -> (Int, Bool) -> (Int, Bool))
-> FlagName
-> (Int, Bool)
-> Map FlagName (Int, Bool)
-> Map FlagName (Int, Bool)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Instance of class: Ord of the constraint type Ord FlagName
Map.insertWith (((Int, Bool) -> (Int, Bool) -> (Int, Bool))
-> (Int, Bool) -> (Int, Bool) -> (Int, Bool)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int, Bool) -> (Int, Bool) -> (Int, Bool)
combineFlagValues) FlagName
flag (Int
1, Bool
val) (Map FlagName (Int, Bool) -> Map FlagName (Int, Bool))
-> (FlagAssignment -> Map FlagName (Int, Bool))
-> FlagAssignment
-> Map FlagName (Int, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  FlagAssignment -> Map FlagName (Int, Bool)
getFlagAssignment

-- | Remove all flag-assignments from the first 'FlagAssignment' that
-- are contained in the second 'FlagAssignment'
--
-- NB/TODO: This currently only removes flag assignments which also
-- match the value assignment! We should review the code which uses
-- this operation to figure out if this it's not enough to only
-- compare the flagnames without the values.
--
-- @since 2.2.0
diffFlagAssignment :: FlagAssignment -> FlagAssignment -> FlagAssignment
diffFlagAssignment :: FlagAssignment -> FlagAssignment -> FlagAssignment
diffFlagAssignment FlagAssignment
fa1 FlagAssignment
fa2 = Map FlagName (Int, Bool) -> FlagAssignment
FlagAssignment
  (Map FlagName (Int, Bool)
-> Map FlagName (Int, Bool) -> Map FlagName (Int, Bool)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Instance of class: Ord of the constraint type Ord FlagName
Map.difference (FlagAssignment -> Map FlagName (Int, Bool)
getFlagAssignment FlagAssignment
fa1) (FlagAssignment -> Map FlagName (Int, Bool)
getFlagAssignment FlagAssignment
fa2))

-- | Find the 'FlagName's that have been listed more than once.
--
-- @since 2.2.0
findDuplicateFlagAssignments :: FlagAssignment -> [FlagName]
findDuplicateFlagAssignments :: FlagAssignment -> [FlagName]
findDuplicateFlagAssignments =
  Map FlagName (Int, Bool) -> [FlagName]
forall k a. Map k a -> [k]
Map.keys (Map FlagName (Int, Bool) -> [FlagName])
-> (FlagAssignment -> Map FlagName (Int, Bool))
-> FlagAssignment
-> [FlagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Bool) -> Bool)
-> Map FlagName (Int, Bool) -> Map FlagName (Int, Bool)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
> Int
1) (Int -> Bool) -> ((Int, Bool) -> Int) -> (Int, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Bool) -> Int
forall a b. (a, b) -> a
fst) (Map FlagName (Int, Bool) -> Map FlagName (Int, Bool))
-> (FlagAssignment -> Map FlagName (Int, Bool))
-> FlagAssignment
-> Map FlagName (Int, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagAssignment -> Map FlagName (Int, Bool)
getFlagAssignment

-- | @since 2.2.0
instance Read FlagAssignment where
    readsPrec :: Int -> ReadS FlagAssignment
readsPrec Int
p String
s = [ (Map FlagName (Int, Bool) -> FlagAssignment
FlagAssignment Map FlagName (Int, Bool)
x, String
rest) | (Map FlagName (Int, Bool)
x,String
rest) <- Int -> ReadS (Map FlagName (Int, Bool))
forall a. Read a => Int -> ReadS a
External instance of the constraint type forall k e. (Ord k, Read k, Read e) => Read (Map k e)
Instance of class: Ord of the constraint type Ord FlagName
Instance of class: Read of the constraint type Read FlagName
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type Read Int
External instance of the constraint type Read Bool
readsPrec Int
p String
s ]

-- | @since 2.2.0
instance Show FlagAssignment where
    showsPrec :: Int -> FlagAssignment -> ShowS
showsPrec Int
p (FlagAssignment Map FlagName (Int, Bool)
xs) = Int -> Map FlagName (Int, Bool) -> ShowS
forall a. Show a => Int -> a -> ShowS
External instance of the constraint type forall k a. (Show k, Show a) => Show (Map k a)
Instance of class: Show of the constraint type Show FlagName
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show Int
External instance of the constraint type Show Bool
showsPrec Int
p Map FlagName (Int, Bool)
xs

-- | String representation of a flag-value pair.
showFlagValue :: (FlagName, Bool) -> String
showFlagValue :: (FlagName, Bool) -> String
showFlagValue (FlagName
f, Bool
True)   = Char
'+' Char -> ShowS
forall a. a -> [a] -> [a]
: FlagName -> String
unFlagName FlagName
f
showFlagValue (FlagName
f, Bool
False)  = Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: FlagName -> String
unFlagName FlagName
f

-- | Pretty-prints a flag assignment.
dispFlagAssignment :: FlagAssignment -> Disp.Doc
dispFlagAssignment :: FlagAssignment -> Doc
dispFlagAssignment = [Doc] -> Doc
Disp.hsep ([Doc] -> Doc)
-> (FlagAssignment -> [Doc]) -> FlagAssignment -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FlagName, Bool) -> Doc) -> [(FlagName, Bool)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
Disp.text (String -> Doc)
-> ((FlagName, Bool) -> String) -> (FlagName, Bool) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlagName, Bool) -> String
showFlagValue) ([(FlagName, Bool)] -> [Doc])
-> (FlagAssignment -> [(FlagName, Bool)])
-> FlagAssignment
-> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagAssignment -> [(FlagName, Bool)]
unFlagAssignment

-- | Parses a flag assignment.
parsecFlagAssignment :: CabalParsing m => m FlagAssignment
parsecFlagAssignment :: m FlagAssignment
parsecFlagAssignment = [(FlagName, Bool)] -> FlagAssignment
mkFlagAssignment ([(FlagName, Bool)] -> FlagAssignment)
-> m [(FlagName, Bool)] -> m FlagAssignment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$>
                       m (FlagName, Bool) -> m () -> m [(FlagName, Bool)]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.sepBy (m (FlagName, Bool)
onFlag m (FlagName, Bool) -> m (FlagName, Bool) -> m (FlagName, Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<|> m (FlagName, Bool)
offFlag) m ()
forall (m :: * -> *). CharParsing m => m ()
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.skipSpaces1
  where
    onFlag :: m (FlagName, Bool)
onFlag = do
        Maybe Char
_ <- m Char -> m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.optional (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.char Char
'+')
        FlagName
f <- m FlagName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
Instance of class: Parsec of the constraint type Parsec FlagName
parsec
        (FlagName, Bool) -> m (FlagName, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return (FlagName
f, Bool
True)
    offFlag :: m (FlagName, Bool)
offFlag = do
        Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.char Char
'-'
        FlagName
f <- m FlagName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
Instance of class: Parsec of the constraint type Parsec FlagName
parsec
        (FlagName, Bool) -> m (FlagName, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return (FlagName
f, Bool
False)