-- | User activities
module Calamity.Types.Model.Presence.Activity (
  Activity (..),
  activity,
  ActivityType (..),
  ActivityTimestamps (..),
  ActivityParty (..),
  ActivityAssets (..),
  ActivitySecrets (..),
) where

import Calamity.Internal.AesonThings
import Calamity.Internal.Utils
import Calamity.Types.Snowflake
import Calamity.Types.UnixTimestamp
import Control.DeepSeq (NFData)
import Data.Aeson
import Data.Scientific
import Data.Text.Lazy (Text)
import Data.Word
import GHC.Generics
import TextShow
import qualified TextShow.Generic as TSG

data ActivityType
  = Game
  | Streaming
  | Listening
  | Custom
  | Other Int
  deriving (ActivityType -> ActivityType -> Bool
(ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool) -> Eq ActivityType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityType -> ActivityType -> Bool
$c/= :: ActivityType -> ActivityType -> Bool
== :: ActivityType -> ActivityType -> Bool
$c== :: ActivityType -> ActivityType -> Bool
Eq, (forall x. ActivityType -> Rep ActivityType x)
-> (forall x. Rep ActivityType x -> ActivityType)
-> Generic ActivityType
forall x. Rep ActivityType x -> ActivityType
forall x. ActivityType -> Rep ActivityType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActivityType x -> ActivityType
$cfrom :: forall x. ActivityType -> Rep ActivityType x
Generic, Int -> ActivityType -> ShowS
[ActivityType] -> ShowS
ActivityType -> String
(Int -> ActivityType -> ShowS)
-> (ActivityType -> String)
-> ([ActivityType] -> ShowS)
-> Show ActivityType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityType] -> ShowS
$cshowList :: [ActivityType] -> ShowS
show :: ActivityType -> String
$cshow :: ActivityType -> String
showsPrec :: Int -> ActivityType -> ShowS
$cshowsPrec :: Int -> ActivityType -> ShowS
Show, ActivityType -> ()
(ActivityType -> ()) -> NFData ActivityType
forall a. (a -> ()) -> NFData a
rnf :: ActivityType -> ()
$crnf :: ActivityType -> ()
NFData)
  deriving (Int -> ActivityType -> Builder
Int -> ActivityType -> Text
Int -> ActivityType -> Text
[ActivityType] -> Builder
[ActivityType] -> Text
[ActivityType] -> Text
ActivityType -> Builder
ActivityType -> Text
ActivityType -> Text
(Int -> ActivityType -> Builder)
-> (ActivityType -> Builder)
-> ([ActivityType] -> Builder)
-> (Int -> ActivityType -> Text)
-> (ActivityType -> Text)
-> ([ActivityType] -> Text)
-> (Int -> ActivityType -> Text)
-> (ActivityType -> Text)
-> ([ActivityType] -> Text)
-> TextShow ActivityType
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [ActivityType] -> Text
$cshowtlList :: [ActivityType] -> Text
showtl :: ActivityType -> Text
$cshowtl :: ActivityType -> Text
showtlPrec :: Int -> ActivityType -> Text
$cshowtlPrec :: Int -> ActivityType -> Text
showtList :: [ActivityType] -> Text
$cshowtList :: [ActivityType] -> Text
showt :: ActivityType -> Text
$cshowt :: ActivityType -> Text
showtPrec :: Int -> ActivityType -> Text
$cshowtPrec :: Int -> ActivityType -> Text
showbList :: [ActivityType] -> Builder
$cshowbList :: [ActivityType] -> Builder
showb :: ActivityType -> Builder
$cshowb :: ActivityType -> Builder
showbPrec :: Int -> ActivityType -> Builder
$cshowbPrec :: Int -> ActivityType -> Builder
TextShow) via TSG.FromGeneric ActivityType

instance ToJSON ActivityType where
  toJSON :: ActivityType -> Value
toJSON ActivityType
Game = Scientific -> Value
Number Scientific
0
  toJSON ActivityType
Streaming = Scientific -> Value
Number Scientific
1
  toJSON ActivityType
Listening = Scientific -> Value
Number Scientific
2
  toJSON (Other Int
n) = Scientific -> Value
Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
  toJSON ActivityType
Custom = Scientific -> Value
Number Scientific
4

instance FromJSON ActivityType where
  parseJSON :: Value -> Parser ActivityType
parseJSON = String
-> (Scientific -> Parser ActivityType)
-> Value
-> Parser ActivityType
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"ActivityType" ((Scientific -> Parser ActivityType)
 -> Value -> Parser ActivityType)
-> (Scientific -> Parser ActivityType)
-> Value
-> Parser ActivityType
forall a b. (a -> b) -> a -> b
$ \Scientific
n -> case Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger @Int Scientific
n of
    Just !Int
v -> case Int
v of
      Int
0 -> ActivityType -> Parser ActivityType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
Game
      Int
1 -> ActivityType -> Parser ActivityType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
Streaming
      Int
2 -> ActivityType -> Parser ActivityType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
Listening
      Int
4 -> ActivityType -> Parser ActivityType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
Custom
      Int
n -> ActivityType -> Parser ActivityType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActivityType -> Parser ActivityType)
-> ActivityType -> Parser ActivityType
forall a b. (a -> b) -> a -> b
$ Int -> ActivityType
Other Int
n
    Maybe Int
Nothing -> String -> Parser ActivityType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ActivityType) -> String -> Parser ActivityType
forall a b. (a -> b) -> a -> b
$ String
"Invalid ActivityType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
n

data Activity = Activity
  { Activity -> Text
name :: Text
  , Activity -> ActivityType
type_ :: !ActivityType
  , Activity -> Maybe Text
url :: Maybe Text
  , Activity -> Maybe ActivityTimestamps
timestamps :: Maybe ActivityTimestamps
  , Activity -> Maybe (Snowflake ())
applicationID :: Maybe (Snowflake ())
  , Activity -> Maybe Text
details :: Maybe Text
  , Activity -> Maybe Text
state :: Maybe Text
  , Activity -> Maybe ActivityParty
party :: Maybe ActivityParty
  , Activity -> Maybe ActivityAssets
assets :: Maybe ActivityAssets
  , Activity -> Maybe ActivitySecrets
secrets :: Maybe ActivitySecrets
  , Activity -> Maybe Bool
instance_ :: Maybe Bool
  , Activity -> Maybe Word64
flags :: Maybe Word64
  }
  deriving (Activity -> Activity -> Bool
(Activity -> Activity -> Bool)
-> (Activity -> Activity -> Bool) -> Eq Activity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Activity -> Activity -> Bool
$c/= :: Activity -> Activity -> Bool
== :: Activity -> Activity -> Bool
$c== :: Activity -> Activity -> Bool
Eq, Int -> Activity -> ShowS
[Activity] -> ShowS
Activity -> String
(Int -> Activity -> ShowS)
-> (Activity -> String) -> ([Activity] -> ShowS) -> Show Activity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Activity] -> ShowS
$cshowList :: [Activity] -> ShowS
show :: Activity -> String
$cshow :: Activity -> String
showsPrec :: Int -> Activity -> ShowS
$cshowsPrec :: Int -> Activity -> ShowS
Show, (forall x. Activity -> Rep Activity x)
-> (forall x. Rep Activity x -> Activity) -> Generic Activity
forall x. Rep Activity x -> Activity
forall x. Activity -> Rep Activity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Activity x -> Activity
$cfrom :: forall x. Activity -> Rep Activity x
Generic, Activity -> ()
(Activity -> ()) -> NFData Activity
forall a. (a -> ()) -> NFData a
rnf :: Activity -> ()
$crnf :: Activity -> ()
NFData)
  deriving (Int -> Activity -> Builder
Int -> Activity -> Text
Int -> Activity -> Text
[Activity] -> Builder
[Activity] -> Text
[Activity] -> Text
Activity -> Builder
Activity -> Text
Activity -> Text
(Int -> Activity -> Builder)
-> (Activity -> Builder)
-> ([Activity] -> Builder)
-> (Int -> Activity -> Text)
-> (Activity -> Text)
-> ([Activity] -> Text)
-> (Int -> Activity -> Text)
-> (Activity -> Text)
-> ([Activity] -> Text)
-> TextShow Activity
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [Activity] -> Text
$cshowtlList :: [Activity] -> Text
showtl :: Activity -> Text
$cshowtl :: Activity -> Text
showtlPrec :: Int -> Activity -> Text
$cshowtlPrec :: Int -> Activity -> Text
showtList :: [Activity] -> Text
$cshowtList :: [Activity] -> Text
showt :: Activity -> Text
$cshowt :: Activity -> Text
showtPrec :: Int -> Activity -> Text
$cshowtPrec :: Int -> Activity -> Text
showbList :: [Activity] -> Builder
$cshowbList :: [Activity] -> Builder
showb :: Activity -> Builder
$cshowb :: Activity -> Builder
showbPrec :: Int -> Activity -> Builder
$cshowbPrec :: Int -> Activity -> Builder
TextShow) via TSG.FromGeneric Activity
  deriving ([Activity] -> Encoding
[Activity] -> Value
Activity -> Encoding
Activity -> Value
(Activity -> Value)
-> (Activity -> Encoding)
-> ([Activity] -> Value)
-> ([Activity] -> Encoding)
-> ToJSON Activity
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Activity] -> Encoding
$ctoEncodingList :: [Activity] -> Encoding
toJSONList :: [Activity] -> Value
$ctoJSONList :: [Activity] -> Value
toEncoding :: Activity -> Encoding
$ctoEncoding :: Activity -> Encoding
toJSON :: Activity -> Value
$ctoJSON :: Activity -> Value
ToJSON, Value -> Parser [Activity]
Value -> Parser Activity
(Value -> Parser Activity)
-> (Value -> Parser [Activity]) -> FromJSON Activity
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Activity]
$cparseJSONList :: Value -> Parser [Activity]
parseJSON :: Value -> Parser Activity
$cparseJSON :: Value -> Parser Activity
FromJSON) via CalamityJSON Activity

-- | Make an 'Activity' with all optional fields set to Nothing
activity :: Text -> ActivityType -> Activity
activity :: Text -> ActivityType -> Activity
activity !Text
name !ActivityType
type_ =
  Activity :: Text
-> ActivityType
-> Maybe Text
-> Maybe ActivityTimestamps
-> Maybe (Snowflake ())
-> Maybe Text
-> Maybe Text
-> Maybe ActivityParty
-> Maybe ActivityAssets
-> Maybe ActivitySecrets
-> Maybe Bool
-> Maybe Word64
-> Activity
Activity
    { $sel:name:Activity :: Text
name = Text
name
    , $sel:type_:Activity :: ActivityType
type_ = ActivityType
type_
    , $sel:url:Activity :: Maybe Text
url = Maybe Text
forall a. Maybe a
Nothing
    , $sel:timestamps:Activity :: Maybe ActivityTimestamps
timestamps = Maybe ActivityTimestamps
forall a. Maybe a
Nothing
    , $sel:applicationID:Activity :: Maybe (Snowflake ())
applicationID = Maybe (Snowflake ())
forall a. Maybe a
Nothing
    , $sel:details:Activity :: Maybe Text
details = Maybe Text
forall a. Maybe a
Nothing
    , $sel:state:Activity :: Maybe Text
state = Maybe Text
forall a. Maybe a
Nothing
    , $sel:party:Activity :: Maybe ActivityParty
party = Maybe ActivityParty
forall a. Maybe a
Nothing
    , $sel:assets:Activity :: Maybe ActivityAssets
assets = Maybe ActivityAssets
forall a. Maybe a
Nothing
    , $sel:secrets:Activity :: Maybe ActivitySecrets
secrets = Maybe ActivitySecrets
forall a. Maybe a
Nothing
    , $sel:instance_:Activity :: Maybe Bool
instance_ = Maybe Bool
forall a. Maybe a
Nothing
    , $sel:flags:Activity :: Maybe Word64
flags = Maybe Word64
forall a. Maybe a
Nothing
    }

data ActivityTimestamps = ActivityTimestamps
  { ActivityTimestamps -> Maybe UnixTimestamp
start :: !(Maybe UnixTimestamp)
  , ActivityTimestamps -> Maybe UnixTimestamp
end :: !(Maybe UnixTimestamp)
  }
  deriving (ActivityTimestamps -> ActivityTimestamps -> Bool
(ActivityTimestamps -> ActivityTimestamps -> Bool)
-> (ActivityTimestamps -> ActivityTimestamps -> Bool)
-> Eq ActivityTimestamps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityTimestamps -> ActivityTimestamps -> Bool
$c/= :: ActivityTimestamps -> ActivityTimestamps -> Bool
== :: ActivityTimestamps -> ActivityTimestamps -> Bool
$c== :: ActivityTimestamps -> ActivityTimestamps -> Bool
Eq, Int -> ActivityTimestamps -> ShowS
[ActivityTimestamps] -> ShowS
ActivityTimestamps -> String
(Int -> ActivityTimestamps -> ShowS)
-> (ActivityTimestamps -> String)
-> ([ActivityTimestamps] -> ShowS)
-> Show ActivityTimestamps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityTimestamps] -> ShowS
$cshowList :: [ActivityTimestamps] -> ShowS
show :: ActivityTimestamps -> String
$cshow :: ActivityTimestamps -> String
showsPrec :: Int -> ActivityTimestamps -> ShowS
$cshowsPrec :: Int -> ActivityTimestamps -> ShowS
Show, (forall x. ActivityTimestamps -> Rep ActivityTimestamps x)
-> (forall x. Rep ActivityTimestamps x -> ActivityTimestamps)
-> Generic ActivityTimestamps
forall x. Rep ActivityTimestamps x -> ActivityTimestamps
forall x. ActivityTimestamps -> Rep ActivityTimestamps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActivityTimestamps x -> ActivityTimestamps
$cfrom :: forall x. ActivityTimestamps -> Rep ActivityTimestamps x
Generic, ActivityTimestamps -> ()
(ActivityTimestamps -> ()) -> NFData ActivityTimestamps
forall a. (a -> ()) -> NFData a
rnf :: ActivityTimestamps -> ()
$crnf :: ActivityTimestamps -> ()
NFData)
  deriving (Int -> ActivityTimestamps -> Builder
Int -> ActivityTimestamps -> Text
Int -> ActivityTimestamps -> Text
[ActivityTimestamps] -> Builder
[ActivityTimestamps] -> Text
[ActivityTimestamps] -> Text
ActivityTimestamps -> Builder
ActivityTimestamps -> Text
ActivityTimestamps -> Text
(Int -> ActivityTimestamps -> Builder)
-> (ActivityTimestamps -> Builder)
-> ([ActivityTimestamps] -> Builder)
-> (Int -> ActivityTimestamps -> Text)
-> (ActivityTimestamps -> Text)
-> ([ActivityTimestamps] -> Text)
-> (Int -> ActivityTimestamps -> Text)
-> (ActivityTimestamps -> Text)
-> ([ActivityTimestamps] -> Text)
-> TextShow ActivityTimestamps
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [ActivityTimestamps] -> Text
$cshowtlList :: [ActivityTimestamps] -> Text
showtl :: ActivityTimestamps -> Text
$cshowtl :: ActivityTimestamps -> Text
showtlPrec :: Int -> ActivityTimestamps -> Text
$cshowtlPrec :: Int -> ActivityTimestamps -> Text
showtList :: [ActivityTimestamps] -> Text
$cshowtList :: [ActivityTimestamps] -> Text
showt :: ActivityTimestamps -> Text
$cshowt :: ActivityTimestamps -> Text
showtPrec :: Int -> ActivityTimestamps -> Text
$cshowtPrec :: Int -> ActivityTimestamps -> Text
showbList :: [ActivityTimestamps] -> Builder
$cshowbList :: [ActivityTimestamps] -> Builder
showb :: ActivityTimestamps -> Builder
$cshowb :: ActivityTimestamps -> Builder
showbPrec :: Int -> ActivityTimestamps -> Builder
$cshowbPrec :: Int -> ActivityTimestamps -> Builder
TextShow) via TSG.FromGeneric ActivityTimestamps

instance ToJSON ActivityTimestamps where
  toJSON :: ActivityTimestamps -> Value
toJSON ActivityTimestamps{Maybe UnixTimestamp
start :: Maybe UnixTimestamp
$sel:start:ActivityTimestamps :: ActivityTimestamps -> Maybe UnixTimestamp
start, Maybe UnixTimestamp
end :: Maybe UnixTimestamp
$sel:end:ActivityTimestamps :: ActivityTimestamps -> Maybe UnixTimestamp
end} =
    [Pair] -> Value
object
      [Text
"start" Text -> Maybe Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (UnixTimestamp -> Word64
unixToMilliseconds (UnixTimestamp -> Word64) -> Maybe UnixTimestamp -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UnixTimestamp
start), Text
"end" Text -> Maybe Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (UnixTimestamp -> Word64
unixToMilliseconds (UnixTimestamp -> Word64) -> Maybe UnixTimestamp -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UnixTimestamp
end)]

instance FromJSON ActivityTimestamps where
  parseJSON :: Value -> Parser ActivityTimestamps
parseJSON = String
-> (Object -> Parser ActivityTimestamps)
-> Value
-> Parser ActivityTimestamps
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ActivityTimestamps" ((Object -> Parser ActivityTimestamps)
 -> Value -> Parser ActivityTimestamps)
-> (Object -> Parser ActivityTimestamps)
-> Value
-> Parser ActivityTimestamps
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Maybe UnixTimestamp
start <- Word64 -> UnixTimestamp
millisecondsToUnix (Word64 -> UnixTimestamp)
-> Parser (Maybe Word64) -> Parser (Maybe UnixTimestamp)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> Object
v Object -> Text -> Parser (Maybe Word64)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"start"
    Maybe UnixTimestamp
end <- Word64 -> UnixTimestamp
millisecondsToUnix (Word64 -> UnixTimestamp)
-> Parser (Maybe Word64) -> Parser (Maybe UnixTimestamp)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> Object
v Object -> Text -> Parser (Maybe Word64)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"end"

    ActivityTimestamps -> Parser ActivityTimestamps
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActivityTimestamps -> Parser ActivityTimestamps)
-> ActivityTimestamps -> Parser ActivityTimestamps
forall a b. (a -> b) -> a -> b
$ Maybe UnixTimestamp -> Maybe UnixTimestamp -> ActivityTimestamps
ActivityTimestamps Maybe UnixTimestamp
start Maybe UnixTimestamp
end

data ActivityParty = ActivityParty
  { ActivityParty -> Maybe Text
id :: Maybe Text
  , ActivityParty -> Maybe (Int, Int)
size :: Maybe (Int, Int)
  }
  deriving (ActivityParty -> ActivityParty -> Bool
(ActivityParty -> ActivityParty -> Bool)
-> (ActivityParty -> ActivityParty -> Bool) -> Eq ActivityParty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityParty -> ActivityParty -> Bool
$c/= :: ActivityParty -> ActivityParty -> Bool
== :: ActivityParty -> ActivityParty -> Bool
$c== :: ActivityParty -> ActivityParty -> Bool
Eq, Int -> ActivityParty -> ShowS
[ActivityParty] -> ShowS
ActivityParty -> String
(Int -> ActivityParty -> ShowS)
-> (ActivityParty -> String)
-> ([ActivityParty] -> ShowS)
-> Show ActivityParty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityParty] -> ShowS
$cshowList :: [ActivityParty] -> ShowS
show :: ActivityParty -> String
$cshow :: ActivityParty -> String
showsPrec :: Int -> ActivityParty -> ShowS
$cshowsPrec :: Int -> ActivityParty -> ShowS
Show, (forall x. ActivityParty -> Rep ActivityParty x)
-> (forall x. Rep ActivityParty x -> ActivityParty)
-> Generic ActivityParty
forall x. Rep ActivityParty x -> ActivityParty
forall x. ActivityParty -> Rep ActivityParty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActivityParty x -> ActivityParty
$cfrom :: forall x. ActivityParty -> Rep ActivityParty x
Generic, ActivityParty -> ()
(ActivityParty -> ()) -> NFData ActivityParty
forall a. (a -> ()) -> NFData a
rnf :: ActivityParty -> ()
$crnf :: ActivityParty -> ()
NFData)
  deriving (Int -> ActivityParty -> Builder
Int -> ActivityParty -> Text
Int -> ActivityParty -> Text
[ActivityParty] -> Builder
[ActivityParty] -> Text
[ActivityParty] -> Text
ActivityParty -> Builder
ActivityParty -> Text
ActivityParty -> Text
(Int -> ActivityParty -> Builder)
-> (ActivityParty -> Builder)
-> ([ActivityParty] -> Builder)
-> (Int -> ActivityParty -> Text)
-> (ActivityParty -> Text)
-> ([ActivityParty] -> Text)
-> (Int -> ActivityParty -> Text)
-> (ActivityParty -> Text)
-> ([ActivityParty] -> Text)
-> TextShow ActivityParty
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [ActivityParty] -> Text
$cshowtlList :: [ActivityParty] -> Text
showtl :: ActivityParty -> Text
$cshowtl :: ActivityParty -> Text
showtlPrec :: Int -> ActivityParty -> Text
$cshowtlPrec :: Int -> ActivityParty -> Text
showtList :: [ActivityParty] -> Text
$cshowtList :: [ActivityParty] -> Text
showt :: ActivityParty -> Text
$cshowt :: ActivityParty -> Text
showtPrec :: Int -> ActivityParty -> Text
$cshowtPrec :: Int -> ActivityParty -> Text
showbList :: [ActivityParty] -> Builder
$cshowbList :: [ActivityParty] -> Builder
showb :: ActivityParty -> Builder
$cshowb :: ActivityParty -> Builder
showbPrec :: Int -> ActivityParty -> Builder
$cshowbPrec :: Int -> ActivityParty -> Builder
TextShow) via TSG.FromGeneric ActivityParty
  deriving ([ActivityParty] -> Encoding
[ActivityParty] -> Value
ActivityParty -> Encoding
ActivityParty -> Value
(ActivityParty -> Value)
-> (ActivityParty -> Encoding)
-> ([ActivityParty] -> Value)
-> ([ActivityParty] -> Encoding)
-> ToJSON ActivityParty
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ActivityParty] -> Encoding
$ctoEncodingList :: [ActivityParty] -> Encoding
toJSONList :: [ActivityParty] -> Value
$ctoJSONList :: [ActivityParty] -> Value
toEncoding :: ActivityParty -> Encoding
$ctoEncoding :: ActivityParty -> Encoding
toJSON :: ActivityParty -> Value
$ctoJSON :: ActivityParty -> Value
ToJSON, Value -> Parser [ActivityParty]
Value -> Parser ActivityParty
(Value -> Parser ActivityParty)
-> (Value -> Parser [ActivityParty]) -> FromJSON ActivityParty
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ActivityParty]
$cparseJSONList :: Value -> Parser [ActivityParty]
parseJSON :: Value -> Parser ActivityParty
$cparseJSON :: Value -> Parser ActivityParty
FromJSON) via CalamityJSON ActivityParty

data ActivityAssets = ActivityAssets
  { ActivityAssets -> Maybe Text
largeImage :: Maybe Text
  , ActivityAssets -> Maybe Text
largeText :: Maybe Text
  , ActivityAssets -> Maybe Text
smallImage :: Maybe Text
  , ActivityAssets -> Maybe Text
smallText :: Maybe Text
  }
  deriving (ActivityAssets -> ActivityAssets -> Bool
(ActivityAssets -> ActivityAssets -> Bool)
-> (ActivityAssets -> ActivityAssets -> Bool) -> Eq ActivityAssets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityAssets -> ActivityAssets -> Bool
$c/= :: ActivityAssets -> ActivityAssets -> Bool
== :: ActivityAssets -> ActivityAssets -> Bool
$c== :: ActivityAssets -> ActivityAssets -> Bool
Eq, Int -> ActivityAssets -> ShowS
[ActivityAssets] -> ShowS
ActivityAssets -> String
(Int -> ActivityAssets -> ShowS)
-> (ActivityAssets -> String)
-> ([ActivityAssets] -> ShowS)
-> Show ActivityAssets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityAssets] -> ShowS
$cshowList :: [ActivityAssets] -> ShowS
show :: ActivityAssets -> String
$cshow :: ActivityAssets -> String
showsPrec :: Int -> ActivityAssets -> ShowS
$cshowsPrec :: Int -> ActivityAssets -> ShowS
Show, (forall x. ActivityAssets -> Rep ActivityAssets x)
-> (forall x. Rep ActivityAssets x -> ActivityAssets)
-> Generic ActivityAssets
forall x. Rep ActivityAssets x -> ActivityAssets
forall x. ActivityAssets -> Rep ActivityAssets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActivityAssets x -> ActivityAssets
$cfrom :: forall x. ActivityAssets -> Rep ActivityAssets x
Generic, ActivityAssets -> ()
(ActivityAssets -> ()) -> NFData ActivityAssets
forall a. (a -> ()) -> NFData a
rnf :: ActivityAssets -> ()
$crnf :: ActivityAssets -> ()
NFData)
  deriving (Int -> ActivityAssets -> Builder
Int -> ActivityAssets -> Text
Int -> ActivityAssets -> Text
[ActivityAssets] -> Builder
[ActivityAssets] -> Text
[ActivityAssets] -> Text
ActivityAssets -> Builder
ActivityAssets -> Text
ActivityAssets -> Text
(Int -> ActivityAssets -> Builder)
-> (ActivityAssets -> Builder)
-> ([ActivityAssets] -> Builder)
-> (Int -> ActivityAssets -> Text)
-> (ActivityAssets -> Text)
-> ([ActivityAssets] -> Text)
-> (Int -> ActivityAssets -> Text)
-> (ActivityAssets -> Text)
-> ([ActivityAssets] -> Text)
-> TextShow ActivityAssets
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [ActivityAssets] -> Text
$cshowtlList :: [ActivityAssets] -> Text
showtl :: ActivityAssets -> Text
$cshowtl :: ActivityAssets -> Text
showtlPrec :: Int -> ActivityAssets -> Text
$cshowtlPrec :: Int -> ActivityAssets -> Text
showtList :: [ActivityAssets] -> Text
$cshowtList :: [ActivityAssets] -> Text
showt :: ActivityAssets -> Text
$cshowt :: ActivityAssets -> Text
showtPrec :: Int -> ActivityAssets -> Text
$cshowtPrec :: Int -> ActivityAssets -> Text
showbList :: [ActivityAssets] -> Builder
$cshowbList :: [ActivityAssets] -> Builder
showb :: ActivityAssets -> Builder
$cshowb :: ActivityAssets -> Builder
showbPrec :: Int -> ActivityAssets -> Builder
$cshowbPrec :: Int -> ActivityAssets -> Builder
TextShow) via TSG.FromGeneric ActivityAssets
  deriving ([ActivityAssets] -> Encoding
[ActivityAssets] -> Value
ActivityAssets -> Encoding
ActivityAssets -> Value
(ActivityAssets -> Value)
-> (ActivityAssets -> Encoding)
-> ([ActivityAssets] -> Value)
-> ([ActivityAssets] -> Encoding)
-> ToJSON ActivityAssets
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ActivityAssets] -> Encoding
$ctoEncodingList :: [ActivityAssets] -> Encoding
toJSONList :: [ActivityAssets] -> Value
$ctoJSONList :: [ActivityAssets] -> Value
toEncoding :: ActivityAssets -> Encoding
$ctoEncoding :: ActivityAssets -> Encoding
toJSON :: ActivityAssets -> Value
$ctoJSON :: ActivityAssets -> Value
ToJSON, Value -> Parser [ActivityAssets]
Value -> Parser ActivityAssets
(Value -> Parser ActivityAssets)
-> (Value -> Parser [ActivityAssets]) -> FromJSON ActivityAssets
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ActivityAssets]
$cparseJSONList :: Value -> Parser [ActivityAssets]
parseJSON :: Value -> Parser ActivityAssets
$cparseJSON :: Value -> Parser ActivityAssets
FromJSON) via CalamityJSON ActivityAssets

data ActivitySecrets = ActivitySecrets
  { ActivitySecrets -> Maybe Text
join :: Maybe Text
  , ActivitySecrets -> Maybe Text
spectate :: Maybe Text
  , ActivitySecrets -> Maybe Text
match :: Maybe Text
  }
  deriving (ActivitySecrets -> ActivitySecrets -> Bool
(ActivitySecrets -> ActivitySecrets -> Bool)
-> (ActivitySecrets -> ActivitySecrets -> Bool)
-> Eq ActivitySecrets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivitySecrets -> ActivitySecrets -> Bool
$c/= :: ActivitySecrets -> ActivitySecrets -> Bool
== :: ActivitySecrets -> ActivitySecrets -> Bool
$c== :: ActivitySecrets -> ActivitySecrets -> Bool
Eq, Int -> ActivitySecrets -> ShowS
[ActivitySecrets] -> ShowS
ActivitySecrets -> String
(Int -> ActivitySecrets -> ShowS)
-> (ActivitySecrets -> String)
-> ([ActivitySecrets] -> ShowS)
-> Show ActivitySecrets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivitySecrets] -> ShowS
$cshowList :: [ActivitySecrets] -> ShowS
show :: ActivitySecrets -> String
$cshow :: ActivitySecrets -> String
showsPrec :: Int -> ActivitySecrets -> ShowS
$cshowsPrec :: Int -> ActivitySecrets -> ShowS
Show, (forall x. ActivitySecrets -> Rep ActivitySecrets x)
-> (forall x. Rep ActivitySecrets x -> ActivitySecrets)
-> Generic ActivitySecrets
forall x. Rep ActivitySecrets x -> ActivitySecrets
forall x. ActivitySecrets -> Rep ActivitySecrets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActivitySecrets x -> ActivitySecrets
$cfrom :: forall x. ActivitySecrets -> Rep ActivitySecrets x
Generic, ActivitySecrets -> ()
(ActivitySecrets -> ()) -> NFData ActivitySecrets
forall a. (a -> ()) -> NFData a
rnf :: ActivitySecrets -> ()
$crnf :: ActivitySecrets -> ()
NFData)
  deriving (Int -> ActivitySecrets -> Builder
Int -> ActivitySecrets -> Text
Int -> ActivitySecrets -> Text
[ActivitySecrets] -> Builder
[ActivitySecrets] -> Text
[ActivitySecrets] -> Text
ActivitySecrets -> Builder
ActivitySecrets -> Text
ActivitySecrets -> Text
(Int -> ActivitySecrets -> Builder)
-> (ActivitySecrets -> Builder)
-> ([ActivitySecrets] -> Builder)
-> (Int -> ActivitySecrets -> Text)
-> (ActivitySecrets -> Text)
-> ([ActivitySecrets] -> Text)
-> (Int -> ActivitySecrets -> Text)
-> (ActivitySecrets -> Text)
-> ([ActivitySecrets] -> Text)
-> TextShow ActivitySecrets
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [ActivitySecrets] -> Text
$cshowtlList :: [ActivitySecrets] -> Text
showtl :: ActivitySecrets -> Text
$cshowtl :: ActivitySecrets -> Text
showtlPrec :: Int -> ActivitySecrets -> Text
$cshowtlPrec :: Int -> ActivitySecrets -> Text
showtList :: [ActivitySecrets] -> Text
$cshowtList :: [ActivitySecrets] -> Text
showt :: ActivitySecrets -> Text
$cshowt :: ActivitySecrets -> Text
showtPrec :: Int -> ActivitySecrets -> Text
$cshowtPrec :: Int -> ActivitySecrets -> Text
showbList :: [ActivitySecrets] -> Builder
$cshowbList :: [ActivitySecrets] -> Builder
showb :: ActivitySecrets -> Builder
$cshowb :: ActivitySecrets -> Builder
showbPrec :: Int -> ActivitySecrets -> Builder
$cshowbPrec :: Int -> ActivitySecrets -> Builder
TextShow) via TSG.FromGeneric ActivitySecrets
  deriving ([ActivitySecrets] -> Encoding
[ActivitySecrets] -> Value
ActivitySecrets -> Encoding
ActivitySecrets -> Value
(ActivitySecrets -> Value)
-> (ActivitySecrets -> Encoding)
-> ([ActivitySecrets] -> Value)
-> ([ActivitySecrets] -> Encoding)
-> ToJSON ActivitySecrets
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ActivitySecrets] -> Encoding
$ctoEncodingList :: [ActivitySecrets] -> Encoding
toJSONList :: [ActivitySecrets] -> Value
$ctoJSONList :: [ActivitySecrets] -> Value
toEncoding :: ActivitySecrets -> Encoding
$ctoEncoding :: ActivitySecrets -> Encoding
toJSON :: ActivitySecrets -> Value
$ctoJSON :: ActivitySecrets -> Value
ToJSON, Value -> Parser [ActivitySecrets]
Value -> Parser ActivitySecrets
(Value -> Parser ActivitySecrets)
-> (Value -> Parser [ActivitySecrets]) -> FromJSON ActivitySecrets
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ActivitySecrets]
$cparseJSONList :: Value -> Parser [ActivitySecrets]
parseJSON :: Value -> Parser ActivitySecrets
$cparseJSON :: Value -> Parser ActivitySecrets
FromJSON) via CalamityJSON ActivitySecrets