module LaunchDarkly.Server.Features where

import Control.Lens (element, (^?))
import Control.Monad (mzero)
import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.!=), (.:), (.:?), (.=))
import Data.Generics.Product (getField)
import Data.HashSet (HashSet)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import GHC.Generics (Generic)
import GHC.Natural (Natural)

import LaunchDarkly.Server.Details (EvaluationReason (..))
import qualified LaunchDarkly.Server.Details as D
import LaunchDarkly.Server.Operators (Op)
import LaunchDarkly.Server.Reference (Reference, makeLiteral, makeReference)

data Target = Target
    { Target -> HashSet Text
values :: !(HashSet Text)
    , Target -> Integer
variation :: !Integer
    , Target -> Text
contextKind :: Text
    }
    deriving ((forall x. Target -> Rep Target x)
-> (forall x. Rep Target x -> Target) -> Generic Target
forall x. Rep Target x -> Target
forall x. Target -> Rep Target x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Target x -> Target
$cfrom :: forall x. Target -> Rep Target x
Generic, [Target] -> Encoding
[Target] -> Value
Target -> Encoding
Target -> Value
(Target -> Value)
-> (Target -> Encoding)
-> ([Target] -> Value)
-> ([Target] -> Encoding)
-> ToJSON Target
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Target] -> Encoding
$ctoEncodingList :: [Target] -> Encoding
toJSONList :: [Target] -> Value
$ctoJSONList :: [Target] -> Value
toEncoding :: Target -> Encoding
$ctoEncoding :: Target -> Encoding
toJSON :: Target -> Value
$ctoJSON :: Target -> Value
ToJSON, Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Target] -> ShowS
$cshowList :: [Target] -> ShowS
show :: Target -> String
$cshow :: Target -> String
showsPrec :: Int -> Target -> ShowS
$cshowsPrec :: Int -> Target -> ShowS
Show, Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c== :: Target -> Target -> Bool
Eq)

instance FromJSON Target where
    parseJSON :: Value -> Parser Target
parseJSON = String -> (Object -> Parser Target) -> Value -> Parser Target
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Target" ((Object -> Parser Target) -> Value -> Parser Target)
-> (Object -> Parser Target) -> Value -> Parser Target
forall a b. (a -> b) -> a -> b
$ \t :: Object
t ->
        HashSet Text -> Integer -> Text -> Target
Target
            (HashSet Text -> Integer -> Text -> Target)
-> Parser (HashSet Text) -> Parser (Integer -> Text -> Target)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
t Object -> Text -> Parser (HashSet Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: "values"
            Parser (Integer -> Text -> Target)
-> Parser Integer -> Parser (Text -> Target)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
t Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: "variation"
            Parser (Text -> Target) -> Parser Text -> Parser Target
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
t Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "contextKind" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= "user"

data Rule = Rule
    { Rule -> Text
id :: !Text
    , Rule -> [Clause]
clauses :: ![Clause]
    , Rule -> VariationOrRollout
variationOrRollout :: !VariationOrRollout
    , Rule -> Bool
trackEvents :: !Bool
    }
    deriving ((forall x. Rule -> Rep Rule x)
-> (forall x. Rep Rule x -> Rule) -> Generic Rule
forall x. Rep Rule x -> Rule
forall x. Rule -> Rep Rule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rule x -> Rule
$cfrom :: forall x. Rule -> Rep Rule x
Generic, Int -> Rule -> ShowS
[Rule] -> ShowS
Rule -> String
(Int -> Rule -> ShowS)
-> (Rule -> String) -> ([Rule] -> ShowS) -> Show Rule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rule] -> ShowS
$cshowList :: [Rule] -> ShowS
show :: Rule -> String
$cshow :: Rule -> String
showsPrec :: Int -> Rule -> ShowS
$cshowsPrec :: Int -> Rule -> ShowS
Show, Rule -> Rule -> Bool
(Rule -> Rule -> Bool) -> (Rule -> Rule -> Bool) -> Eq Rule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rule -> Rule -> Bool
$c/= :: Rule -> Rule -> Bool
== :: Rule -> Rule -> Bool
$c== :: Rule -> Rule -> Bool
Eq)

instance FromJSON Rule where
    parseJSON :: Value -> Parser Rule
parseJSON = String -> (Object -> Parser Rule) -> Value -> Parser Rule
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Rule" ((Object -> Parser Rule) -> Value -> Parser Rule)
-> (Object -> Parser Rule) -> Value -> Parser Rule
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Maybe Text
id <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "id"
        [Clause]
clauses <- Object
o Object -> Text -> Parser [Clause]
forall a. FromJSON a => Object -> Text -> Parser a
.: "clauses"
        Maybe Integer
variation <- Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "variation"
        Maybe Rollout
rollout <- Object
o Object -> Text -> Parser (Maybe Rollout)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "rollout"
        Bool
trackEvents <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "trackEvents"
        Rule -> Parser Rule
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            $WRule :: Text -> [Clause] -> VariationOrRollout -> Bool -> Rule
Rule
                { $sel:id:Rule :: Text
id = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" Maybe Text
id
                , $sel:clauses:Rule :: [Clause]
clauses = [Clause]
clauses
                , $sel:variationOrRollout:Rule :: VariationOrRollout
variationOrRollout =
                    $WVariationOrRollout :: Maybe Integer -> Maybe Rollout -> VariationOrRollout
VariationOrRollout
                        { $sel:variation:VariationOrRollout :: Maybe Integer
variation = Maybe Integer
variation
                        , $sel:rollout:VariationOrRollout :: Maybe Rollout
rollout = Maybe Rollout
rollout
                        }
                , $sel:trackEvents:Rule :: Bool
trackEvents = Bool
trackEvents
                }

instance ToJSON Rule where
    toJSON :: Rule -> Value
toJSON rule :: Rule
rule =
        [Pair] -> Value
object
            [ "id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Rule -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"id" Rule
rule
            , "clauses" Text -> [Clause] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Rule -> [Clause]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clauses" Rule
rule
            , "trackEvents" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Rule -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents" Rule
rule
            , "variation" Text -> Maybe Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= VariationOrRollout -> Maybe Integer
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" (Rule -> VariationOrRollout
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationOrRollout" Rule
rule)
            , "rollout" Text -> Maybe Rollout -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= VariationOrRollout -> Maybe Rollout
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rollout" (Rule -> VariationOrRollout
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationOrRollout" Rule
rule)
            ]

data WeightedVariation = WeightedVariation
    { WeightedVariation -> Integer
variation :: !Integer
    , WeightedVariation -> Float
weight :: !Float
    , WeightedVariation -> Bool
untracked :: !Bool
    }
    deriving ((forall x. WeightedVariation -> Rep WeightedVariation x)
-> (forall x. Rep WeightedVariation x -> WeightedVariation)
-> Generic WeightedVariation
forall x. Rep WeightedVariation x -> WeightedVariation
forall x. WeightedVariation -> Rep WeightedVariation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WeightedVariation x -> WeightedVariation
$cfrom :: forall x. WeightedVariation -> Rep WeightedVariation x
Generic, [WeightedVariation] -> Encoding
[WeightedVariation] -> Value
WeightedVariation -> Encoding
WeightedVariation -> Value
(WeightedVariation -> Value)
-> (WeightedVariation -> Encoding)
-> ([WeightedVariation] -> Value)
-> ([WeightedVariation] -> Encoding)
-> ToJSON WeightedVariation
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WeightedVariation] -> Encoding
$ctoEncodingList :: [WeightedVariation] -> Encoding
toJSONList :: [WeightedVariation] -> Value
$ctoJSONList :: [WeightedVariation] -> Value
toEncoding :: WeightedVariation -> Encoding
$ctoEncoding :: WeightedVariation -> Encoding
toJSON :: WeightedVariation -> Value
$ctoJSON :: WeightedVariation -> Value
ToJSON, Int -> WeightedVariation -> ShowS
[WeightedVariation] -> ShowS
WeightedVariation -> String
(Int -> WeightedVariation -> ShowS)
-> (WeightedVariation -> String)
-> ([WeightedVariation] -> ShowS)
-> Show WeightedVariation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WeightedVariation] -> ShowS
$cshowList :: [WeightedVariation] -> ShowS
show :: WeightedVariation -> String
$cshow :: WeightedVariation -> String
showsPrec :: Int -> WeightedVariation -> ShowS
$cshowsPrec :: Int -> WeightedVariation -> ShowS
Show, WeightedVariation -> WeightedVariation -> Bool
(WeightedVariation -> WeightedVariation -> Bool)
-> (WeightedVariation -> WeightedVariation -> Bool)
-> Eq WeightedVariation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WeightedVariation -> WeightedVariation -> Bool
$c/= :: WeightedVariation -> WeightedVariation -> Bool
== :: WeightedVariation -> WeightedVariation -> Bool
$c== :: WeightedVariation -> WeightedVariation -> Bool
Eq)

instance FromJSON WeightedVariation where
    parseJSON :: Value -> Parser WeightedVariation
parseJSON = String
-> (Object -> Parser WeightedVariation)
-> Value
-> Parser WeightedVariation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "WeightedVariation" ((Object -> Parser WeightedVariation)
 -> Value -> Parser WeightedVariation)
-> (Object -> Parser WeightedVariation)
-> Value
-> Parser WeightedVariation
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Integer
variation <- Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: "variation"
        Float
weight <- Object
o Object -> Text -> Parser Float
forall a. FromJSON a => Object -> Text -> Parser a
.: "weight"
        Bool
untracked <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "untracked" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
        WeightedVariation -> Parser WeightedVariation
forall (f :: * -> *) a. Applicative f => a -> f a
pure $WWeightedVariation :: Integer -> Float -> Bool -> WeightedVariation
WeightedVariation {..}

data RolloutKind = RolloutKindExperiment | RolloutKindRollout
    deriving (RolloutKind -> RolloutKind -> Bool
(RolloutKind -> RolloutKind -> Bool)
-> (RolloutKind -> RolloutKind -> Bool) -> Eq RolloutKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RolloutKind -> RolloutKind -> Bool
$c/= :: RolloutKind -> RolloutKind -> Bool
== :: RolloutKind -> RolloutKind -> Bool
$c== :: RolloutKind -> RolloutKind -> Bool
Eq, Int -> RolloutKind -> ShowS
[RolloutKind] -> ShowS
RolloutKind -> String
(Int -> RolloutKind -> ShowS)
-> (RolloutKind -> String)
-> ([RolloutKind] -> ShowS)
-> Show RolloutKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RolloutKind] -> ShowS
$cshowList :: [RolloutKind] -> ShowS
show :: RolloutKind -> String
$cshow :: RolloutKind -> String
showsPrec :: Int -> RolloutKind -> ShowS
$cshowsPrec :: Int -> RolloutKind -> ShowS
Show)

instance ToJSON RolloutKind where
    toJSON :: RolloutKind -> Value
toJSON x :: RolloutKind
x = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case RolloutKind
x of
        RolloutKindExperiment -> "experiment"
        RolloutKindRollout -> "rollout"

instance FromJSON RolloutKind where
    parseJSON :: Value -> Parser RolloutKind
parseJSON x :: Value
x = case Value
x of
        (String "experiment") -> RolloutKind -> Parser RolloutKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RolloutKind
RolloutKindExperiment
        (String "rollout") -> RolloutKind -> Parser RolloutKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RolloutKind
RolloutKindRollout
        _ -> Parser RolloutKind
forall (m :: * -> *) a. MonadPlus m => m a
mzero

data Rollout = Rollout
    { Rollout -> [WeightedVariation]
variations :: ![WeightedVariation]
    , Rollout -> Maybe Text
bucketBy :: !(Maybe Text)
    , Rollout -> RolloutKind
kind :: !RolloutKind
    , Rollout -> Maybe Text
contextKind :: !(Maybe Text)
    , Rollout -> Maybe Int
seed :: !(Maybe Int)
    }
    deriving ((forall x. Rollout -> Rep Rollout x)
-> (forall x. Rep Rollout x -> Rollout) -> Generic Rollout
forall x. Rep Rollout x -> Rollout
forall x. Rollout -> Rep Rollout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rollout x -> Rollout
$cfrom :: forall x. Rollout -> Rep Rollout x
Generic, [Rollout] -> Encoding
[Rollout] -> Value
Rollout -> Encoding
Rollout -> Value
(Rollout -> Value)
-> (Rollout -> Encoding)
-> ([Rollout] -> Value)
-> ([Rollout] -> Encoding)
-> ToJSON Rollout
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Rollout] -> Encoding
$ctoEncodingList :: [Rollout] -> Encoding
toJSONList :: [Rollout] -> Value
$ctoJSONList :: [Rollout] -> Value
toEncoding :: Rollout -> Encoding
$ctoEncoding :: Rollout -> Encoding
toJSON :: Rollout -> Value
$ctoJSON :: Rollout -> Value
ToJSON, Int -> Rollout -> ShowS
[Rollout] -> ShowS
Rollout -> String
(Int -> Rollout -> ShowS)
-> (Rollout -> String) -> ([Rollout] -> ShowS) -> Show Rollout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rollout] -> ShowS
$cshowList :: [Rollout] -> ShowS
show :: Rollout -> String
$cshow :: Rollout -> String
showsPrec :: Int -> Rollout -> ShowS
$cshowsPrec :: Int -> Rollout -> ShowS
Show, Rollout -> Rollout -> Bool
(Rollout -> Rollout -> Bool)
-> (Rollout -> Rollout -> Bool) -> Eq Rollout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rollout -> Rollout -> Bool
$c/= :: Rollout -> Rollout -> Bool
== :: Rollout -> Rollout -> Bool
$c== :: Rollout -> Rollout -> Bool
Eq)

instance FromJSON Rollout where
    parseJSON :: Value -> Parser Rollout
parseJSON = String -> (Object -> Parser Rollout) -> Value -> Parser Rollout
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "rollout" ((Object -> Parser Rollout) -> Value -> Parser Rollout)
-> (Object -> Parser Rollout) -> Value -> Parser Rollout
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        [WeightedVariation]
variations <- Object
o Object -> Text -> Parser [WeightedVariation]
forall a. FromJSON a => Object -> Text -> Parser a
.: "variations"
        Maybe Text
bucketBy <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "bucketBy"
        RolloutKind
kind <- Object
o Object -> Text -> Parser (Maybe RolloutKind)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "kind" Parser (Maybe RolloutKind) -> RolloutKind -> Parser RolloutKind
forall a. Parser (Maybe a) -> a -> Parser a
.!= RolloutKind
RolloutKindRollout
        Maybe Text
contextKind <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "contextKind"
        Maybe Int
seed <- Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "seed"
        Rollout -> Parser Rollout
forall (f :: * -> *) a. Applicative f => a -> f a
pure $WRollout :: [WeightedVariation]
-> Maybe Text -> RolloutKind -> Maybe Text -> Maybe Int -> Rollout
Rollout {..}

data VariationOrRollout = VariationOrRollout
    { VariationOrRollout -> Maybe Integer
variation :: !(Maybe Integer)
    , VariationOrRollout -> Maybe Rollout
rollout :: !(Maybe Rollout)
    }
    deriving ((forall x. VariationOrRollout -> Rep VariationOrRollout x)
-> (forall x. Rep VariationOrRollout x -> VariationOrRollout)
-> Generic VariationOrRollout
forall x. Rep VariationOrRollout x -> VariationOrRollout
forall x. VariationOrRollout -> Rep VariationOrRollout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VariationOrRollout x -> VariationOrRollout
$cfrom :: forall x. VariationOrRollout -> Rep VariationOrRollout x
Generic, Value -> Parser [VariationOrRollout]
Value -> Parser VariationOrRollout
(Value -> Parser VariationOrRollout)
-> (Value -> Parser [VariationOrRollout])
-> FromJSON VariationOrRollout
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [VariationOrRollout]
$cparseJSONList :: Value -> Parser [VariationOrRollout]
parseJSON :: Value -> Parser VariationOrRollout
$cparseJSON :: Value -> Parser VariationOrRollout
FromJSON, [VariationOrRollout] -> Encoding
[VariationOrRollout] -> Value
VariationOrRollout -> Encoding
VariationOrRollout -> Value
(VariationOrRollout -> Value)
-> (VariationOrRollout -> Encoding)
-> ([VariationOrRollout] -> Value)
-> ([VariationOrRollout] -> Encoding)
-> ToJSON VariationOrRollout
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VariationOrRollout] -> Encoding
$ctoEncodingList :: [VariationOrRollout] -> Encoding
toJSONList :: [VariationOrRollout] -> Value
$ctoJSONList :: [VariationOrRollout] -> Value
toEncoding :: VariationOrRollout -> Encoding
$ctoEncoding :: VariationOrRollout -> Encoding
toJSON :: VariationOrRollout -> Value
$ctoJSON :: VariationOrRollout -> Value
ToJSON, Int -> VariationOrRollout -> ShowS
[VariationOrRollout] -> ShowS
VariationOrRollout -> String
(Int -> VariationOrRollout -> ShowS)
-> (VariationOrRollout -> String)
-> ([VariationOrRollout] -> ShowS)
-> Show VariationOrRollout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariationOrRollout] -> ShowS
$cshowList :: [VariationOrRollout] -> ShowS
show :: VariationOrRollout -> String
$cshow :: VariationOrRollout -> String
showsPrec :: Int -> VariationOrRollout -> ShowS
$cshowsPrec :: Int -> VariationOrRollout -> ShowS
Show, VariationOrRollout -> VariationOrRollout -> Bool
(VariationOrRollout -> VariationOrRollout -> Bool)
-> (VariationOrRollout -> VariationOrRollout -> Bool)
-> Eq VariationOrRollout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariationOrRollout -> VariationOrRollout -> Bool
$c/= :: VariationOrRollout -> VariationOrRollout -> Bool
== :: VariationOrRollout -> VariationOrRollout -> Bool
$c== :: VariationOrRollout -> VariationOrRollout -> Bool
Eq)

data ClientSideAvailability = ClientSideAvailability
    { ClientSideAvailability -> Bool
usingEnvironmentId :: !Bool
    , ClientSideAvailability -> Bool
usingMobileKey :: !Bool
    , ClientSideAvailability -> Bool
explicit :: !Bool
    }
    deriving ((forall x. ClientSideAvailability -> Rep ClientSideAvailability x)
-> (forall x.
    Rep ClientSideAvailability x -> ClientSideAvailability)
-> Generic ClientSideAvailability
forall x. Rep ClientSideAvailability x -> ClientSideAvailability
forall x. ClientSideAvailability -> Rep ClientSideAvailability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientSideAvailability x -> ClientSideAvailability
$cfrom :: forall x. ClientSideAvailability -> Rep ClientSideAvailability x
Generic, Int -> ClientSideAvailability -> ShowS
[ClientSideAvailability] -> ShowS
ClientSideAvailability -> String
(Int -> ClientSideAvailability -> ShowS)
-> (ClientSideAvailability -> String)
-> ([ClientSideAvailability] -> ShowS)
-> Show ClientSideAvailability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientSideAvailability] -> ShowS
$cshowList :: [ClientSideAvailability] -> ShowS
show :: ClientSideAvailability -> String
$cshow :: ClientSideAvailability -> String
showsPrec :: Int -> ClientSideAvailability -> ShowS
$cshowsPrec :: Int -> ClientSideAvailability -> ShowS
Show, ClientSideAvailability -> ClientSideAvailability -> Bool
(ClientSideAvailability -> ClientSideAvailability -> Bool)
-> (ClientSideAvailability -> ClientSideAvailability -> Bool)
-> Eq ClientSideAvailability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientSideAvailability -> ClientSideAvailability -> Bool
$c/= :: ClientSideAvailability -> ClientSideAvailability -> Bool
== :: ClientSideAvailability -> ClientSideAvailability -> Bool
$c== :: ClientSideAvailability -> ClientSideAvailability -> Bool
Eq)

instance FromJSON ClientSideAvailability where
    parseJSON :: Value -> Parser ClientSideAvailability
parseJSON = String
-> (Object -> Parser ClientSideAvailability)
-> Value
-> Parser ClientSideAvailability
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "ClientSideAvailability" ((Object -> Parser ClientSideAvailability)
 -> Value -> Parser ClientSideAvailability)
-> (Object -> Parser ClientSideAvailability)
-> Value
-> Parser ClientSideAvailability
forall a b. (a -> b) -> a -> b
$ \obj :: Object
obj ->
        Bool -> Bool -> Bool -> ClientSideAvailability
ClientSideAvailability
            (Bool -> Bool -> Bool -> ClientSideAvailability)
-> Parser Bool -> Parser (Bool -> Bool -> ClientSideAvailability)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "usingEnvironmentId"
            Parser (Bool -> Bool -> ClientSideAvailability)
-> Parser Bool -> Parser (Bool -> ClientSideAvailability)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "usingMobileKey"
            Parser (Bool -> ClientSideAvailability)
-> Parser Bool -> Parser ClientSideAvailability
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

instance ToJSON ClientSideAvailability where
    toJSON :: ClientSideAvailability -> Value
toJSON (ClientSideAvailability env :: Bool
env mob :: Bool
mob _) =
        [Pair] -> Value
object ["usingEnvironmentId" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
env, "usingMobileKey" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
mob]

data Flag = Flag
    { Flag -> Text
key :: !Text
    , Flag -> Natural
version :: !Natural
    , Flag -> Bool
on :: !Bool
    , Flag -> Bool
trackEvents :: !Bool
    , Flag -> Bool
trackEventsFallthrough :: !Bool
    , Flag -> Bool
deleted :: !Bool
    , Flag -> [Prerequisite]
prerequisites :: ![Prerequisite]
    , Flag -> Text
salt :: !Text
    , Flag -> [Target]
targets :: ![Target]
    , Flag -> [Target]
contextTargets :: ![Target]
    , Flag -> [Rule]
rules :: ![Rule]
    , Flag -> VariationOrRollout
fallthrough :: !VariationOrRollout
    , Flag -> Maybe Integer
offVariation :: !(Maybe Integer)
    , Flag -> [Value]
variations :: ![Value]
    , Flag -> Maybe Natural
debugEventsUntilDate :: !(Maybe Natural)
    , Flag -> ClientSideAvailability
clientSideAvailability :: !ClientSideAvailability
    }
    deriving ((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, 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)

instance ToJSON Flag where
    toJSON :: Flag -> Value
toJSON flag :: Flag
flag =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            [ "key" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Flag
flag
            , "version" Text -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" Flag
flag
            , "on" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"on" Flag
flag
            , "trackEvents" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents" Flag
flag
            , "trackEventsFallthrough" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEventsFallthrough" Flag
flag
            , "deleted" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"deleted" Flag
flag
            , "prerequisites" Text -> [Prerequisite] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> [Prerequisite]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"prerequisites" Flag
flag
            , "salt" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"salt" Flag
flag
            , "targets" Text -> [Target] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> [Target]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"targets" Flag
flag
            , "contextTargets" Text -> [Target] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> [Target]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"contextTargets" Flag
flag
            , "rules" Text -> [Rule] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> [Rule]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" Flag
flag
            , "fallthrough" Text -> VariationOrRollout -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> VariationOrRollout
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"fallthrough" Flag
flag
            , "offVariation" Text -> Maybe Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> Maybe Integer
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"offVariation" Flag
flag
            , "variations" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> [Value]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variations" Flag
flag
            , "debugEventsUntilDate" Text -> Maybe Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"debugEventsUntilDate" Flag
flag
            , "clientSide" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (forall a s. HasField' "usingEnvironmentId" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"usingEnvironmentId" (ClientSideAvailability -> Bool) -> ClientSideAvailability -> Bool
forall a b. (a -> b) -> a -> b
$ Flag -> ClientSideAvailability
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clientSideAvailability" Flag
flag)
            ]
                [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> case forall a s. HasField' "explicit" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"explicit" (ClientSideAvailability -> Bool) -> ClientSideAvailability -> Bool
forall a b. (a -> b) -> a -> b
$ Flag -> ClientSideAvailability
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clientSideAvailability" Flag
flag of
                    True -> ["clientSideAvailability" Text -> ClientSideAvailability -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Flag -> ClientSideAvailability
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clientSideAvailability" Flag
flag]
                    False -> []

instance FromJSON Flag where
    parseJSON :: Value -> Parser Flag
parseJSON = String -> (Object -> Parser Flag) -> Value -> Parser Flag
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Flag" ((Object -> Parser Flag) -> Value -> Parser Flag)
-> (Object -> Parser Flag) -> Value -> Parser Flag
forall a b. (a -> b) -> a -> b
$ \obj :: Object
obj -> do
        Text
key <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "key"
        Natural
version <- Object
obj Object -> Text -> Parser Natural
forall a. FromJSON a => Object -> Text -> Parser a
.: "version"
        Bool
on <- Object
obj Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "on"
        Bool
trackEvents <- Object
obj Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "trackEvents"
        Bool
trackEventsFallthrough <- Object
obj Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "trackEventsFallthrough"
        Bool
deleted <- Object
obj Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "deleted"
        [Prerequisite]
prerequisites <- Object
obj Object -> Text -> Parser [Prerequisite]
forall a. FromJSON a => Object -> Text -> Parser a
.: "prerequisites"
        Text
salt <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "salt"
        [Target]
targets <- Object
obj Object -> Text -> Parser [Target]
forall a. FromJSON a => Object -> Text -> Parser a
.: "targets"
        [Target]
contextTargets <- Object
obj Object -> Text -> Parser (Maybe [Target])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "contextTargets" Parser (Maybe [Target]) -> [Target] -> Parser [Target]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [Target]
forall a. Monoid a => a
mempty
        [Rule]
rules <- Object
obj Object -> Text -> Parser [Rule]
forall a. FromJSON a => Object -> Text -> Parser a
.: "rules"
        VariationOrRollout
fallthrough <- Object
obj Object -> Text -> Parser VariationOrRollout
forall a. FromJSON a => Object -> Text -> Parser a
.: "fallthrough"
        Maybe Integer
offVariation <- Object
obj Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "offVariation"
        [Value]
variations <- Object
obj Object -> Text -> Parser [Value]
forall a. FromJSON a => Object -> Text -> Parser a
.: "variations"
        Maybe Natural
debugEventsUntilDate <- Object
obj Object -> Text -> Parser (Maybe Natural)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "debugEventsUntilDate"
        Bool
clientSide <- Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "clientSide" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
        ClientSideAvailability
clientSideAvailability <- Object
obj Object -> Text -> Parser (Maybe ClientSideAvailability)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "clientSideAvailability" Parser (Maybe ClientSideAvailability)
-> ClientSideAvailability -> Parser ClientSideAvailability
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool -> Bool -> Bool -> ClientSideAvailability
ClientSideAvailability Bool
clientSide Bool
True Bool
False
        Flag -> Parser Flag
forall (f :: * -> *) a. Applicative f => a -> f a
pure $WFlag :: Text
-> Natural
-> Bool
-> Bool
-> Bool
-> Bool
-> [Prerequisite]
-> Text
-> [Target]
-> [Target]
-> [Rule]
-> VariationOrRollout
-> Maybe Integer
-> [Value]
-> Maybe Natural
-> ClientSideAvailability
-> Flag
Flag {..}

isClientSideOnlyFlag :: Flag -> Bool
isClientSideOnlyFlag :: Flag -> Bool
isClientSideOnlyFlag flag :: Flag
flag = forall a s. HasField' "usingEnvironmentId" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"usingEnvironmentId" (ClientSideAvailability -> Bool) -> ClientSideAvailability -> Bool
forall a b. (a -> b) -> a -> b
$ Flag -> ClientSideAvailability
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clientSideAvailability" Flag
flag

-- If the reason for the flag is in an experiment,
-- or if it's a fallthrough reason and the flag has trackEventsFallthrough
-- or if it's a rule match and the rule that matched has track events turned on
-- otherwise false
isInExperiment :: Flag -> EvaluationReason -> Bool
isInExperiment :: Flag -> EvaluationReason -> Bool
isInExperiment _ reason :: EvaluationReason
reason
    | EvaluationReason -> Bool
D.isInExperiment EvaluationReason
reason = Bool
True
isInExperiment flag :: Flag
flag EvaluationReasonFallthrough {} = Flag -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEventsFallthrough" Flag
flag
isInExperiment flag :: Flag
flag (EvaluationReasonRuleMatch ruleIndex :: Natural
ruleIndex _ _) =
    let index :: Int
index = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
ruleIndex
        rules :: [Rule]
rules = Flag -> [Rule]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" Flag
flag
        rule :: Maybe Rule
rule = [Rule]
rules [Rule] -> Getting (First Rule) [Rule] Rule -> Maybe Rule
forall s a. s -> Getting (First a) s a -> Maybe a
^? Int -> IndexedTraversal' Int [Rule] Rule
forall (t :: * -> *) a.
Traversable t =>
Int -> IndexedTraversal' Int (t a) a
element Int
index
     in Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Rule -> Bool) -> Maybe Rule -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a s. HasField' "trackEvents" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents") Maybe Rule
rule
isInExperiment _ _ = Bool
False

data Prerequisite = Prerequisite
    { Prerequisite -> Text
key :: !Text
    , Prerequisite -> Integer
variation :: !Integer
    }
    deriving ((forall x. Prerequisite -> Rep Prerequisite x)
-> (forall x. Rep Prerequisite x -> Prerequisite)
-> Generic Prerequisite
forall x. Rep Prerequisite x -> Prerequisite
forall x. Prerequisite -> Rep Prerequisite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Prerequisite x -> Prerequisite
$cfrom :: forall x. Prerequisite -> Rep Prerequisite x
Generic, Value -> Parser [Prerequisite]
Value -> Parser Prerequisite
(Value -> Parser Prerequisite)
-> (Value -> Parser [Prerequisite]) -> FromJSON Prerequisite
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Prerequisite]
$cparseJSONList :: Value -> Parser [Prerequisite]
parseJSON :: Value -> Parser Prerequisite
$cparseJSON :: Value -> Parser Prerequisite
FromJSON, [Prerequisite] -> Encoding
[Prerequisite] -> Value
Prerequisite -> Encoding
Prerequisite -> Value
(Prerequisite -> Value)
-> (Prerequisite -> Encoding)
-> ([Prerequisite] -> Value)
-> ([Prerequisite] -> Encoding)
-> ToJSON Prerequisite
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Prerequisite] -> Encoding
$ctoEncodingList :: [Prerequisite] -> Encoding
toJSONList :: [Prerequisite] -> Value
$ctoJSONList :: [Prerequisite] -> Value
toEncoding :: Prerequisite -> Encoding
$ctoEncoding :: Prerequisite -> Encoding
toJSON :: Prerequisite -> Value
$ctoJSON :: Prerequisite -> Value
ToJSON, Int -> Prerequisite -> ShowS
[Prerequisite] -> ShowS
Prerequisite -> String
(Int -> Prerequisite -> ShowS)
-> (Prerequisite -> String)
-> ([Prerequisite] -> ShowS)
-> Show Prerequisite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prerequisite] -> ShowS
$cshowList :: [Prerequisite] -> ShowS
show :: Prerequisite -> String
$cshow :: Prerequisite -> String
showsPrec :: Int -> Prerequisite -> ShowS
$cshowsPrec :: Int -> Prerequisite -> ShowS
Show, Prerequisite -> Prerequisite -> Bool
(Prerequisite -> Prerequisite -> Bool)
-> (Prerequisite -> Prerequisite -> Bool) -> Eq Prerequisite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prerequisite -> Prerequisite -> Bool
$c/= :: Prerequisite -> Prerequisite -> Bool
== :: Prerequisite -> Prerequisite -> Bool
$c== :: Prerequisite -> Prerequisite -> Bool
Eq)

data SegmentRule = SegmentRule
    { SegmentRule -> Text
id :: !Text
    , SegmentRule -> [Clause]
clauses :: ![Clause]
    , SegmentRule -> Maybe Float
weight :: !(Maybe Float)
    , SegmentRule -> Maybe Text
bucketBy :: !(Maybe Text)
    , SegmentRule -> Maybe Text
rolloutContextKind :: !(Maybe Text)
    }
    deriving ((forall x. SegmentRule -> Rep SegmentRule x)
-> (forall x. Rep SegmentRule x -> SegmentRule)
-> Generic SegmentRule
forall x. Rep SegmentRule x -> SegmentRule
forall x. SegmentRule -> Rep SegmentRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SegmentRule x -> SegmentRule
$cfrom :: forall x. SegmentRule -> Rep SegmentRule x
Generic, [SegmentRule] -> Encoding
[SegmentRule] -> Value
SegmentRule -> Encoding
SegmentRule -> Value
(SegmentRule -> Value)
-> (SegmentRule -> Encoding)
-> ([SegmentRule] -> Value)
-> ([SegmentRule] -> Encoding)
-> ToJSON SegmentRule
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SegmentRule] -> Encoding
$ctoEncodingList :: [SegmentRule] -> Encoding
toJSONList :: [SegmentRule] -> Value
$ctoJSONList :: [SegmentRule] -> Value
toEncoding :: SegmentRule -> Encoding
$ctoEncoding :: SegmentRule -> Encoding
toJSON :: SegmentRule -> Value
$ctoJSON :: SegmentRule -> Value
ToJSON, Int -> SegmentRule -> ShowS
[SegmentRule] -> ShowS
SegmentRule -> String
(Int -> SegmentRule -> ShowS)
-> (SegmentRule -> String)
-> ([SegmentRule] -> ShowS)
-> Show SegmentRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SegmentRule] -> ShowS
$cshowList :: [SegmentRule] -> ShowS
show :: SegmentRule -> String
$cshow :: SegmentRule -> String
showsPrec :: Int -> SegmentRule -> ShowS
$cshowsPrec :: Int -> SegmentRule -> ShowS
Show, SegmentRule -> SegmentRule -> Bool
(SegmentRule -> SegmentRule -> Bool)
-> (SegmentRule -> SegmentRule -> Bool) -> Eq SegmentRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SegmentRule -> SegmentRule -> Bool
$c/= :: SegmentRule -> SegmentRule -> Bool
== :: SegmentRule -> SegmentRule -> Bool
$c== :: SegmentRule -> SegmentRule -> Bool
Eq)

instance FromJSON SegmentRule where
    parseJSON :: Value -> Parser SegmentRule
parseJSON = String
-> (Object -> Parser SegmentRule) -> Value -> Parser SegmentRule
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "SegmentRule" ((Object -> Parser SegmentRule) -> Value -> Parser SegmentRule)
-> (Object -> Parser SegmentRule) -> Value -> Parser SegmentRule
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Text
id <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "id"
        [Clause]
clauses <- Object
o Object -> Text -> Parser [Clause]
forall a. FromJSON a => Object -> Text -> Parser a
.: "clauses"
        Maybe Float
weight <- Object
o Object -> Text -> Parser (Maybe Float)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "weight"
        Maybe Text
bucketBy <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "bucketBy"
        Maybe Text
rolloutContextKind <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "rolloutContextKind"
        SegmentRule -> Parser SegmentRule
forall (m :: * -> *) a. Monad m => a -> m a
return (SegmentRule -> Parser SegmentRule)
-> SegmentRule -> Parser SegmentRule
forall a b. (a -> b) -> a -> b
$ $WSegmentRule :: Text
-> [Clause]
-> Maybe Float
-> Maybe Text
-> Maybe Text
-> SegmentRule
SegmentRule {..}

data Segment = Segment
    { Segment -> Text
key :: !Text
    , Segment -> HashSet Text
included :: !(HashSet Text)
    , Segment -> [SegmentTarget]
includedContexts :: ![SegmentTarget]
    , Segment -> HashSet Text
excluded :: !(HashSet Text)
    , Segment -> [SegmentTarget]
excludedContexts :: ![SegmentTarget]
    , Segment -> Text
salt :: !Text
    , Segment -> [SegmentRule]
rules :: ![SegmentRule]
    , Segment -> Natural
version :: !Natural
    , Segment -> Bool
deleted :: !Bool
    }
    deriving ((forall x. Segment -> Rep Segment x)
-> (forall x. Rep Segment x -> Segment) -> Generic Segment
forall x. Rep Segment x -> Segment
forall x. Segment -> Rep Segment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Segment x -> Segment
$cfrom :: forall x. Segment -> Rep Segment x
Generic, Value -> Parser [Segment]
Value -> Parser Segment
(Value -> Parser Segment)
-> (Value -> Parser [Segment]) -> FromJSON Segment
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Segment]
$cparseJSONList :: Value -> Parser [Segment]
parseJSON :: Value -> Parser Segment
$cparseJSON :: Value -> Parser Segment
FromJSON, [Segment] -> Encoding
[Segment] -> Value
Segment -> Encoding
Segment -> Value
(Segment -> Value)
-> (Segment -> Encoding)
-> ([Segment] -> Value)
-> ([Segment] -> Encoding)
-> ToJSON Segment
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Segment] -> Encoding
$ctoEncodingList :: [Segment] -> Encoding
toJSONList :: [Segment] -> Value
$ctoJSONList :: [Segment] -> Value
toEncoding :: Segment -> Encoding
$ctoEncoding :: Segment -> Encoding
toJSON :: Segment -> Value
$ctoJSON :: Segment -> Value
ToJSON, Int -> Segment -> ShowS
[Segment] -> ShowS
Segment -> String
(Int -> Segment -> ShowS)
-> (Segment -> String) -> ([Segment] -> ShowS) -> Show Segment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Segment] -> ShowS
$cshowList :: [Segment] -> ShowS
show :: Segment -> String
$cshow :: Segment -> String
showsPrec :: Int -> Segment -> ShowS
$cshowsPrec :: Int -> Segment -> ShowS
Show, Segment -> Segment -> Bool
(Segment -> Segment -> Bool)
-> (Segment -> Segment -> Bool) -> Eq Segment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Segment -> Segment -> Bool
$c/= :: Segment -> Segment -> Bool
== :: Segment -> Segment -> Bool
$c== :: Segment -> Segment -> Bool
Eq)

data SegmentTarget = SegmentTarget
    { SegmentTarget -> HashSet Text
values :: !(HashSet Text)
    , SegmentTarget -> Text
contextKind :: !Text
    }
    deriving ((forall x. SegmentTarget -> Rep SegmentTarget x)
-> (forall x. Rep SegmentTarget x -> SegmentTarget)
-> Generic SegmentTarget
forall x. Rep SegmentTarget x -> SegmentTarget
forall x. SegmentTarget -> Rep SegmentTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SegmentTarget x -> SegmentTarget
$cfrom :: forall x. SegmentTarget -> Rep SegmentTarget x
Generic, Value -> Parser [SegmentTarget]
Value -> Parser SegmentTarget
(Value -> Parser SegmentTarget)
-> (Value -> Parser [SegmentTarget]) -> FromJSON SegmentTarget
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SegmentTarget]
$cparseJSONList :: Value -> Parser [SegmentTarget]
parseJSON :: Value -> Parser SegmentTarget
$cparseJSON :: Value -> Parser SegmentTarget
FromJSON, [SegmentTarget] -> Encoding
[SegmentTarget] -> Value
SegmentTarget -> Encoding
SegmentTarget -> Value
(SegmentTarget -> Value)
-> (SegmentTarget -> Encoding)
-> ([SegmentTarget] -> Value)
-> ([SegmentTarget] -> Encoding)
-> ToJSON SegmentTarget
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SegmentTarget] -> Encoding
$ctoEncodingList :: [SegmentTarget] -> Encoding
toJSONList :: [SegmentTarget] -> Value
$ctoJSONList :: [SegmentTarget] -> Value
toEncoding :: SegmentTarget -> Encoding
$ctoEncoding :: SegmentTarget -> Encoding
toJSON :: SegmentTarget -> Value
$ctoJSON :: SegmentTarget -> Value
ToJSON, Int -> SegmentTarget -> ShowS
[SegmentTarget] -> ShowS
SegmentTarget -> String
(Int -> SegmentTarget -> ShowS)
-> (SegmentTarget -> String)
-> ([SegmentTarget] -> ShowS)
-> Show SegmentTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SegmentTarget] -> ShowS
$cshowList :: [SegmentTarget] -> ShowS
show :: SegmentTarget -> String
$cshow :: SegmentTarget -> String
showsPrec :: Int -> SegmentTarget -> ShowS
$cshowsPrec :: Int -> SegmentTarget -> ShowS
Show, SegmentTarget -> SegmentTarget -> Bool
(SegmentTarget -> SegmentTarget -> Bool)
-> (SegmentTarget -> SegmentTarget -> Bool) -> Eq SegmentTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SegmentTarget -> SegmentTarget -> Bool
$c/= :: SegmentTarget -> SegmentTarget -> Bool
== :: SegmentTarget -> SegmentTarget -> Bool
$c== :: SegmentTarget -> SegmentTarget -> Bool
Eq)

data Clause = Clause
    { Clause -> Reference
attribute :: !Reference
    , Clause -> Text
contextKind :: !Text
    , Clause -> Bool
negate :: !Bool
    , Clause -> Op
op :: !Op
    , Clause -> [Value]
values :: ![Value]
    }
    deriving ((forall x. Clause -> Rep Clause x)
-> (forall x. Rep Clause x -> Clause) -> Generic Clause
forall x. Rep Clause x -> Clause
forall x. Clause -> Rep Clause x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Clause x -> Clause
$cfrom :: forall x. Clause -> Rep Clause x
Generic, [Clause] -> Encoding
[Clause] -> Value
Clause -> Encoding
Clause -> Value
(Clause -> Value)
-> (Clause -> Encoding)
-> ([Clause] -> Value)
-> ([Clause] -> Encoding)
-> ToJSON Clause
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Clause] -> Encoding
$ctoEncodingList :: [Clause] -> Encoding
toJSONList :: [Clause] -> Value
$ctoJSONList :: [Clause] -> Value
toEncoding :: Clause -> Encoding
$ctoEncoding :: Clause -> Encoding
toJSON :: Clause -> Value
$ctoJSON :: Clause -> Value
ToJSON, 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, Clause -> Clause -> Bool
(Clause -> Clause -> Bool)
-> (Clause -> Clause -> Bool) -> Eq Clause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Clause -> Clause -> Bool
$c/= :: Clause -> Clause -> Bool
== :: Clause -> Clause -> Bool
$c== :: Clause -> Clause -> Bool
Eq)

instance FromJSON Clause where
    parseJSON :: Value -> Parser Clause
parseJSON = String -> (Object -> Parser Clause) -> Value -> Parser Clause
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Clause" ((Object -> Parser Clause) -> Value -> Parser Clause)
-> (Object -> Parser Clause) -> Value -> Parser Clause
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Text
attr <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "attribute"
        Maybe Text
kind <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "contextKind"
        Bool
negate <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "negate"
        Op
op <- Object
o Object -> Text -> Parser Op
forall a. FromJSON a => Object -> Text -> Parser a
.: "op"
        [Value]
values <- Object
o Object -> Text -> Parser [Value]
forall a. FromJSON a => Object -> Text -> Parser a
.: "values"

        let contextKind :: Text
contextKind = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "user" Maybe Text
kind
            attribute :: Reference
attribute = case Maybe Text
kind of Nothing -> Text -> Reference
makeLiteral (Text
attr); _ -> Text -> Reference
makeReference (Text
attr)
        Clause -> Parser Clause
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> Parser Clause) -> Clause -> Parser Clause
forall a b. (a -> b) -> a -> b
$ $WClause :: Reference -> Text -> Bool -> Op -> [Value] -> Clause
Clause {..}