{-# LANGUAGE NamedFieldPuns #-}

module LaunchDarkly.Server.Integrations.TestData.FlagBuilder
    ( FlagBuilder (..)
    , VariationIndex
    , newFlagBuilder
    , booleanFlag
    , on
    , fallthroughVariation
    , offVariation
    , variationForAll
    , variationForAllUsers
    , valueForAll
    , valueForAllUsers
    , variationForKey
    , variationForUser
    , variations
    , buildFlag
    , ifMatch
    , ifMatchContext
    , ifNotMatch
    , ifNotMatchContext
    , FlagRuleBuilder
    , andMatch
    , andMatchContext
    , andNotMatch
    , andNotMatchContext
    , thenReturn
    , Variation
    )
where

import qualified Data.Aeson as Aeson
import Data.Function ((&))
import Data.HashSet (HashSet)
import qualified Data.HashSet as HS
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Natural (Natural)
import qualified LaunchDarkly.Server.Features as F
import qualified LaunchDarkly.Server.Operators as Op
import LaunchDarkly.Server.Reference (makeReference)

type VariationIndex = Integer

trueVariationForBoolean, falseVariationForBoolean :: VariationIndex
trueVariationForBoolean :: VariationIndex
trueVariationForBoolean = 0
falseVariationForBoolean :: VariationIndex
falseVariationForBoolean = 1

variationForBoolean :: Bool -> VariationIndex
variationForBoolean :: Bool -> VariationIndex
variationForBoolean True = VariationIndex
trueVariationForBoolean
variationForBoolean False = VariationIndex
falseVariationForBoolean

-- |
-- A builder for feature flag configurations to be used with
-- "LaunchDarkly.Server.Integrations.TestData".
--
-- see 'LaunchDarkly.Server.Integrations.TestData.flag' and
-- 'LaunchDarkly.Server.Integrations.TestData.update'
data FlagBuilder = FlagBuilder
    { FlagBuilder -> Text
fbKey :: Text
    , FlagBuilder -> Maybe VariationIndex
fbOffVariation :: Maybe VariationIndex
    , FlagBuilder -> Bool
fbOn :: Bool
    , FlagBuilder -> Maybe VariationIndex
fbFallthroughVariation :: Maybe VariationIndex
    , FlagBuilder -> [Value]
fbVariations :: [Aeson.Value]
    , FlagBuilder -> Map Text (Map VariationIndex (HashSet Text))
fbTargetMap :: Map Text (Map VariationIndex (HashSet Text))
    , FlagBuilder -> [FlagRule]
fbRules :: [FlagRule]
    }
    deriving (Int -> FlagBuilder -> ShowS
[FlagBuilder] -> ShowS
FlagBuilder -> String
(Int -> FlagBuilder -> ShowS)
-> (FlagBuilder -> String)
-> ([FlagBuilder] -> ShowS)
-> Show FlagBuilder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlagBuilder] -> ShowS
$cshowList :: [FlagBuilder] -> ShowS
show :: FlagBuilder -> String
$cshow :: FlagBuilder -> String
showsPrec :: Int -> FlagBuilder -> ShowS
$cshowsPrec :: Int -> FlagBuilder -> ShowS
Show)

fbTargets :: FlagBuilder -> ([F.Target], [F.Target])
fbTargets :: FlagBuilder -> ([Target], [Target])
fbTargets FlagBuilder {$sel:fbTargetMap:FlagBuilder :: FlagBuilder -> Map Text (Map VariationIndex (HashSet Text))
fbTargetMap = Map Text (Map VariationIndex (HashSet Text))
targetMap} =
    (([Target], [Target])
 -> Text
 -> Map VariationIndex (HashSet Text)
 -> ([Target], [Target]))
-> ([Target], [Target])
-> Map Text (Map VariationIndex (HashSet Text))
-> ([Target], [Target])
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey ([Target], [Target])
-> Text
-> Map VariationIndex (HashSet Text)
-> ([Target], [Target])
splitIntoTargets ([], []) Map Text (Map VariationIndex (HashSet Text))
targetMap
  where
    splitIntoTargets :: ([F.Target], [F.Target]) -> Text -> Map VariationIndex (HashSet Text) -> ([F.Target], [F.Target])
    splitIntoTargets :: ([Target], [Target])
-> Text
-> Map VariationIndex (HashSet Text)
-> ([Target], [Target])
splitIntoTargets acc :: ([Target], [Target])
acc "user" keyMap :: Map VariationIndex (HashSet Text)
keyMap = (([Target], [Target])
 -> VariationIndex -> HashSet Text -> ([Target], [Target]))
-> ([Target], [Target])
-> Map VariationIndex (HashSet Text)
-> ([Target], [Target])
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey ([Target], [Target])
-> VariationIndex -> HashSet Text -> ([Target], [Target])
foldForUserKind ([Target], [Target])
acc Map VariationIndex (HashSet Text)
keyMap
    splitIntoTargets acc :: ([Target], [Target])
acc kind :: Text
kind keyMap :: Map VariationIndex (HashSet Text)
keyMap = (([Target], [Target])
 -> VariationIndex -> HashSet Text -> ([Target], [Target]))
-> ([Target], [Target])
-> Map VariationIndex (HashSet Text)
-> ([Target], [Target])
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey (Text
-> ([Target], [Target])
-> VariationIndex
-> HashSet Text
-> ([Target], [Target])
foldForOtherKind Text
kind) ([Target], [Target])
acc Map VariationIndex (HashSet Text)
keyMap

    -- When processing user kinds, we need to add a full target to the user targets, and a placeholder without the values in the context targets list
    foldForUserKind :: ([F.Target], [F.Target]) -> VariationIndex -> HashSet Text -> ([F.Target], [F.Target])
    foldForUserKind :: ([Target], [Target])
-> VariationIndex -> HashSet Text -> ([Target], [Target])
foldForUserKind (userTargets :: [Target]
userTargets, allTargets :: [Target]
allTargets) variation :: VariationIndex
variation values :: HashSet Text
values =
        ( $WTarget :: HashSet Text -> VariationIndex -> Text -> Target
F.Target {HashSet Text
$sel:values:Target :: HashSet Text
values :: HashSet Text
values, VariationIndex
$sel:variation:Target :: VariationIndex
variation :: VariationIndex
variation, $sel:contextKind:Target :: Text
contextKind = "user"} Target -> [Target] -> [Target]
forall a. a -> [a] -> [a]
: [Target]
userTargets
        , $WTarget :: HashSet Text -> VariationIndex -> Text -> Target
F.Target {$sel:values:Target :: HashSet Text
values = HashSet Text
forall a. Monoid a => a
mempty, VariationIndex
$sel:variation:Target :: VariationIndex
variation :: VariationIndex
variation, $sel:contextKind:Target :: Text
contextKind = "user"} Target -> [Target] -> [Target]
forall a. a -> [a] -> [a]
: [Target]
allTargets
        )

    foldForOtherKind :: Text -> ([F.Target], [F.Target]) -> VariationIndex -> HashSet Text -> ([F.Target], [F.Target])
    foldForOtherKind :: Text
-> ([Target], [Target])
-> VariationIndex
-> HashSet Text
-> ([Target], [Target])
foldForOtherKind kind :: Text
kind (userTargets :: [Target]
userTargets, allTargets :: [Target]
allTargets) variation :: VariationIndex
variation values :: HashSet Text
values =
        ( [Target]
userTargets
        , $WTarget :: HashSet Text -> VariationIndex -> Text -> Target
F.Target {$sel:values:Target :: HashSet Text
values = HashSet Text
values, VariationIndex
variation :: VariationIndex
$sel:variation:Target :: VariationIndex
variation, $sel:contextKind:Target :: Text
contextKind = Text
kind} Target -> [Target] -> [Target]
forall a. a -> [a] -> [a]
: [Target]
allTargets
        )

buildFlag :: Natural -> FlagBuilder -> F.Flag
buildFlag :: Natural -> FlagBuilder -> Flag
buildFlag version :: Natural
version flagBuilder :: FlagBuilder
flagBuilder =
    $WFlag :: Text
-> Natural
-> Bool
-> Bool
-> Bool
-> Bool
-> [Prerequisite]
-> Text
-> [Target]
-> [Target]
-> [Rule]
-> VariationOrRollout
-> Maybe VariationIndex
-> [Value]
-> Maybe Natural
-> ClientSideAvailability
-> Flag
F.Flag
        { $sel:key:Flag :: Text
F.key = FlagBuilder -> Text
fbKey FlagBuilder
flagBuilder
        , $sel:version:Flag :: Natural
F.version = Natural
version
        , $sel:on:Flag :: Bool
F.on = FlagBuilder -> Bool
fbOn FlagBuilder
flagBuilder
        , $sel:trackEvents:Flag :: Bool
F.trackEvents = Bool
False
        , $sel:trackEventsFallthrough:Flag :: Bool
F.trackEventsFallthrough = Bool
False
        , $sel:deleted:Flag :: Bool
F.deleted = Bool
False
        , $sel:prerequisites:Flag :: [Prerequisite]
F.prerequisites = []
        , $sel:salt:Flag :: Text
F.salt = "salt"
        , $sel:targets:Flag :: [Target]
F.targets = [Target]
userTargets
        , $sel:contextTargets:Flag :: [Target]
F.contextTargets = [Target]
allTargets
        , $sel:rules:Flag :: [Rule]
F.rules = (VariationIndex -> FlagRule -> Rule) -> [FlagRule] -> [Rule]
forall num a b. Integral num => (num -> a -> b) -> [a] -> [b]
mapWithIndex VariationIndex -> FlagRule -> Rule
convertFlagRule (FlagBuilder -> [FlagRule]
fbRules FlagBuilder
flagBuilder)
        , $sel:fallthrough:Flag :: VariationOrRollout
F.fallthrough = Maybe VariationIndex -> Maybe Rollout -> VariationOrRollout
F.VariationOrRollout (FlagBuilder -> Maybe VariationIndex
fbFallthroughVariation FlagBuilder
flagBuilder) Maybe Rollout
forall a. Maybe a
Nothing
        , $sel:offVariation:Flag :: Maybe VariationIndex
F.offVariation = FlagBuilder -> Maybe VariationIndex
fbOffVariation FlagBuilder
flagBuilder
        , $sel:variations:Flag :: [Value]
F.variations = FlagBuilder -> [Value]
fbVariations FlagBuilder
flagBuilder
        , $sel:debugEventsUntilDate:Flag :: Maybe Natural
F.debugEventsUntilDate = Maybe Natural
forall a. Maybe a
Nothing
        , $sel:clientSideAvailability:Flag :: ClientSideAvailability
F.clientSideAvailability = Bool -> Bool -> Bool -> ClientSideAvailability
F.ClientSideAvailability Bool
False Bool
False Bool
False
        }
  where
    (userTargets :: [Target]
userTargets, allTargets :: [Target]
allTargets) = FlagBuilder -> ([Target], [Target])
fbTargets FlagBuilder
flagBuilder

mapWithIndex :: Integral num => (num -> a -> b) -> [a] -> [b]
mapWithIndex :: (num -> a -> b) -> [a] -> [b]
mapWithIndex f :: num -> a -> b
f l :: [a]
l =
    ((num, a) -> b) -> [(num, a)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((num -> a -> b) -> (num, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry num -> a -> b
f) ([num] -> [a] -> [(num, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0 ..] [a]
l)

newFlagBuilder :: Text -> FlagBuilder
newFlagBuilder :: Text -> FlagBuilder
newFlagBuilder key :: Text
key =
    FlagBuilder :: Text
-> Maybe VariationIndex
-> Bool
-> Maybe VariationIndex
-> [Value]
-> Map Text (Map VariationIndex (HashSet Text))
-> [FlagRule]
-> FlagBuilder
FlagBuilder
        { $sel:fbKey:FlagBuilder :: Text
fbKey = Text
key
        , $sel:fbOffVariation:FlagBuilder :: Maybe VariationIndex
fbOffVariation = Maybe VariationIndex
forall a. Maybe a
Nothing
        , $sel:fbOn:FlagBuilder :: Bool
fbOn = Bool
True
        , $sel:fbFallthroughVariation:FlagBuilder :: Maybe VariationIndex
fbFallthroughVariation = Maybe VariationIndex
forall a. Maybe a
Nothing
        , $sel:fbVariations:FlagBuilder :: [Value]
fbVariations = [Value]
forall a. Monoid a => a
mempty
        , $sel:fbTargetMap:FlagBuilder :: Map Text (Map VariationIndex (HashSet Text))
fbTargetMap = Map Text (Map VariationIndex (HashSet Text))
forall a. Monoid a => a
mempty
        , $sel:fbRules:FlagBuilder :: [FlagRule]
fbRules = [FlagRule]
forall a. Monoid a => a
mempty
        }

booleanFlagVariations :: [Aeson.Value]
booleanFlagVariations :: [Value]
booleanFlagVariations = [Bool -> Value
Aeson.Bool Bool
True, Bool -> Value
Aeson.Bool Bool
False]

isBooleanFlag :: FlagBuilder -> Bool
isBooleanFlag :: FlagBuilder -> Bool
isBooleanFlag flagBuilder :: FlagBuilder
flagBuilder
    | [Value]
booleanFlagVariations [Value] -> [Value] -> Bool
forall a. Eq a => a -> a -> Bool
== FlagBuilder -> [Value]
fbVariations FlagBuilder
flagBuilder = Bool
True
    | Bool
otherwise = Bool
False

-- |
-- A shortcut for setting the flag to use the standard boolean configuration.
--
-- This is the default for all new flags created with
-- 'LaunchDarkly.Server.Integrations.TestData.flag'. The flag will have two
-- variations, @True@ and @False@ (in that order); it will return @False@
-- whenever targeting is off, and @True@ when targeting is on if no other
-- settings specify otherwise.
booleanFlag :: FlagBuilder -> FlagBuilder
booleanFlag :: FlagBuilder -> FlagBuilder
booleanFlag flagBuilder :: FlagBuilder
flagBuilder
    | FlagBuilder -> Bool
isBooleanFlag FlagBuilder
flagBuilder =
        FlagBuilder
flagBuilder
    | Bool
otherwise =
        FlagBuilder
flagBuilder
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& [Value] -> FlagBuilder -> FlagBuilder
variations [Value]
booleanFlagVariations
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& VariationIndex -> FlagBuilder -> FlagBuilder
forall val. Variation val => val -> FlagBuilder -> FlagBuilder
fallthroughVariation VariationIndex
trueVariationForBoolean
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& VariationIndex -> FlagBuilder -> FlagBuilder
forall val. Variation val => val -> FlagBuilder -> FlagBuilder
offVariation VariationIndex
falseVariationForBoolean

-- |
-- Sets targeting to be on or off for this flag.
--
-- The effect of this depends on the rest of the flag configuration, just as it
-- does on the real LaunchDarkly dashboard. In the default configuration that
-- you get from calling 'LaunchDarkly.Server.Integrations.TestData.flag' with a
-- new flag key, the flag will return @False@ whenever targeting is off, and
-- @True@ when targeting is on.
on ::
    -- | isOn @True@ if targeting should be on
    Bool ->
    FlagBuilder ->
    FlagBuilder
on :: Bool -> FlagBuilder -> FlagBuilder
on isOn :: Bool
isOn fb :: FlagBuilder
fb =
    FlagBuilder
fb {$sel:fbOn:FlagBuilder :: Bool
fbOn = Bool
isOn}

-- |
-- Removes any existing rules from the flag.
-- This undoes the effect of methods like 'ifMatch' or 'ifNotMatch'
clearRules :: FlagBuilder -> FlagBuilder
clearRules :: FlagBuilder -> FlagBuilder
clearRules fb :: FlagBuilder
fb =
    FlagBuilder
fb {$sel:fbRules:FlagBuilder :: [FlagRule]
fbRules = [FlagRule]
forall a. Monoid a => a
mempty}

-- |
-- Removes any existing targets from the flag.
-- This undoes the effect of methods like 'variationForKey'
clearTargets :: FlagBuilder -> FlagBuilder
clearTargets :: FlagBuilder -> FlagBuilder
clearTargets fb :: FlagBuilder
fb =
    FlagBuilder
fb {$sel:fbTargetMap:FlagBuilder :: Map Text (Map VariationIndex (HashSet Text))
fbTargetMap = Map Text (Map VariationIndex (HashSet Text))
forall a. Monoid a => a
mempty}

-- |
-- Sets the flag to always return the specified variation value for all
-- contexts.
--
-- The value may be of any type that implements 'Aeson.ToJSON'. This method
-- changes the flag to have only a single variation, which is this value, and
-- to return the same variation regardless of whether targeting is on or off.
-- Any existing targets or rules are removed.
valueForAll ::
    Aeson.ToJSON value =>
    value -> -- the desired value to be returned for all contexts
    FlagBuilder ->
    FlagBuilder
valueForAll :: value -> FlagBuilder -> FlagBuilder
valueForAll val :: value
val fb :: FlagBuilder
fb =
    FlagBuilder
fb
        FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& [Value] -> FlagBuilder -> FlagBuilder
variations [value -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON value
val]
        FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& VariationIndex -> FlagBuilder -> FlagBuilder
forall val. Variation val => val -> FlagBuilder -> FlagBuilder
variationForAll (0 :: VariationIndex)

{-# DEPRECATED valueForAllUsers "Use valueForAll instead" #-}

-- |
-- Sets the flag to always return the specified variation value for all users.
--
-- This function is an alias to 'valueForAll'.
--
-- The value may be of any type that implements 'Aeson.ToJSON'. This method
-- changes the flag to have only a single variation, which is this value, and
-- to return the same variation regardless of whether targeting is on or off.
-- Any existing targets or rules are removed.
valueForAllUsers ::
    Aeson.ToJSON value =>
    value -> -- the desired value to be returned for all users
    FlagBuilder ->
    FlagBuilder
valueForAllUsers :: value -> FlagBuilder -> FlagBuilder
valueForAllUsers = value -> FlagBuilder -> FlagBuilder
forall value. ToJSON value => value -> FlagBuilder -> FlagBuilder
valueForAll

-- |
-- Changes the allowable variation values for the flag.
--
-- The value may be of any JSON type, as defined by 'Aeson.Value'. For
-- instance, a boolean flag normally has [toJSON True, toJSON False]; a
-- string-valued flag might have [toJSON "red", toJSON "green"]; etc.
variations ::
    -- | the desired variations
    [Aeson.Value] ->
    FlagBuilder ->
    FlagBuilder
variations :: [Value] -> FlagBuilder -> FlagBuilder
variations values :: [Value]
values fb :: FlagBuilder
fb =
    FlagBuilder
fb {$sel:fbVariations:FlagBuilder :: [Value]
fbVariations = [Value]
values}

-- Should this actually use overloaded function names?
class Variation val where
    -- |
    -- Specifies the fallthrough variation. The fallthrough is the value that
    -- is returned if targeting is on and the context was not matched by a more
    -- specific target or rule.
    --
    -- If the flag was previously configured with other variations and the
    -- variation specified is a boolean, this also changes it to a boolean
    -- flag.
    fallthroughVariation ::
        -- | @True@ or @False@ or the desired fallthrough variation index: 0 for the first, 1 for the second, etc.
        val ->
        FlagBuilder ->
        FlagBuilder

    -- |
    -- Specifies the off variation for a flag. This is the variation that is
    -- returned whenever targeting is off.
    --
    -- If the flag was previously configured with other variations and the
    -- variation specified is a boolean, this also changes it to a boolean
    -- flag.
    offVariation ::
        -- | @True@ or @False@ or the desired fallthrough variation index: 0 for the first, 1 for the second, etc.
        val ->
        FlagBuilder ->
        FlagBuilder

    -- |
    -- Sets the flag to always return the specified variation for all contexts.
    --
    -- The variation is specified, Targeting is switched on, and any existing
    -- targets or rules are removed. The fallthrough variation is set to the
    -- specified value. The off variation is left unchanged.
    --
    -- If the flag was previously configured with other variations and the
    -- variation specified is a boolean, this also changes it to a boolean
    -- flag.
    variationForAll ::
        -- | @True@ or @False@ or the desired fallthrough variation index: 0 for the first, 1 for the second, etc.
        val ->
        FlagBuilder ->
        FlagBuilder

    -- |
    -- Sets the flag to always return the specified variation for all users.
    --
    -- The variation is specified, Targeting is switched on, and any existing
    -- targets or rules are removed. The fallthrough variation is set to the
    -- specified value. The off variation is left unchanged.
    --
    -- If the flag was previously configured with other variations and the
    -- variation specified is a boolean, this also changes it to a boolean
    -- flag.
    variationForAllUsers ::
        -- | @True@ or @False@ or the desired fallthrough variation index: 0 for the first, 1 for the second, etc.
        val ->
        FlagBuilder ->
        FlagBuilder

    -- |
    -- Sets the flag to return the specified variation for a specific context
    -- kind and key when targeting is on.
    --
    -- This has no effect when targeting is turned off for the flag.
    --
    -- If the flag was previously configured with other variations and the
    -- variation specified is a boolean, this also changes it to a boolean
    -- flag.
    variationForKey ::
        -- | The context kind to match against
        Text ->
        -- | a key to target
        Text ->
        -- | @True@ or @False@ or the desired fallthrough variation index: 0 for the first, 1 for the second, etc.
        val ->
        FlagBuilder ->
        FlagBuilder

    -- |
    -- Sets the flag to return the specified variation for a specific user key
    -- when targeting is on.
    --
    -- This has no effect when targeting is turned off for the flag.
    --
    -- If the flag was previously configured with other variations and the
    -- variation specified is a boolean, this also changes it to a boolean
    -- flag.
    variationForUser ::
        -- | a user key to target
        Text ->
        -- | @True@ or @False@ or the desired fallthrough variation index: 0 for the first, 1 for the second, etc.
        val ->
        FlagBuilder ->
        FlagBuilder

    -- |
    -- Finishes defining the rule, specifying the result as either a boolean or
    -- a variation index.
    --
    -- If the flag was previously configured with other variations and the
    -- variation specified is a boolean, this also changes it to a boolean
    -- flag.
    thenReturn ::
        -- | @True@ or @False@ or the desired fallthrough variation index: 0 for the first, 1 for the second, etc.
        val ->
        FlagRuleBuilder ->
        FlagBuilder

instance Variation Integer where
    fallthroughVariation :: VariationIndex -> FlagBuilder -> FlagBuilder
fallthroughVariation variationIndex :: VariationIndex
variationIndex fb :: FlagBuilder
fb =
        FlagBuilder
fb {$sel:fbFallthroughVariation:FlagBuilder :: Maybe VariationIndex
fbFallthroughVariation = VariationIndex -> Maybe VariationIndex
forall a. a -> Maybe a
Just VariationIndex
variationIndex}

    offVariation :: VariationIndex -> FlagBuilder -> FlagBuilder
offVariation variationIndex :: VariationIndex
variationIndex fb :: FlagBuilder
fb =
        FlagBuilder
fb {$sel:fbOffVariation:FlagBuilder :: Maybe VariationIndex
fbOffVariation = VariationIndex -> Maybe VariationIndex
forall a. a -> Maybe a
Just VariationIndex
variationIndex}

    variationForAll :: VariationIndex -> FlagBuilder -> FlagBuilder
variationForAll variationIndex :: VariationIndex
variationIndex fb :: FlagBuilder
fb =
        FlagBuilder
fb
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& Bool -> FlagBuilder -> FlagBuilder
on Bool
True
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& FlagBuilder -> FlagBuilder
clearRules
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& FlagBuilder -> FlagBuilder
clearTargets
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& VariationIndex -> FlagBuilder -> FlagBuilder
forall val. Variation val => val -> FlagBuilder -> FlagBuilder
fallthroughVariation VariationIndex
variationIndex

    variationForAllUsers :: VariationIndex -> FlagBuilder -> FlagBuilder
variationForAllUsers = VariationIndex -> FlagBuilder -> FlagBuilder
forall val. Variation val => val -> FlagBuilder -> FlagBuilder
variationForAll

    variationForKey :: Text -> Text -> VariationIndex -> FlagBuilder -> FlagBuilder
variationForKey kind :: Text
kind key :: Text
key variationIndex :: VariationIndex
variationIndex fb :: FlagBuilder
fb@(FlagBuilder {$sel:fbTargetMap:FlagBuilder :: FlagBuilder -> Map Text (Map VariationIndex (HashSet Text))
fbTargetMap = Map Text (Map VariationIndex (HashSet Text))
targetMap}) =
        case Text
-> Map Text (Map VariationIndex (HashSet Text))
-> Maybe (Map VariationIndex (HashSet Text))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
kind Map Text (Map VariationIndex (HashSet Text))
targetMap of
            Nothing -> FlagBuilder
fb {$sel:fbTargetMap:FlagBuilder :: Map Text (Map VariationIndex (HashSet Text))
fbTargetMap = Text
-> Map VariationIndex (HashSet Text)
-> Map Text (Map VariationIndex (HashSet Text))
-> Map Text (Map VariationIndex (HashSet Text))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
kind (VariationIndex -> HashSet Text -> Map VariationIndex (HashSet Text)
forall k a. k -> a -> Map k a
Map.singleton VariationIndex
variationIndex (HashSet Text -> Map VariationIndex (HashSet Text))
-> HashSet Text -> Map VariationIndex (HashSet Text)
forall a b. (a -> b) -> a -> b
$ Text -> HashSet Text
forall a. Hashable a => a -> HashSet a
HS.singleton Text
key) Map Text (Map VariationIndex (HashSet Text))
targetMap}
            Just m :: Map VariationIndex (HashSet Text)
m ->
                case VariationIndex
-> Map VariationIndex (HashSet Text) -> Maybe (HashSet Text)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup VariationIndex
variationIndex Map VariationIndex (HashSet Text)
m of
                    Nothing -> FlagBuilder
fb {$sel:fbTargetMap:FlagBuilder :: Map Text (Map VariationIndex (HashSet Text))
fbTargetMap = Text
-> Map VariationIndex (HashSet Text)
-> Map Text (Map VariationIndex (HashSet Text))
-> Map Text (Map VariationIndex (HashSet Text))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
kind (VariationIndex
-> HashSet Text
-> Map VariationIndex (HashSet Text)
-> Map VariationIndex (HashSet Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert VariationIndex
variationIndex (Text -> HashSet Text
forall a. Hashable a => a -> HashSet a
HS.singleton Text
key) Map VariationIndex (HashSet Text)
m) Map Text (Map VariationIndex (HashSet Text))
targetMap}
                    Just keys :: HashSet Text
keys -> FlagBuilder
fb {$sel:fbTargetMap:FlagBuilder :: Map Text (Map VariationIndex (HashSet Text))
fbTargetMap = Text
-> Map VariationIndex (HashSet Text)
-> Map Text (Map VariationIndex (HashSet Text))
-> Map Text (Map VariationIndex (HashSet Text))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
kind (VariationIndex
-> HashSet Text
-> Map VariationIndex (HashSet Text)
-> Map VariationIndex (HashSet Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert VariationIndex
variationIndex (Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.insert Text
key HashSet Text
keys) Map VariationIndex (HashSet Text)
m) Map Text (Map VariationIndex (HashSet Text))
targetMap}

    variationForUser :: Text -> VariationIndex -> FlagBuilder -> FlagBuilder
variationForUser = Text -> Text -> VariationIndex -> FlagBuilder -> FlagBuilder
forall val.
Variation val =>
Text -> Text -> val -> FlagBuilder -> FlagBuilder
variationForKey "user"

    thenReturn :: VariationIndex -> FlagRuleBuilder -> FlagBuilder
thenReturn variationIndex :: VariationIndex
variationIndex ruleBuilder :: FlagRuleBuilder
ruleBuilder =
        let fb :: FlagBuilder
fb = FlagRuleBuilder -> FlagBuilder
frbBaseBuilder FlagRuleBuilder
ruleBuilder
         in FlagBuilder
fb {$sel:fbRules:FlagBuilder :: [FlagRule]
fbRules = [Clause] -> VariationIndex -> FlagRule
FlagRule (FlagRuleBuilder -> [Clause]
frbClauses FlagRuleBuilder
ruleBuilder) VariationIndex
variationIndex FlagRule -> [FlagRule] -> [FlagRule]
forall a. a -> [a] -> [a]
: FlagBuilder -> [FlagRule]
fbRules FlagBuilder
fb}

instance Variation Bool where
    fallthroughVariation :: Bool -> FlagBuilder -> FlagBuilder
fallthroughVariation value :: Bool
value fb :: FlagBuilder
fb =
        FlagBuilder
fb
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& FlagBuilder -> FlagBuilder
booleanFlag
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& VariationIndex -> FlagBuilder -> FlagBuilder
forall val. Variation val => val -> FlagBuilder -> FlagBuilder
fallthroughVariation (Bool -> VariationIndex
variationForBoolean Bool
value)
    offVariation :: Bool -> FlagBuilder -> FlagBuilder
offVariation value :: Bool
value fb :: FlagBuilder
fb =
        FlagBuilder
fb
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& FlagBuilder -> FlagBuilder
booleanFlag
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& VariationIndex -> FlagBuilder -> FlagBuilder
forall val. Variation val => val -> FlagBuilder -> FlagBuilder
offVariation (Bool -> VariationIndex
variationForBoolean Bool
value)
    variationForAll :: Bool -> FlagBuilder -> FlagBuilder
variationForAll value :: Bool
value fb :: FlagBuilder
fb =
        FlagBuilder
fb
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& FlagBuilder -> FlagBuilder
booleanFlag
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& VariationIndex -> FlagBuilder -> FlagBuilder
forall val. Variation val => val -> FlagBuilder -> FlagBuilder
variationForAll (Bool -> VariationIndex
variationForBoolean Bool
value)
    variationForAllUsers :: Bool -> FlagBuilder -> FlagBuilder
variationForAllUsers = Bool -> FlagBuilder -> FlagBuilder
forall val. Variation val => val -> FlagBuilder -> FlagBuilder
variationForAll
    variationForKey :: Text -> Text -> Bool -> FlagBuilder -> FlagBuilder
variationForKey kind :: Text
kind key :: Text
key value :: Bool
value fb :: FlagBuilder
fb =
        FlagBuilder
fb
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& FlagBuilder -> FlagBuilder
booleanFlag
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& Text -> Text -> VariationIndex -> FlagBuilder -> FlagBuilder
forall val.
Variation val =>
Text -> Text -> val -> FlagBuilder -> FlagBuilder
variationForKey Text
kind Text
key (Bool -> VariationIndex
variationForBoolean Bool
value)
    variationForUser :: Text -> Bool -> FlagBuilder -> FlagBuilder
variationForUser userKey :: Text
userKey value :: Bool
value fb :: FlagBuilder
fb =
        FlagBuilder
fb
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& FlagBuilder -> FlagBuilder
booleanFlag
            FlagBuilder -> (FlagBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& Text -> VariationIndex -> FlagBuilder -> FlagBuilder
forall val.
Variation val =>
Text -> val -> FlagBuilder -> FlagBuilder
variationForUser Text
userKey (Bool -> VariationIndex
variationForBoolean Bool
value)
    thenReturn :: Bool -> FlagRuleBuilder -> FlagBuilder
thenReturn value :: Bool
value ruleBuilder :: FlagRuleBuilder
ruleBuilder =
        FlagRuleBuilder
ruleBuilder {$sel:frbBaseBuilder:FlagRuleBuilder :: FlagBuilder
frbBaseBuilder = FlagBuilder -> FlagBuilder
booleanFlag (FlagBuilder -> FlagBuilder) -> FlagBuilder -> FlagBuilder
forall a b. (a -> b) -> a -> b
$ FlagRuleBuilder -> FlagBuilder
frbBaseBuilder FlagRuleBuilder
ruleBuilder}
            FlagRuleBuilder -> (FlagRuleBuilder -> FlagBuilder) -> FlagBuilder
forall a b. a -> (a -> b) -> b
& VariationIndex -> FlagRuleBuilder -> FlagBuilder
forall val. Variation val => val -> FlagRuleBuilder -> FlagBuilder
thenReturn (Bool -> VariationIndex
variationForBoolean Bool
value)

-- |
-- Starts defining a flag rule, using the "is one of" operator.
--
-- For example, this creates a rule that returns @True@ if the name is
-- \"Patsy\" or \"Edina\":
--
-- @
-- testData
--     & flag "flag"
--     & ifMatchContext "user" "name" [toJSON \"Patsy\", toJSON \"Edina\"]
--     & thenReturn True
-- @
ifMatchContext ::
    -- | the context kind to match again
    Text ->
    -- | the context attribute to match against
    Text ->
    -- | values to compare to
    [Aeson.Value] ->
    FlagBuilder ->
    -- | call 'thenReturn' to finish the rule, or add more tests with 'andMatch' or 'andNotMatch'
    FlagRuleBuilder
ifMatchContext :: Text -> Text -> [Value] -> FlagBuilder -> FlagRuleBuilder
ifMatchContext kind :: Text
kind attribute :: Text
attribute values :: [Value]
values fb :: FlagBuilder
fb =
    FlagBuilder -> FlagRuleBuilder
newFlagRuleBuilder FlagBuilder
fb
        FlagRuleBuilder
-> (FlagRuleBuilder -> FlagRuleBuilder) -> FlagRuleBuilder
forall a b. a -> (a -> b) -> b
& Text -> Text -> [Value] -> FlagRuleBuilder -> FlagRuleBuilder
andMatchContext Text
kind Text
attribute [Value]
values

{-# DEPRECATED ifMatch "Use ifMatchContext instead" #-}

-- |
-- Starts defining a flag rule, using the "is one of" operator.
--
-- This is a shortcut for calling 'ifMatch' with a context kind of "user".
--
-- For example, this creates a rule that returns @True@ if the name is
-- \"Patsy\" or \"Edina\":
--
-- @
-- testData
--     & flag "flag"
--     & ifMatch "name" [toJSON \"Patsy\", toJSON \"Edina\"]
--     & thenReturn True
-- @
ifMatch ::
    -- | the context attribute to match against
    Text ->
    -- | values to compare to
    [Aeson.Value] ->
    FlagBuilder ->
    -- | call 'thenReturn' to finish the rule, or add more tests with 'andMatch' or 'andNotMatch'
    FlagRuleBuilder
ifMatch :: Text -> [Value] -> FlagBuilder -> FlagRuleBuilder
ifMatch = Text -> Text -> [Value] -> FlagBuilder -> FlagRuleBuilder
ifMatchContext "user"

-- |
-- Starts defining a flag rule, using the "is not one of" operator.
--
-- For example, this creates a rule that returns @True@ if the name is neither
-- \"Saffron\" nor \"Bubble\"
--
-- @
-- testData
--     & flag "flag"
--     & ifNotMatchContext "user" "name" [toJSON \"Saffron\", toJSON \"Bubble\"]
--     & thenReturn True
-- @
ifNotMatchContext ::
    -- | context kind to match again
    Text ->
    -- | attribute to match against
    Text ->
    -- | values to compare to
    [Aeson.Value] ->
    FlagBuilder ->
    -- | call 'thenReturn' to finish the rule, or add more tests with 'andMatch' or 'andNotMatch'
    FlagRuleBuilder
ifNotMatchContext :: Text -> Text -> [Value] -> FlagBuilder -> FlagRuleBuilder
ifNotMatchContext kind :: Text
kind attibute :: Text
attibute values :: [Value]
values fb :: FlagBuilder
fb =
    FlagBuilder -> FlagRuleBuilder
newFlagRuleBuilder FlagBuilder
fb
        FlagRuleBuilder
-> (FlagRuleBuilder -> FlagRuleBuilder) -> FlagRuleBuilder
forall a b. a -> (a -> b) -> b
& Text -> Text -> [Value] -> FlagRuleBuilder -> FlagRuleBuilder
andNotMatchContext Text
kind Text
attibute [Value]
values

{-# DEPRECATED ifNotMatch "Use ifNotMatchContext instead" #-}

-- |
-- Starts defining a flag rule, using the "is not one of" operator.
--
-- This is a shortcut for calling 'ifNotMatchContext' with a context kind of
-- "user".
--
-- For example, this creates a rule that returns @True@ if the name is neither
-- \"Saffron\" nor \"Bubble\"
--
-- @
-- testData
--     & flag "flag"
--     & ifNotMatch "name" [toJSON \"Saffron\", toJSON \"Bubble\"]
--     & thenReturn True
-- @
ifNotMatch ::
    -- | attribute to match against
    Text ->
    -- | values to compare to
    [Aeson.Value] ->
    FlagBuilder ->
    -- | call 'thenReturn' to finish the rule, or add more tests with 'andMatch' or 'andNotMatch'
    FlagRuleBuilder
ifNotMatch :: Text -> [Value] -> FlagBuilder -> FlagRuleBuilder
ifNotMatch = Text -> Text -> [Value] -> FlagBuilder -> FlagRuleBuilder
ifNotMatchContext "user"

data Clause = Clause
    { Clause -> Text
clauseAttribute :: Text
    , Clause -> Text
contextKind :: Text
    , Clause -> [Value]
clauseValues :: [Aeson.Value]
    , Clause -> Bool
clauseNegate :: Bool
    }
    deriving (Int -> Clause -> ShowS
[Clause] -> ShowS
Clause -> String
(Int -> Clause -> ShowS)
-> (Clause -> String) -> ([Clause] -> ShowS) -> Show Clause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Clause] -> ShowS
$cshowList :: [Clause] -> ShowS
show :: Clause -> String
$cshow :: Clause -> String
showsPrec :: Int -> Clause -> ShowS
$cshowsPrec :: Int -> Clause -> ShowS
Show)

data FlagRule = FlagRule
    { FlagRule -> [Clause]
frClauses :: [Clause]
    , FlagRule -> VariationIndex
frVariation :: VariationIndex
    }
    deriving (Int -> FlagRule -> ShowS
[FlagRule] -> ShowS
FlagRule -> String
(Int -> FlagRule -> ShowS)
-> (FlagRule -> String) -> ([FlagRule] -> ShowS) -> Show FlagRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlagRule] -> ShowS
$cshowList :: [FlagRule] -> ShowS
show :: FlagRule -> String
$cshow :: FlagRule -> String
showsPrec :: Int -> FlagRule -> ShowS
$cshowsPrec :: Int -> FlagRule -> ShowS
Show)

convertFlagRule :: Integer -> FlagRule -> F.Rule
convertFlagRule :: VariationIndex -> FlagRule -> Rule
convertFlagRule idx :: VariationIndex
idx flagRule :: FlagRule
flagRule =
    $WRule :: Text -> [Clause] -> VariationOrRollout -> Bool -> Rule
F.Rule
        { $sel:id:Rule :: Text
F.id = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "rule" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> VariationIndex -> String
forall a. Show a => a -> String
show VariationIndex
idx
        , $sel:variationOrRollout:Rule :: VariationOrRollout
F.variationOrRollout = Maybe VariationIndex -> Maybe Rollout -> VariationOrRollout
F.VariationOrRollout (VariationIndex -> Maybe VariationIndex
forall a. a -> Maybe a
Just (VariationIndex -> Maybe VariationIndex)
-> VariationIndex -> Maybe VariationIndex
forall a b. (a -> b) -> a -> b
$ FlagRule -> VariationIndex
frVariation FlagRule
flagRule) Maybe Rollout
forall a. Maybe a
Nothing
        , $sel:clauses:Rule :: [Clause]
F.clauses = (Clause -> Clause) -> [Clause] -> [Clause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Clause -> Clause
convertClause (FlagRule -> [Clause]
frClauses FlagRule
flagRule)
        , $sel:trackEvents:Rule :: Bool
F.trackEvents = Bool
False
        }

convertClause :: Clause -> F.Clause
convertClause :: Clause -> Clause
convertClause clause :: Clause
clause =
    $WClause :: Reference -> Text -> Bool -> Op -> [Value] -> Clause
F.Clause
        { $sel:attribute:Clause :: Reference
F.attribute = Text -> Reference
makeReference (Text -> Reference) -> Text -> Reference
forall a b. (a -> b) -> a -> b
$ Clause -> Text
clauseAttribute Clause
clause
        , $sel:contextKind:Clause :: Text
F.contextKind = Clause -> Text
contextKind Clause
clause
        , $sel:negate:Clause :: Bool
F.negate = Clause -> Bool
clauseNegate Clause
clause
        , $sel:values:Clause :: [Value]
F.values = Clause -> [Value]
clauseValues Clause
clause
        , $sel:op:Clause :: Op
F.op = Op
Op.OpIn
        }

-- |
-- A builder for feature flag rules to be used with 'FlagBuilder'.
--
-- In the LaunchDarkly model, a flag can have any number of rules, and a rule
-- can have any number of clauses. A clause is an individual test such as
-- \"name is \'X\'\". A rule matches a context if all of the rule's clauses
-- match the context.
--
-- To start defining a rule, use one of the matching functions such as
-- 'ifMatch' or 'ifNotMatch'. This defines the first clause for the rule.
--
-- Optionally, you may add more clauses with the rule builder functions such as
-- 'andMatch' and 'andNotMatch'.
--
-- Finally, call 'thenReturn' to finish defining the rule.
data FlagRuleBuilder = FlagRuleBuilder
    { FlagRuleBuilder -> [Clause]
frbClauses :: [Clause]
    , FlagRuleBuilder -> FlagBuilder
frbBaseBuilder :: FlagBuilder
    }
    deriving (Int -> FlagRuleBuilder -> ShowS
[FlagRuleBuilder] -> ShowS
FlagRuleBuilder -> String
(Int -> FlagRuleBuilder -> ShowS)
-> (FlagRuleBuilder -> String)
-> ([FlagRuleBuilder] -> ShowS)
-> Show FlagRuleBuilder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlagRuleBuilder] -> ShowS
$cshowList :: [FlagRuleBuilder] -> ShowS
show :: FlagRuleBuilder -> String
$cshow :: FlagRuleBuilder -> String
showsPrec :: Int -> FlagRuleBuilder -> ShowS
$cshowsPrec :: Int -> FlagRuleBuilder -> ShowS
Show)

newFlagRuleBuilder :: FlagBuilder -> FlagRuleBuilder
newFlagRuleBuilder :: FlagBuilder -> FlagRuleBuilder
newFlagRuleBuilder baseBuilder :: FlagBuilder
baseBuilder =
    FlagRuleBuilder :: [Clause] -> FlagBuilder -> FlagRuleBuilder
FlagRuleBuilder
        { $sel:frbClauses:FlagRuleBuilder :: [Clause]
frbClauses = [Clause]
forall a. Monoid a => a
mempty
        , $sel:frbBaseBuilder:FlagRuleBuilder :: FlagBuilder
frbBaseBuilder = FlagBuilder
baseBuilder
        }

-- |
-- Adds another clause, using the "is one of" operator.
--
-- For example, this creates a rule that returns @True@ if the name is
-- \"Patsy\" and the country is \"gb\":
--
-- @
-- testData
--     & flag "flag"
--     & ifMatch "name" [toJSON \"Patsy\"]
--     & andMatch "country" [toJSON \"gb\"]
--     & thenReturn True
-- @
andMatchContext ::
    -- | the context kind to match again
    Text ->
    -- | the context attribute to match against
    Text ->
    -- | values to compare to
    [Aeson.Value] ->
    FlagRuleBuilder ->
    FlagRuleBuilder
andMatchContext :: Text -> Text -> [Value] -> FlagRuleBuilder -> FlagRuleBuilder
andMatchContext kind :: Text
kind attribute :: Text
attribute values :: [Value]
values ruleBuilder :: FlagRuleBuilder
ruleBuilder =
    FlagRuleBuilder
ruleBuilder {$sel:frbClauses:FlagRuleBuilder :: [Clause]
frbClauses = Text -> Text -> [Value] -> Bool -> Clause
Clause Text
attribute Text
kind [Value]
values Bool
False Clause -> [Clause] -> [Clause]
forall a. a -> [a] -> [a]
: FlagRuleBuilder -> [Clause]
frbClauses FlagRuleBuilder
ruleBuilder}

{-# DEPRECATED andMatch "Use andMatchContext instead" #-}

-- |
-- Adds another clause, using the "is one of" operator.
--
-- This is a shortcut for calling 'andMatchContext' with a context kind of
-- "user".
--
-- For example, this creates a rule that returns @True@ if the name is
-- \"Patsy\" and the country is \"gb\":
--
-- @
-- testData
--     & flag "flag"
--     & ifMatch "name" [toJSON \"Patsy\"]
--     & andMatch "country" [toJSON \"gb\"]
--     & thenReturn True
-- @
andMatch ::
    -- | the context attribute to match against
    Text ->
    -- | values to compare to
    [Aeson.Value] ->
    FlagRuleBuilder ->
    FlagRuleBuilder
andMatch :: Text -> [Value] -> FlagRuleBuilder -> FlagRuleBuilder
andMatch = Text -> Text -> [Value] -> FlagRuleBuilder -> FlagRuleBuilder
andMatchContext "user"

-- |
-- Adds another clause, using the "is not one of" operator.
--
-- For example, this creates a rule that returns @True@ if the name is
-- \"Patsy\" and the country is not \"gb\":
--
-- @
-- testData
--     & flag "flag"
--     & ifMatchContext "user" "name" [toJSON \"Patsy\"]
--     & andNotMatchContext "user" "country" [toJSON \"gb\"]
--     & thenReturn True
-- @
andNotMatchContext ::
    -- | the context kind to match against
    Text ->
    -- | the context attribute to match against
    Text ->
    -- | values to compare to
    [Aeson.Value] ->
    FlagRuleBuilder ->
    FlagRuleBuilder
andNotMatchContext :: Text -> Text -> [Value] -> FlagRuleBuilder -> FlagRuleBuilder
andNotMatchContext kind :: Text
kind attribute :: Text
attribute values :: [Value]
values ruleBuilder :: FlagRuleBuilder
ruleBuilder =
    FlagRuleBuilder
ruleBuilder {$sel:frbClauses:FlagRuleBuilder :: [Clause]
frbClauses = Text -> Text -> [Value] -> Bool -> Clause
Clause Text
attribute Text
kind [Value]
values Bool
True Clause -> [Clause] -> [Clause]
forall a. a -> [a] -> [a]
: FlagRuleBuilder -> [Clause]
frbClauses FlagRuleBuilder
ruleBuilder}

{-# DEPRECATED andNotMatch "Use andNotMatchContext instead" #-}

-- |
-- Adds another clause, using the "is not one of" operator.
--
-- This is a shortcut for calling 'andNotMatchContext' with a context kind of
-- "user".
--
-- For example, this creates a rule that returns @True@ if the name is
-- \"Patsy\" and the country is not \"gb\":
--
-- @
-- testData
--     & flag "flag"
--     & ifMatch "name" [toJSON \"Patsy\"]
--     & andNotMatch "country" [toJSON \"gb\"]
--     & thenReturn True
-- @
andNotMatch ::
    -- | the context attribute to match against
    Text ->
    -- | values to compare to
    [Aeson.Value] ->
    FlagRuleBuilder ->
    FlagRuleBuilder
andNotMatch :: Text -> [Value] -> FlagRuleBuilder -> FlagRuleBuilder
andNotMatch = Text -> Text -> [Value] -> FlagRuleBuilder -> FlagRuleBuilder
andNotMatchContext "user"

{-# DEPRECATED variationForAllUsers "Use variationForAll instead" #-}
{-# DEPRECATED variationForUser "Use variationForKey instead" #-}