{-# LANGUAGE TemplateHaskell #-}

module Calamity.Types.Model.Voice.VoiceState (VoiceState (..)) where

import Calamity.Internal.Utils
import Calamity.Types.Model.Channel.Guild.Voice
import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild
import Calamity.Types.Model.User
import Calamity.Types.Snowflake
import Data.Aeson ((.:), (.:?))
import qualified Data.Aeson as Aeson
import Data.Text (Text)
import Optics.TH
import TextShow.TH

data VoiceState = VoiceState
  { VoiceState -> Maybe (Snowflake Guild)
guildID :: Maybe (Snowflake Guild)
  , VoiceState -> Maybe (Snowflake VoiceChannel)
channelID :: Maybe (Snowflake VoiceChannel)
  , VoiceState -> Snowflake User
userID :: Snowflake User
  , VoiceState -> Text
sessionID :: Text
  , VoiceState -> Bool
deaf :: Bool
  , VoiceState -> Bool
mute :: Bool
  , VoiceState -> Bool
selfDeaf :: Bool
  , VoiceState -> Bool
selfMute :: Bool
  , VoiceState -> Bool
suppress :: Bool
  }
  deriving (Int -> VoiceState -> ShowS
[VoiceState] -> ShowS
VoiceState -> String
(Int -> VoiceState -> ShowS)
-> (VoiceState -> String)
-> ([VoiceState] -> ShowS)
-> Show VoiceState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VoiceState] -> ShowS
$cshowList :: [VoiceState] -> ShowS
show :: VoiceState -> String
$cshow :: VoiceState -> String
showsPrec :: Int -> VoiceState -> ShowS
$cshowsPrec :: Int -> VoiceState -> ShowS
Show, VoiceState -> VoiceState -> Bool
(VoiceState -> VoiceState -> Bool)
-> (VoiceState -> VoiceState -> Bool) -> Eq VoiceState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VoiceState -> VoiceState -> Bool
$c/= :: VoiceState -> VoiceState -> Bool
== :: VoiceState -> VoiceState -> Bool
$c== :: VoiceState -> VoiceState -> Bool
Eq)
  deriving ([VoiceState] -> Encoding
[VoiceState] -> Value
VoiceState -> Encoding
VoiceState -> Value
(VoiceState -> Value)
-> (VoiceState -> Encoding)
-> ([VoiceState] -> Value)
-> ([VoiceState] -> Encoding)
-> ToJSON VoiceState
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VoiceState] -> Encoding
$ctoEncodingList :: [VoiceState] -> Encoding
toJSONList :: [VoiceState] -> Value
$ctoJSONList :: [VoiceState] -> Value
toEncoding :: VoiceState -> Encoding
$ctoEncoding :: VoiceState -> Encoding
toJSON :: VoiceState -> Value
$ctoJSON :: VoiceState -> Value
Aeson.ToJSON) via CalamityToJSON VoiceState

instance CalamityToJSON' VoiceState where
  toPairs :: forall kv. KeyValue kv => VoiceState -> [Maybe kv]
toPairs VoiceState {Bool
Maybe (Snowflake Guild)
Maybe (Snowflake VoiceChannel)
Text
Snowflake User
suppress :: Bool
selfMute :: Bool
selfDeaf :: Bool
mute :: Bool
deaf :: Bool
sessionID :: Text
userID :: Snowflake User
channelID :: Maybe (Snowflake VoiceChannel)
guildID :: Maybe (Snowflake Guild)
$sel:suppress:VoiceState :: VoiceState -> Bool
$sel:selfMute:VoiceState :: VoiceState -> Bool
$sel:selfDeaf:VoiceState :: VoiceState -> Bool
$sel:mute:VoiceState :: VoiceState -> Bool
$sel:deaf:VoiceState :: VoiceState -> Bool
$sel:sessionID:VoiceState :: VoiceState -> Text
$sel:userID:VoiceState :: VoiceState -> Snowflake User
$sel:channelID:VoiceState :: VoiceState -> Maybe (Snowflake VoiceChannel)
$sel:guildID:VoiceState :: VoiceState -> Maybe (Snowflake Guild)
..} =
    [ Key
"guild_id" Key -> Maybe (Snowflake Guild) -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Maybe (Snowflake Guild)
guildID
    , Key
"channel_id" Key -> Maybe (Snowflake VoiceChannel) -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Maybe (Snowflake VoiceChannel)
channelID
    , Key
"user_id" Key -> Snowflake User -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Snowflake User
userID
    , Key
"session_id" Key -> Text -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Text
sessionID
    , Key
"deaf" Key -> Bool -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Bool
deaf
    , Key
"mute" Key -> Bool -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Bool
mute
    , Key
"self_deaf" Key -> Bool -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Bool
selfDeaf
    , Key
"self_mute" Key -> Bool -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Bool
selfMute
    , Key
"suppress" Key -> Bool -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Bool
suppress
    ]

instance Aeson.FromJSON VoiceState where
  parseJSON :: Value -> Parser VoiceState
parseJSON = String
-> (Object -> Parser VoiceState) -> Value -> Parser VoiceState
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"VoiceState" ((Object -> Parser VoiceState) -> Value -> Parser VoiceState)
-> (Object -> Parser VoiceState) -> Value -> Parser VoiceState
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Maybe (Snowflake Guild)
-> Maybe (Snowflake VoiceChannel)
-> Snowflake User
-> Text
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> VoiceState
VoiceState
      (Maybe (Snowflake Guild)
 -> Maybe (Snowflake VoiceChannel)
 -> Snowflake User
 -> Text
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> VoiceState)
-> Parser (Maybe (Snowflake Guild))
-> Parser
     (Maybe (Snowflake VoiceChannel)
      -> Snowflake User
      -> Text
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> VoiceState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe (Snowflake Guild))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild_id"
      Parser
  (Maybe (Snowflake VoiceChannel)
   -> Snowflake User
   -> Text
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> VoiceState)
-> Parser (Maybe (Snowflake VoiceChannel))
-> Parser
     (Snowflake User
      -> Text -> Bool -> Bool -> Bool -> Bool -> Bool -> VoiceState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Snowflake VoiceChannel))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channel_id"
      Parser
  (Snowflake User
   -> Text -> Bool -> Bool -> Bool -> Bool -> Bool -> VoiceState)
-> Parser (Snowflake User)
-> Parser
     (Text -> Bool -> Bool -> Bool -> Bool -> Bool -> VoiceState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Snowflake User)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
      Parser (Text -> Bool -> Bool -> Bool -> Bool -> Bool -> VoiceState)
-> Parser Text
-> Parser (Bool -> Bool -> Bool -> Bool -> Bool -> VoiceState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"session_id"
      Parser (Bool -> Bool -> Bool -> Bool -> Bool -> VoiceState)
-> Parser Bool
-> Parser (Bool -> Bool -> Bool -> Bool -> VoiceState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deaf"
      Parser (Bool -> Bool -> Bool -> Bool -> VoiceState)
-> Parser Bool -> Parser (Bool -> Bool -> Bool -> VoiceState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mute"
      Parser (Bool -> Bool -> Bool -> VoiceState)
-> Parser Bool -> Parser (Bool -> Bool -> VoiceState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"self_deaf"
      Parser (Bool -> Bool -> VoiceState)
-> Parser Bool -> Parser (Bool -> VoiceState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"self_mute"
      Parser (Bool -> VoiceState) -> Parser Bool -> Parser VoiceState
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"suppress"

$(deriveTextShow ''VoiceState)
$(makeFieldLabelsNoPrefix ''VoiceState)