-- | Guild roles
module Calamity.Types.Model.Guild.Role (Role (..)) where

import Calamity.Internal.AesonThings
import Calamity.Internal.IntColour
import Calamity.Types.Model.Guild.Permissions
import Calamity.Types.Snowflake

import Data.Aeson
import Data.Colour
import Data.Text (Text)

import GHC.Generics

import Calamity.Internal.OverriddenVia
import Control.DeepSeq (NFData (rnf), rwhnf)
import TextShow
import qualified TextShow.Generic as TSG

data Role' = Role'
  { Role' -> Snowflake Role
id :: Snowflake Role
  , Role' -> Text
name :: Text
  , Role' -> IntColour
color :: IntColour
  , Role' -> Bool
hoist :: Bool
  , Role' -> Int
position :: Int
  , Role' -> Permissions
permissions :: Permissions
  , Role' -> Bool
managed :: Bool
  , Role' -> Bool
mentionable :: Bool
  }
  deriving ((forall x. Role' -> Rep Role' x)
-> (forall x. Rep Role' x -> Role') -> Generic Role'
forall x. Rep Role' x -> Role'
forall x. Role' -> Rep Role' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Role' x -> Role'
$cfrom :: forall x. Role' -> Rep Role' x
Generic)
  deriving (Int -> Role' -> Builder
Int -> Role' -> Text
Int -> Role' -> Text
[Role'] -> Builder
[Role'] -> Text
[Role'] -> Text
Role' -> Builder
Role' -> Text
Role' -> Text
(Int -> Role' -> Builder)
-> (Role' -> Builder)
-> ([Role'] -> Builder)
-> (Int -> Role' -> Text)
-> (Role' -> Text)
-> ([Role'] -> Text)
-> (Int -> Role' -> Text)
-> (Role' -> Text)
-> ([Role'] -> Text)
-> TextShow Role'
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 :: [Role'] -> Text
$cshowtlList :: [Role'] -> Text
showtl :: Role' -> Text
$cshowtl :: Role' -> Text
showtlPrec :: Int -> Role' -> Text
$cshowtlPrec :: Int -> Role' -> Text
showtList :: [Role'] -> Text
$cshowtList :: [Role'] -> Text
showt :: Role' -> Text
$cshowt :: Role' -> Text
showtPrec :: Int -> Role' -> Text
$cshowtPrec :: Int -> Role' -> Text
showbList :: [Role'] -> Builder
$cshowbList :: [Role'] -> Builder
showb :: Role' -> Builder
$cshowb :: Role' -> Builder
showbPrec :: Int -> Role' -> Builder
$cshowbPrec :: Int -> Role' -> Builder
TextShow) via TSG.FromGeneric Role'
  deriving ([Role'] -> Encoding
[Role'] -> Value
Role' -> Encoding
Role' -> Value
(Role' -> Value)
-> (Role' -> Encoding)
-> ([Role'] -> Value)
-> ([Role'] -> Encoding)
-> ToJSON Role'
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Role'] -> Encoding
$ctoEncodingList :: [Role'] -> Encoding
toJSONList :: [Role'] -> Value
$ctoJSONList :: [Role'] -> Value
toEncoding :: Role' -> Encoding
$ctoEncoding :: Role' -> Encoding
toJSON :: Role' -> Value
$ctoJSON :: Role' -> Value
ToJSON, Value -> Parser [Role']
Value -> Parser Role'
(Value -> Parser Role')
-> (Value -> Parser [Role']) -> FromJSON Role'
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Role']
$cparseJSONList :: Value -> Parser [Role']
parseJSON :: Value -> Parser Role'
$cparseJSON :: Value -> Parser Role'
FromJSON) via CalamityJSON Role'

data Role = Role
  { Role -> Snowflake Role
id :: Snowflake Role
  , Role -> Text
name :: Text
  , Role -> Colour Double
color :: Colour Double
  , Role -> Bool
hoist :: Bool
  , Role -> Int
position :: Int
  , Role -> Permissions
permissions :: Permissions
  , Role -> Bool
managed :: Bool
  , Role -> Bool
mentionable :: Bool
  }
  deriving (Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c== :: Role -> Role -> Bool
Eq, Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Role] -> ShowS
$cshowList :: [Role] -> ShowS
show :: Role -> String
$cshow :: Role -> String
showsPrec :: Int -> Role -> ShowS
$cshowsPrec :: Int -> Role -> ShowS
Show, (forall x. Role -> Rep Role x)
-> (forall x. Rep Role x -> Role) -> Generic Role
forall x. Rep Role x -> Role
forall x. Role -> Rep Role x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Role x -> Role
$cfrom :: forall x. Role -> Rep Role x
Generic)
  deriving (Int -> Role -> Builder
Int -> Role -> Text
Int -> Role -> Text
[Role] -> Builder
[Role] -> Text
[Role] -> Text
Role -> Builder
Role -> Text
Role -> Text
(Int -> Role -> Builder)
-> (Role -> Builder)
-> ([Role] -> Builder)
-> (Int -> Role -> Text)
-> (Role -> Text)
-> ([Role] -> Text)
-> (Int -> Role -> Text)
-> (Role -> Text)
-> ([Role] -> Text)
-> TextShow Role
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 :: [Role] -> Text
$cshowtlList :: [Role] -> Text
showtl :: Role -> Text
$cshowtl :: Role -> Text
showtlPrec :: Int -> Role -> Text
$cshowtlPrec :: Int -> Role -> Text
showtList :: [Role] -> Text
$cshowtList :: [Role] -> Text
showt :: Role -> Text
$cshowt :: Role -> Text
showtPrec :: Int -> Role -> Text
$cshowtPrec :: Int -> Role -> Text
showbList :: [Role] -> Builder
$cshowbList :: [Role] -> Builder
showb :: Role -> Builder
$cshowb :: Role -> Builder
showbPrec :: Int -> Role -> Builder
$cshowbPrec :: Int -> Role -> Builder
TextShow, Value -> Parser [Role]
Value -> Parser Role
(Value -> Parser Role) -> (Value -> Parser [Role]) -> FromJSON Role
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Role]
$cparseJSONList :: Value -> Parser [Role]
parseJSON :: Value -> Parser Role
$cparseJSON :: Value -> Parser Role
FromJSON, [Role] -> Encoding
[Role] -> Value
Role -> Encoding
Role -> Value
(Role -> Value)
-> (Role -> Encoding)
-> ([Role] -> Value)
-> ([Role] -> Encoding)
-> ToJSON Role
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Role] -> Encoding
$ctoEncodingList :: [Role] -> Encoding
toJSONList :: [Role] -> Value
$ctoJSONList :: [Role] -> Value
toEncoding :: Role -> Encoding
$ctoEncoding :: Role -> Encoding
toJSON :: Role -> Value
$ctoJSON :: Role -> Value
ToJSON) via OverriddenVia Role Role'
  deriving (HasID Role) via HasIDField "id" Role

instance NFData Role where
  rnf :: Role -> ()
rnf (Role Snowflake Role
id Text
name Colour Double
color Bool
hoist Int
position Permissions
permissions Bool
managed Bool
mentionable) =
    Snowflake Role -> ()
forall a. NFData a => a -> ()
rnf Snowflake Role
id () -> () -> ()
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
name () -> () -> ()
`seq` Colour Double -> ()
forall a. a -> ()
rwhnf Colour Double
color () -> () -> ()
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
hoist () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
position
      () -> () -> ()
`seq` Permissions -> ()
forall a. NFData a => a -> ()
rnf Permissions
permissions
      () -> () -> ()
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
managed
      () -> () -> ()
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
mentionable