{-# LANGUAGE TemplateHaskell #-}

module Calamity.Types.Model.Channel.Guild.Text (TextChannel (..)) where

import Calamity.Internal.SnowflakeMap (SnowflakeMap)
import {-# SOURCE #-} Calamity.Types.Model.Channel
import Calamity.Types.Model.Channel.Guild.Category
import Calamity.Types.Model.Channel.Message
import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild
import Calamity.Types.Model.Guild.Overwrite
import Calamity.Types.Snowflake
import Data.Aeson ((.!=), (.:), (.:?))
import qualified Data.Aeson as Aeson
import Data.Text (Text)
import Data.Time
import Optics.TH
import qualified TextShow

data TextChannel = TextChannel
  { TextChannel -> Snowflake TextChannel
id :: Snowflake TextChannel
  , TextChannel -> Snowflake Guild
guildID :: Snowflake Guild
  , TextChannel -> Int
position :: Int
  , TextChannel -> SnowflakeMap Overwrite
permissionOverwrites :: SnowflakeMap Overwrite
  , TextChannel -> Text
name :: Text
  , TextChannel -> Maybe Text
topic :: Maybe Text
  , TextChannel -> Bool
nsfw :: Bool
  , TextChannel -> Maybe (Snowflake Message)
lastMessageID :: Maybe (Snowflake Message)
  , TextChannel -> Maybe UTCTime
lastPinTimestamp :: Maybe UTCTime
  , TextChannel -> Maybe Int
rateLimitPerUser :: Maybe Int
  , TextChannel -> Maybe (Snowflake Category)
parentID :: Maybe (Snowflake Category)
  }
  deriving (Int -> TextChannel -> ShowS
[TextChannel] -> ShowS
TextChannel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextChannel] -> ShowS
$cshowList :: [TextChannel] -> ShowS
show :: TextChannel -> String
$cshow :: TextChannel -> String
showsPrec :: Int -> TextChannel -> ShowS
$cshowsPrec :: Int -> TextChannel -> ShowS
Show, TextChannel -> TextChannel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextChannel -> TextChannel -> Bool
$c/= :: TextChannel -> TextChannel -> Bool
== :: TextChannel -> TextChannel -> Bool
$c== :: TextChannel -> TextChannel -> Bool
Eq)
  deriving (Int -> TextChannel -> Builder
Int -> TextChannel -> Text
Int -> TextChannel -> Text
[TextChannel] -> Builder
[TextChannel] -> Text
[TextChannel] -> Text
TextChannel -> Builder
TextChannel -> Text
TextChannel -> Text
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 :: [TextChannel] -> Text
$cshowtlList :: [TextChannel] -> Text
showtl :: TextChannel -> Text
$cshowtl :: TextChannel -> Text
showtlPrec :: Int -> TextChannel -> Text
$cshowtlPrec :: Int -> TextChannel -> Text
showtList :: [TextChannel] -> Text
$cshowtList :: [TextChannel] -> Text
showt :: TextChannel -> Text
$cshowt :: TextChannel -> Text
showtPrec :: Int -> TextChannel -> Text
$cshowtPrec :: Int -> TextChannel -> Text
showbList :: [TextChannel] -> Builder
$cshowbList :: [TextChannel] -> Builder
showb :: TextChannel -> Builder
$cshowb :: TextChannel -> Builder
showbPrec :: Int -> TextChannel -> Builder
$cshowbPrec :: Int -> TextChannel -> Builder
TextShow.TextShow) via TextShow.FromStringShow TextChannel
  deriving (HasID TextChannel) via HasIDField "id" TextChannel
  deriving (HasID Channel) via HasIDFieldCoerce' "id" TextChannel
  deriving (HasID Guild) via HasIDField "guildID" TextChannel

instance Aeson.FromJSON TextChannel where
  parseJSON :: Value -> Parser TextChannel
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"TextChannel" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Snowflake TextChannel
-> Snowflake Guild
-> Int
-> SnowflakeMap Overwrite
-> Text
-> Maybe Text
-> Bool
-> Maybe (Snowflake Message)
-> Maybe UTCTime
-> Maybe Int
-> Maybe (Snowflake Category)
-> TextChannel
TextChannel
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"position"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"permission_overwrites"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"topic"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"nsfw" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"last_message_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"last_pin_timestamp"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rate_limit_per_user"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parent_id"

$(makeFieldLabelsNoPrefix ''TextChannel)