-- | Voice channels
module Calamity.Types.Model.Channel.Guild.Voice (VoiceChannel (..)) where

import Calamity.Internal.AesonThings
import Calamity.Internal.SnowflakeMap (SnowflakeMap)
import Calamity.Internal.Utils ()
import {-# SOURCE #-} Calamity.Types.Model.Channel
import {-# SOURCE #-} Calamity.Types.Model.Channel.Guild.Category
import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild
import Calamity.Types.Model.Guild.Overwrite
import Calamity.Types.Snowflake
import Control.DeepSeq (NFData)
import Data.Aeson
import Data.Text.Lazy (Text)
import GHC.Generics
import TextShow
import qualified TextShow.Generic as TSG

data VoiceChannel = VoiceChannel
  { VoiceChannel -> Snowflake VoiceChannel
id :: Snowflake VoiceChannel
  , VoiceChannel -> Snowflake Guild
guildID :: Snowflake Guild
  , VoiceChannel -> Int
position :: Int
  , VoiceChannel -> SnowflakeMap Overwrite
permissionOverwrites :: SnowflakeMap Overwrite
  , VoiceChannel -> Text
name :: Text
  , VoiceChannel -> Int
bitrate :: Int
  , VoiceChannel -> Int
userLimit :: Int
  , VoiceChannel -> Maybe (Snowflake Category)
parentID :: Maybe (Snowflake Category)
  }
  deriving (Int -> VoiceChannel -> ShowS
[VoiceChannel] -> ShowS
VoiceChannel -> String
(Int -> VoiceChannel -> ShowS)
-> (VoiceChannel -> String)
-> ([VoiceChannel] -> ShowS)
-> Show VoiceChannel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VoiceChannel] -> ShowS
$cshowList :: [VoiceChannel] -> ShowS
show :: VoiceChannel -> String
$cshow :: VoiceChannel -> String
showsPrec :: Int -> VoiceChannel -> ShowS
$cshowsPrec :: Int -> VoiceChannel -> ShowS
Show, VoiceChannel -> VoiceChannel -> Bool
(VoiceChannel -> VoiceChannel -> Bool)
-> (VoiceChannel -> VoiceChannel -> Bool) -> Eq VoiceChannel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VoiceChannel -> VoiceChannel -> Bool
$c/= :: VoiceChannel -> VoiceChannel -> Bool
== :: VoiceChannel -> VoiceChannel -> Bool
$c== :: VoiceChannel -> VoiceChannel -> Bool
Eq, (forall x. VoiceChannel -> Rep VoiceChannel x)
-> (forall x. Rep VoiceChannel x -> VoiceChannel)
-> Generic VoiceChannel
forall x. Rep VoiceChannel x -> VoiceChannel
forall x. VoiceChannel -> Rep VoiceChannel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VoiceChannel x -> VoiceChannel
$cfrom :: forall x. VoiceChannel -> Rep VoiceChannel x
Generic, VoiceChannel -> ()
(VoiceChannel -> ()) -> NFData VoiceChannel
forall a. (a -> ()) -> NFData a
rnf :: VoiceChannel -> ()
$crnf :: VoiceChannel -> ()
NFData)
  deriving (Int -> VoiceChannel -> Builder
Int -> VoiceChannel -> Text
Int -> VoiceChannel -> Text
[VoiceChannel] -> Builder
[VoiceChannel] -> Text
[VoiceChannel] -> Text
VoiceChannel -> Builder
VoiceChannel -> Text
VoiceChannel -> Text
(Int -> VoiceChannel -> Builder)
-> (VoiceChannel -> Builder)
-> ([VoiceChannel] -> Builder)
-> (Int -> VoiceChannel -> Text)
-> (VoiceChannel -> Text)
-> ([VoiceChannel] -> Text)
-> (Int -> VoiceChannel -> Text)
-> (VoiceChannel -> Text)
-> ([VoiceChannel] -> Text)
-> TextShow VoiceChannel
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 :: [VoiceChannel] -> Text
$cshowtlList :: [VoiceChannel] -> Text
showtl :: VoiceChannel -> Text
$cshowtl :: VoiceChannel -> Text
showtlPrec :: Int -> VoiceChannel -> Text
$cshowtlPrec :: Int -> VoiceChannel -> Text
showtList :: [VoiceChannel] -> Text
$cshowtList :: [VoiceChannel] -> Text
showt :: VoiceChannel -> Text
$cshowt :: VoiceChannel -> Text
showtPrec :: Int -> VoiceChannel -> Text
$cshowtPrec :: Int -> VoiceChannel -> Text
showbList :: [VoiceChannel] -> Builder
$cshowbList :: [VoiceChannel] -> Builder
showb :: VoiceChannel -> Builder
$cshowb :: VoiceChannel -> Builder
showbPrec :: Int -> VoiceChannel -> Builder
$cshowbPrec :: Int -> VoiceChannel -> Builder
TextShow) via TSG.FromGeneric VoiceChannel
  deriving ([VoiceChannel] -> Encoding
[VoiceChannel] -> Value
VoiceChannel -> Encoding
VoiceChannel -> Value
(VoiceChannel -> Value)
-> (VoiceChannel -> Encoding)
-> ([VoiceChannel] -> Value)
-> ([VoiceChannel] -> Encoding)
-> ToJSON VoiceChannel
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VoiceChannel] -> Encoding
$ctoEncodingList :: [VoiceChannel] -> Encoding
toJSONList :: [VoiceChannel] -> Value
$ctoJSONList :: [VoiceChannel] -> Value
toEncoding :: VoiceChannel -> Encoding
$ctoEncoding :: VoiceChannel -> Encoding
toJSON :: VoiceChannel -> Value
$ctoJSON :: VoiceChannel -> Value
ToJSON, Value -> Parser [VoiceChannel]
Value -> Parser VoiceChannel
(Value -> Parser VoiceChannel)
-> (Value -> Parser [VoiceChannel]) -> FromJSON VoiceChannel
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [VoiceChannel]
$cparseJSONList :: Value -> Parser [VoiceChannel]
parseJSON :: Value -> Parser VoiceChannel
$cparseJSON :: Value -> Parser VoiceChannel
FromJSON) via CalamityJSON VoiceChannel
  deriving (HasID VoiceChannel) via HasIDField "id" VoiceChannel
  deriving (HasID Channel) via HasIDFieldCoerce' "id" VoiceChannel
  deriving (HasID Guild) via HasIDField "guildID" VoiceChannel