{-# LANGUAGE TemplateHaskell #-}

-- | Guild invites
module Calamity.Types.Model.Guild.Invite (Invite (..)) where

import Calamity.Types.Model.Channel
import Calamity.Types.Model.Guild.Guild
import Calamity.Types.Model.User
import Data.Aeson ((.:), (.:?))
import Data.Aeson qualified as Aeson
import Data.Text (Text)
import Data.Time (UTCTime)
import Optics.TH
import TextShow qualified

data Invite = Invite
  { Invite -> Text
code :: Text
  , Invite -> Maybe (Partial Guild)
guild :: Maybe (Partial Guild)
  , Invite -> Maybe (Partial Channel)
channel :: Maybe (Partial Channel)
  , Invite -> Maybe User
inviter :: Maybe User
  , Invite -> Maybe User
targetUser :: Maybe User
  , Invite -> Maybe Int
targetType :: Maybe Int
  , Invite -> Maybe Int
approximatePresenceCount :: Maybe Int
  , Invite -> Maybe Int
approximateMemberCount :: Maybe Int
  , Invite -> Maybe UTCTime
expiresAt :: Maybe UTCTime
  }
  deriving (Invite -> Invite -> Bool
(Invite -> Invite -> Bool)
-> (Invite -> Invite -> Bool) -> Eq Invite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Invite -> Invite -> Bool
== :: Invite -> Invite -> Bool
$c/= :: Invite -> Invite -> Bool
/= :: Invite -> Invite -> Bool
Eq, Int -> Invite -> ShowS
[Invite] -> ShowS
Invite -> String
(Int -> Invite -> ShowS)
-> (Invite -> String) -> ([Invite] -> ShowS) -> Show Invite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Invite -> ShowS
showsPrec :: Int -> Invite -> ShowS
$cshow :: Invite -> String
show :: Invite -> String
$cshowList :: [Invite] -> ShowS
showList :: [Invite] -> ShowS
Show)
  deriving (Int -> Invite -> Text
Int -> Invite -> Builder
Int -> Invite -> Text
[Invite] -> Text
[Invite] -> Builder
[Invite] -> Text
Invite -> Text
Invite -> Builder
Invite -> Text
(Int -> Invite -> Builder)
-> (Invite -> Builder)
-> ([Invite] -> Builder)
-> (Int -> Invite -> Text)
-> (Invite -> Text)
-> ([Invite] -> Text)
-> (Int -> Invite -> Text)
-> (Invite -> Text)
-> ([Invite] -> Text)
-> TextShow Invite
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
$cshowbPrec :: Int -> Invite -> Builder
showbPrec :: Int -> Invite -> Builder
$cshowb :: Invite -> Builder
showb :: Invite -> Builder
$cshowbList :: [Invite] -> Builder
showbList :: [Invite] -> Builder
$cshowtPrec :: Int -> Invite -> Text
showtPrec :: Int -> Invite -> Text
$cshowt :: Invite -> Text
showt :: Invite -> Text
$cshowtList :: [Invite] -> Text
showtList :: [Invite] -> Text
$cshowtlPrec :: Int -> Invite -> Text
showtlPrec :: Int -> Invite -> Text
$cshowtl :: Invite -> Text
showtl :: Invite -> Text
$cshowtlList :: [Invite] -> Text
showtlList :: [Invite] -> Text
TextShow.TextShow) via TextShow.FromStringShow Invite

instance Aeson.FromJSON Invite where
  parseJSON :: Value -> Parser Invite
parseJSON = String -> (Object -> Parser Invite) -> Value -> Parser Invite
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Invite" ((Object -> Parser Invite) -> Value -> Parser Invite)
-> (Object -> Parser Invite) -> Value -> Parser Invite
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text
-> Maybe (Partial Guild)
-> Maybe (Partial Channel)
-> Maybe User
-> Maybe User
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe UTCTime
-> Invite
Invite
      (Text
 -> Maybe (Partial Guild)
 -> Maybe (Partial Channel)
 -> Maybe User
 -> Maybe User
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe UTCTime
 -> Invite)
-> Parser Text
-> Parser
     (Maybe (Partial Guild)
      -> Maybe (Partial Channel)
      -> Maybe User
      -> Maybe User
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe UTCTime
      -> Invite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
      Parser
  (Maybe (Partial Guild)
   -> Maybe (Partial Channel)
   -> Maybe User
   -> Maybe User
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe UTCTime
   -> Invite)
-> Parser (Maybe (Partial Guild))
-> Parser
     (Maybe (Partial Channel)
      -> Maybe User
      -> Maybe User
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe UTCTime
      -> Invite)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Partial Guild))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild"
      Parser
  (Maybe (Partial Channel)
   -> Maybe User
   -> Maybe User
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe UTCTime
   -> Invite)
-> Parser (Maybe (Partial Channel))
-> Parser
     (Maybe User
      -> Maybe User
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe UTCTime
      -> Invite)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Partial Channel))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channel"
      Parser
  (Maybe User
   -> Maybe User
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe UTCTime
   -> Invite)
-> Parser (Maybe User)
-> Parser
     (Maybe User
      -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe UTCTime -> Invite)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"inviter"
      Parser
  (Maybe User
   -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe UTCTime -> Invite)
-> Parser (Maybe User)
-> Parser
     (Maybe Int -> Maybe Int -> Maybe Int -> Maybe UTCTime -> Invite)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"target_user"
      Parser
  (Maybe Int -> Maybe Int -> Maybe Int -> Maybe UTCTime -> Invite)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe Int -> Maybe UTCTime -> Invite)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"target_type"
      Parser (Maybe Int -> Maybe Int -> Maybe UTCTime -> Invite)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe UTCTime -> Invite)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"approximate_presence_count"
      Parser (Maybe Int -> Maybe UTCTime -> Invite)
-> Parser (Maybe Int) -> Parser (Maybe UTCTime -> Invite)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"approximate_user_count"
      Parser (Maybe UTCTime -> Invite)
-> Parser (Maybe UTCTime) -> Parser Invite
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"expires_at"

$(makeFieldLabelsNoPrefix ''Invite)