{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Distribution.Types.Flag
  ( -- * Package flag
    PackageFlag (..)
  , emptyFlag

    -- * Flag name
  , FlagName
  , mkFlagName
  , unFlagName

    -- * Flag assignment
  , FlagAssignment
  , mkFlagAssignment
  , unFlagAssignment
  , lookupFlagAssignment
  , insertFlagAssignment
  , diffFlagAssignment
  , findDuplicateFlagAssignments
  , nullFlagAssignment
  , showFlagValue
  , dispFlagAssignment
  , showFlagAssignment
  , parsecFlagAssignment
  , parsecFlagAssignmentNonEmpty

    -- ** Legacy formats
  , legacyShowFlagAssignment
  , legacyShowFlagAssignment'
  , legacyParsecFlagAssignment
  ) where

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

import Distribution.Parsec
import Distribution.Pretty

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

-- -----------------------------------------------------------------------------
-- 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 PackageFlag = MkPackageFlag
  { PackageFlag -> FlagName
flagName :: FlagName
  , PackageFlag -> String
flagDescription :: String
  , PackageFlag -> Bool
flagDefault :: Bool
  , PackageFlag -> Bool
flagManual :: Bool
  }
  deriving (Int -> PackageFlag -> ShowS
[PackageFlag] -> ShowS
PackageFlag -> String
(Int -> PackageFlag -> ShowS)
-> (PackageFlag -> String)
-> ([PackageFlag] -> ShowS)
-> Show PackageFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageFlag -> ShowS
showsPrec :: Int -> PackageFlag -> ShowS
$cshow :: PackageFlag -> String
show :: PackageFlag -> String
$cshowList :: [PackageFlag] -> ShowS
showList :: [PackageFlag] -> ShowS
Show, PackageFlag -> PackageFlag -> Bool
(PackageFlag -> PackageFlag -> Bool)
-> (PackageFlag -> PackageFlag -> Bool) -> Eq PackageFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageFlag -> PackageFlag -> Bool
== :: PackageFlag -> PackageFlag -> Bool
$c/= :: PackageFlag -> PackageFlag -> Bool
/= :: PackageFlag -> PackageFlag -> Bool
Eq, Typeable, Typeable PackageFlag
Typeable PackageFlag =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> PackageFlag -> c PackageFlag)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PackageFlag)
-> (PackageFlag -> Constr)
-> (PackageFlag -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PackageFlag))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PackageFlag))
-> ((forall b. Data b => b -> b) -> PackageFlag -> PackageFlag)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PackageFlag -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PackageFlag -> r)
-> (forall u. (forall d. Data d => d -> u) -> PackageFlag -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PackageFlag -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PackageFlag -> m PackageFlag)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PackageFlag -> m PackageFlag)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PackageFlag -> m PackageFlag)
-> Data PackageFlag
PackageFlag -> Constr
PackageFlag -> DataType
(forall b. Data b => b -> b) -> PackageFlag -> PackageFlag
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) -> PackageFlag -> u
forall u. (forall d. Data d => d -> u) -> PackageFlag -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageFlag -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageFlag -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PackageFlag -> m PackageFlag
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageFlag -> m PackageFlag
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageFlag
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageFlag -> c PackageFlag
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageFlag)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageFlag)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageFlag -> c PackageFlag
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageFlag -> c PackageFlag
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageFlag
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageFlag
$ctoConstr :: PackageFlag -> Constr
toConstr :: PackageFlag -> Constr
$cdataTypeOf :: PackageFlag -> DataType
dataTypeOf :: PackageFlag -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageFlag)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageFlag)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageFlag)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageFlag)
$cgmapT :: (forall b. Data b => b -> b) -> PackageFlag -> PackageFlag
gmapT :: (forall b. Data b => b -> b) -> PackageFlag -> PackageFlag
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageFlag -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageFlag -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageFlag -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageFlag -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PackageFlag -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PackageFlag -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PackageFlag -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PackageFlag -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PackageFlag -> m PackageFlag
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PackageFlag -> m PackageFlag
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageFlag -> m PackageFlag
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageFlag -> m PackageFlag
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageFlag -> m PackageFlag
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageFlag -> m PackageFlag
Data, (forall x. PackageFlag -> Rep PackageFlag x)
-> (forall x. Rep PackageFlag x -> PackageFlag)
-> Generic PackageFlag
forall x. Rep PackageFlag x -> PackageFlag
forall x. PackageFlag -> Rep PackageFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PackageFlag -> Rep PackageFlag x
from :: forall x. PackageFlag -> Rep PackageFlag x
$cto :: forall x. Rep PackageFlag x -> PackageFlag
to :: forall x. Rep PackageFlag x -> PackageFlag
Generic)

instance Binary PackageFlag
instance Structured PackageFlag
instance NFData PackageFlag where rnf :: PackageFlag -> ()
rnf = PackageFlag -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | A 'PackageFlag' initialized with default parameters.
emptyFlag :: FlagName -> PackageFlag
emptyFlag :: FlagName -> PackageFlag
emptyFlag FlagName
name =
  MkPackageFlag
    { 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
$c== :: FlagName -> FlagName -> Bool
== :: FlagName -> FlagName -> Bool
$c/= :: FlagName -> FlagName -> Bool
/= :: 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
$cfrom :: forall x. FlagName -> Rep FlagName x
from :: forall x. FlagName -> Rep FlagName x
$cto :: forall x. Rep FlagName x -> FlagName
to :: forall x. Rep FlagName x -> FlagName
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
$ccompare :: FlagName -> FlagName -> Ordering
compare :: FlagName -> FlagName -> Ordering
$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
>= :: FlagName -> FlagName -> Bool
$cmax :: FlagName -> FlagName -> FlagName
max :: FlagName -> FlagName -> FlagName
$cmin :: FlagName -> FlagName -> FlagName
min :: FlagName -> FlagName -> 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
$cshowsPrec :: Int -> FlagName -> ShowS
showsPrec :: Int -> FlagName -> ShowS
$cshow :: FlagName -> String
show :: FlagName -> String
$cshowList :: [FlagName] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS FlagName
readsPrec :: Int -> ReadS FlagName
$creadList :: ReadS [FlagName]
readList :: ReadS [FlagName]
$creadPrec :: ReadPrec FlagName
readPrec :: ReadPrec FlagName
$creadListPrec :: ReadPrec [FlagName]
readListPrec :: ReadPrec [FlagName]
Read, Typeable, Typeable FlagName
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 -> Constr
FlagName -> DataType
(forall b. Data b => b -> b) -> FlagName -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FlagName -> c FlagName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FlagName -> c FlagName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FlagName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FlagName
$ctoConstr :: FlagName -> Constr
toConstr :: FlagName -> Constr
$cdataTypeOf :: FlagName -> DataType
dataTypeOf :: FlagName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FlagName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FlagName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FlagName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FlagName)
$cgmapT :: (forall b. Data b => b -> b) -> FlagName -> FlagName
gmapT :: (forall b. Data b => b -> b) -> FlagName -> FlagName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FlagName -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FlagName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FlagName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FlagName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FlagName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FlagName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FlagName -> m FlagName
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FlagName -> m FlagName
Data, FlagName -> ()
(FlagName -> ()) -> NFData FlagName
forall a. (a -> ()) -> NFData a
$crnf :: FlagName -> ()
rnf :: 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 :: forall (m :: * -> *). CabalParsing m => 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 a b. m (a -> b) -> m a -> m b
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)]@
--
-- TODO: Why we record the multiplicity of the flag?
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
$cput :: FlagAssignment -> Put
put :: FlagAssignment -> Put
$cget :: Get FlagAssignment
get :: Get FlagAssignment
$cputList :: [FlagAssignment] -> Put
putList :: [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
$cfrom :: forall x. FlagAssignment -> Rep FlagAssignment x
from :: forall x. FlagAssignment -> Rep FlagAssignment x
$cto :: forall x. Rep FlagAssignment x -> FlagAssignment
to :: forall x. Rep FlagAssignment x -> FlagAssignment
Generic, FlagAssignment -> ()
(FlagAssignment -> ()) -> NFData FlagAssignment
forall a. (a -> ()) -> NFData a
$crnf :: FlagAssignment -> ()
rnf :: 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 a b. (a -> b) -> Map FlagName a -> Map FlagName b
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 a b. (a -> b) -> Map FlagName a -> Map FlagName b
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 a b. (a -> b) -> Map FlagName a -> Map FlagName b
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 a b. (a -> b) -> Map FlagName a -> Map FlagName b
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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> (Int, Bool))
-> (FlagName, Bool) -> (FlagName, (Int, Bool))
forall a b. (a -> b) -> (FlagName, a) -> (FlagName, b)
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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, Bool) -> Bool)
-> (FlagName, (Int, Bool)) -> (FlagName, Bool)
forall a b. (a -> b) -> (FlagName, a) -> (FlagName, b)
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 a b. (a -> b) -> Maybe a -> Maybe b
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 'FlagAssignment', 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

-- | @since 3.4.0.0
instance Pretty FlagAssignment where
  pretty :: FlagAssignment -> Doc
pretty = FlagAssignment -> Doc
dispFlagAssignment

-- |
--
-- >>> simpleParsec "" :: Maybe FlagAssignment
-- Just (fromList [])
--
-- >>> simpleParsec "+foo -bar" :: Maybe FlagAssignment
-- Just (fromList [(FlagName "bar",(1,False)),(FlagName "foo",(1,True))])
--
-- >>> simpleParsec "-none -any" :: Maybe FlagAssignment
-- Just (fromList [(FlagName "any",(1,False)),(FlagName "none",(1,False))])
--
-- >>> simpleParsec "+foo -foo +foo +foo" :: Maybe FlagAssignment
-- Just (fromList [(FlagName "foo",(4,True))])
--
-- >>> simpleParsec "+foo -bar baz" :: Maybe FlagAssignment
-- Nothing
--
-- Issue #7279 was fixed in Cabal-3.8
--
-- >>> explicitEitherParsec (parsecCommaList parsec) "+foo , -bar" :: Either String [FlagAssignment]
-- Right [fromList [(FlagName "foo",(1,True))],fromList [(FlagName "bar",(1,False))]]
--
-- >>> explicitEitherParsec (parsecCommaList parsecFlagAssignmentNonEmpty) "+foo , -bar" :: Either String [FlagAssignment]
-- Right [fromList [(FlagName "foo",(1,True))],fromList [(FlagName "bar",(1,False))]]
--
-- >>> simpleParsec "+foo+foo" :: Maybe FlagAssignment
-- Nothing
--
-- @since 3.4.0.0
instance Parsec FlagAssignment where
  parsec :: forall (m :: * -> *). CabalParsing m => m FlagAssignment
parsec = m FlagAssignment
forall (m :: * -> *). CabalParsing m => m FlagAssignment
parsecFlagAssignment

-- | 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 :: forall (m :: * -> *). CabalParsing m => 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 b. CabalParsing m => m a -> m b -> m [a]
sepByEnding (m (FlagName, Bool)
onFlag m (FlagName, Bool) -> m (FlagName, Bool) -> m (FlagName, Bool)
forall a. m a -> m a -> m a
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
      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
forall (m :: * -> *). CabalParsing m => m FlagName
parsec
      (FlagName, Bool) -> m (FlagName, Bool)
forall a. a -> m a
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
forall (m :: * -> *). CabalParsing m => m FlagName
parsec
      (FlagName, Bool) -> m (FlagName, Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FlagName
f, Bool
False)

    sepByEnding :: CabalParsing m => m a -> m b -> m [a]
    sepByEnding :: forall (m :: * -> *) a b. CabalParsing m => m a -> m b -> m [a]
sepByEnding m a
p m b
sep = m [a]
afterSeparator
      where
        element :: m [a]
element = (:) (a -> [a] -> [a]) -> m a -> m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
p m ([a] -> [a]) -> m [a] -> m [a]
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [a]
afterElement
        afterElement :: m [a]
afterElement = m b
sep m b -> m [a] -> m [a]
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m [a]
afterSeparator m [a] -> m [a] -> m [a]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        afterSeparator :: m [a]
afterSeparator = m [a]
element m [a] -> m [a] -> m [a]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Parse a non-empty flag assignment
--
-- The flags have to explicitly start with minus or plus.
--
-- @since 3.4.0.0
parsecFlagAssignmentNonEmpty :: CabalParsing m => m FlagAssignment
parsecFlagAssignmentNonEmpty :: forall (m :: * -> *). CabalParsing m => m FlagAssignment
parsecFlagAssignmentNonEmpty = [(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 b. CabalParsing m => m a -> m b -> m [a]
sepByEnding1 (m (FlagName, Bool)
onFlag m (FlagName, Bool) -> m (FlagName, Bool) -> m (FlagName, Bool)
forall a. m a -> m a -> m a
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
      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
forall (m :: * -> *). CabalParsing m => m FlagName
parsec
      (FlagName, Bool) -> m (FlagName, Bool)
forall a. a -> m a
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
forall (m :: * -> *). CabalParsing m => m FlagName
parsec
      (FlagName, Bool) -> m (FlagName, Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FlagName
f, Bool
False)

    sepByEnding1 :: CabalParsing m => m a -> m b -> m [a]
    sepByEnding1 :: forall (m :: * -> *) a b. CabalParsing m => m a -> m b -> m [a]
sepByEnding1 m a
p m b
sep = m [a]
element
      where
        element :: m [a]
element = (:) (a -> [a] -> [a]) -> m a -> m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
p m ([a] -> [a]) -> m [a] -> m [a]
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [a]
afterElement
        afterElement :: m [a]
afterElement = m b
sep m b -> m [a] -> m [a]
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m [a]
afterSeparator m [a] -> m [a] -> m [a]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        afterSeparator :: m [a]
afterSeparator = m [a]
element m [a] -> m [a] -> m [a]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Show flag assignment.
--
-- @since 3.4.0.0
showFlagAssignment :: FlagAssignment -> String
showFlagAssignment :: FlagAssignment -> String
showFlagAssignment = Doc -> String
forall a. Pretty a => a -> String
prettyShow (Doc -> String)
-> (FlagAssignment -> Doc) -> FlagAssignment -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagAssignment -> Doc
dispFlagAssignment

-------------------------------------------------------------------------------
-- Legacy: without requiring +
-------------------------------------------------------------------------------

-- | We need this as far as we support custom setups older than 2.2.0.0
--
-- @since 3.4.0.0
legacyShowFlagAssignment :: FlagAssignment -> String
legacyShowFlagAssignment :: FlagAssignment -> String
legacyShowFlagAssignment =
  Doc -> String
forall a. Pretty a => a -> String
prettyShow (Doc -> String)
-> (FlagAssignment -> Doc) -> FlagAssignment -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
Disp.hsep ([Doc] -> Doc)
-> (FlagAssignment -> [Doc]) -> FlagAssignment -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
Disp.text ([String] -> [Doc])
-> (FlagAssignment -> [String]) -> FlagAssignment -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagAssignment -> [String]
legacyShowFlagAssignment'

-- | @since 3.4.0.0
legacyShowFlagAssignment' :: FlagAssignment -> [String]
legacyShowFlagAssignment' :: FlagAssignment -> [String]
legacyShowFlagAssignment' = ((FlagName, Bool) -> String) -> [(FlagName, Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (FlagName, Bool) -> String
legacyShowFlagValue ([(FlagName, Bool)] -> [String])
-> (FlagAssignment -> [(FlagName, Bool)])
-> FlagAssignment
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagAssignment -> [(FlagName, Bool)]
unFlagAssignment

-- | @since 3.4.0.0
legacyShowFlagValue :: (FlagName, Bool) -> String
legacyShowFlagValue :: (FlagName, Bool) -> String
legacyShowFlagValue (FlagName
f, Bool
True) = FlagName -> String
unFlagName FlagName
f
legacyShowFlagValue (FlagName
f, Bool
False) = Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: FlagName -> String
unFlagName FlagName
f

-- |
-- We need this as far as we support custom setups older than 2.2.0.0
--
-- @since 3.4.0.0
legacyParsecFlagAssignment :: CabalParsing m => m FlagAssignment
legacyParsecFlagAssignment :: forall (m :: * -> *). CabalParsing m => m FlagAssignment
legacyParsecFlagAssignment =
  [(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 a. m a -> m a -> m a
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
forall (m :: * -> *). CabalParsing m => m FlagName
parsec
      (FlagName, Bool) -> m (FlagName, Bool)
forall a. a -> m a
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
forall (m :: * -> *). CabalParsing m => m FlagName
parsec
      (FlagName, Bool) -> m (FlagName, Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FlagName
f, Bool
False)