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

import           Calamity.Internal.AesonThings
import           Calamity.Internal.IntColour            ()
import           Calamity.Internal.Utils                ()
import           Calamity.Types.Model.Guild.Permissions
import           Calamity.Types.Snowflake

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

import           GHC.Generics

import           TextShow
import qualified TextShow.Generic                       as TSG

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 ) 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
  deriving ( HasID Role ) via HasIDField "id" Role