{-# 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
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
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
$cp1Data :: Typeable Flag
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 -> ()
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
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
$cp1Ord :: 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
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
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
$cp1Data :: Typeable FlagName
Data, FlagName -> ()
(FlagName -> ()) -> NFData FlagName
forall a. (a -> ()) -> NFData a
rnf :: FlagName -> ()
$crnf :: FlagName -> ()
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
<$> 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
<$> m Char
lead m ShowS -> m String -> m String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m String
rest
        lead :: m Char
lead = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy (\Char
c ->  Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
        rest :: m String
rest = (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 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
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 -> ()
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
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
== ((Int, Bool) -> Bool)
-> Map FlagName (Int, Bool) -> Map FlagName Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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
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
`compare` ((Int, Bool) -> Bool)
-> Map FlagName (Int, Bool) -> Map FlagName Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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
+ 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
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
(<>)

-- | 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
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
fmap ((Bool -> (Int, Bool))
-> (FlagName, Bool) -> (FlagName, (Int, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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
fmap (((Int, Bool) -> Bool)
-> (FlagName, (Int, Bool)) -> (FlagName, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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
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
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
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
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
> 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
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
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
<$>
                       m (FlagName, Bool) -> m () -> m [(FlagName, Bool)]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
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
<|> m (FlagName, Bool)
offFlag) m ()
forall (m :: * -> *). CharParsing m => 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)
P.optional (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'+')
        FlagName
f <- m FlagName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
        (FlagName, Bool) -> m (FlagName, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (FlagName
f, Bool
True)
    offFlag :: m (FlagName, Bool)
offFlag = do
        Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'-'
        FlagName
f <- m FlagName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
        (FlagName, Bool) -> m (FlagName, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (FlagName
f, Bool
False)