{-# LANGUAGE TemplateHaskell #-}

module Calamity.Types.Model.Channel.Guild.Category (Category (..)) where

import Calamity.Internal.SnowflakeMap (SnowflakeMap)
import {-# SOURCE #-} Calamity.Types.Model.Channel
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 Optics.TH
import TextShow.TH

data Category = Category
  { Category -> Snowflake Category
id :: Snowflake Category
  , Category -> SnowflakeMap Overwrite
permissionOverwrites :: SnowflakeMap Overwrite
  , Category -> Text
name :: Text
  , Category -> Bool
nsfw :: Bool
  , Category -> Int
position :: Int
  , Category -> Snowflake Guild
guildID :: Snowflake Guild
  }
  deriving (Int -> Category -> ShowS
[Category] -> ShowS
Category -> String
(Int -> Category -> ShowS)
-> (Category -> String) -> ([Category] -> ShowS) -> Show Category
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Category] -> ShowS
$cshowList :: [Category] -> ShowS
show :: Category -> String
$cshow :: Category -> String
showsPrec :: Int -> Category -> ShowS
$cshowsPrec :: Int -> Category -> ShowS
Show, Category -> Category -> Bool
(Category -> Category -> Bool)
-> (Category -> Category -> Bool) -> Eq Category
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Category -> Category -> Bool
$c/= :: Category -> Category -> Bool
== :: Category -> Category -> Bool
$c== :: Category -> Category -> Bool
Eq)
  deriving (HasID Category) via HasIDField "id" Category
  deriving (HasID Channel) via HasIDFieldCoerce' "id" Category

instance Aeson.FromJSON Category where
  parseJSON :: Value -> Parser Category
parseJSON = String -> (Object -> Parser Category) -> Value -> Parser Category
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Category" ((Object -> Parser Category) -> Value -> Parser Category)
-> (Object -> Parser Category) -> Value -> Parser Category
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Snowflake Category
-> SnowflakeMap Overwrite
-> Text
-> Bool
-> Int
-> Snowflake Guild
-> Category
Category
      (Snowflake Category
 -> SnowflakeMap Overwrite
 -> Text
 -> Bool
 -> Int
 -> Snowflake Guild
 -> Category)
-> Parser (Snowflake Category)
-> Parser
     (SnowflakeMap Overwrite
      -> Text -> Bool -> Int -> Snowflake Guild -> Category)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Snowflake Category)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Parser
  (SnowflakeMap Overwrite
   -> Text -> Bool -> Int -> Snowflake Guild -> Category)
-> Parser (SnowflakeMap Overwrite)
-> Parser (Text -> Bool -> Int -> Snowflake Guild -> Category)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (SnowflakeMap Overwrite)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"permission_overwrites"
      Parser (Text -> Bool -> Int -> Snowflake Guild -> Category)
-> Parser Text
-> Parser (Bool -> Int -> Snowflake Guild -> Category)
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
"name"
      Parser (Bool -> Int -> Snowflake Guild -> Category)
-> Parser Bool -> Parser (Int -> Snowflake Guild -> Category)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"nsfw" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Parser (Int -> Snowflake Guild -> Category)
-> Parser Int -> Parser (Snowflake Guild -> Category)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"position"
      Parser (Snowflake Guild -> Category)
-> Parser (Snowflake Guild) -> Parser Category
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Snowflake Guild)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id"

$(deriveTextShow ''Category)
$(makeFieldLabelsNoPrefix ''Category)