{-# LANGUAGE TemplateHaskell #-}

-- | A User
module Calamity.Types.Model.User (
  User (..),
  Partial (PartialUser),
  StatusType (..),
) where

import {-# SOURCE #-} Calamity.Types.Model.Guild.Member
import Calamity.Types.Partial
import Calamity.Types.Snowflake
import Data.Aeson ((.:), (.:?))
import qualified Data.Aeson as Aeson
import Data.Text (Text)
import Data.Word
import Optics.TH
import TextShow.TH

data User = User
  { User -> Snowflake User
id :: Snowflake User
  , User -> Text
username :: Text
  , User -> Text
discriminator :: Text
  , User -> Maybe Bool
bot :: Maybe Bool
  , User -> Maybe Text
avatar :: Maybe Text
  , User -> Maybe Bool
mfaEnabled :: Maybe Bool
  , User -> Maybe Bool
verified :: Maybe Bool
  , User -> Maybe Text
email :: Maybe Text
  , User -> Maybe Word64
flags :: Maybe Word64
  , User -> Maybe Word64
premiumType :: Maybe Word64
  }
  deriving (Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show, User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: User -> User -> Bool
$c/= :: User -> User -> Bool
== :: User -> User -> Bool
$c== :: User -> User -> Bool
Eq)
  deriving (HasID User) via HasIDField "id" User
  deriving (HasID Member) via HasIDFieldCoerce' "id" User

instance Aeson.FromJSON User where
  parseJSON :: Value -> Parser User
parseJSON = String -> (Object -> Parser User) -> Value -> Parser User
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"User" ((Object -> Parser User) -> Value -> Parser User)
-> (Object -> Parser User) -> Value -> Parser User
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Snowflake User
-> Text
-> Text
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Word64
-> Maybe Word64
-> User
User
      (Snowflake User
 -> Text
 -> Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Word64
 -> Maybe Word64
 -> User)
-> Parser (Snowflake User)
-> Parser
     (Text
      -> Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Word64
      -> Maybe Word64
      -> User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Snowflake User)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Parser
  (Text
   -> Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Word64
   -> Maybe Word64
   -> User)
-> Parser Text
-> Parser
     (Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Word64
      -> Maybe Word64
      -> User)
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
"username"
      Parser
  (Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Word64
   -> Maybe Word64
   -> User)
-> Parser Text
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Word64
      -> Maybe Word64
      -> User)
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
"discriminator"
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Word64
   -> Maybe Word64
   -> User)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Word64
      -> Maybe Word64
      -> User)
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
"bot"
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Word64
   -> Maybe Word64
   -> User)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Word64
      -> Maybe Word64
      -> User)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"avatar"
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Word64
   -> Maybe Word64
   -> User)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool -> Maybe Text -> Maybe Word64 -> Maybe Word64 -> User)
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
"mfa_enabled"
      Parser
  (Maybe Bool -> Maybe Text -> Maybe Word64 -> Maybe Word64 -> User)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> Maybe Word64 -> Maybe Word64 -> User)
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
"verified"
      Parser (Maybe Text -> Maybe Word64 -> Maybe Word64 -> User)
-> Parser (Maybe Text)
-> Parser (Maybe Word64 -> Maybe Word64 -> User)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email"
      Parser (Maybe Word64 -> Maybe Word64 -> User)
-> Parser (Maybe Word64) -> Parser (Maybe Word64 -> User)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Word64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"flags"
      Parser (Maybe Word64 -> User)
-> Parser (Maybe Word64) -> Parser User
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Word64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"premium_type"

newtype instance Partial User = PartialUser
  { Partial User -> Snowflake User
id :: Snowflake User
  }
  deriving (Int -> Partial User -> ShowS
[Partial User] -> ShowS
Partial User -> String
(Int -> Partial User -> ShowS)
-> (Partial User -> String)
-> ([Partial User] -> ShowS)
-> Show (Partial User)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Partial User] -> ShowS
$cshowList :: [Partial User] -> ShowS
show :: Partial User -> String
$cshow :: Partial User -> String
showsPrec :: Int -> Partial User -> ShowS
$cshowsPrec :: Int -> Partial User -> ShowS
Show, Partial User -> Partial User -> Bool
(Partial User -> Partial User -> Bool)
-> (Partial User -> Partial User -> Bool) -> Eq (Partial User)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Partial User -> Partial User -> Bool
$c/= :: Partial User -> Partial User -> Bool
== :: Partial User -> Partial User -> Bool
$c== :: Partial User -> Partial User -> Bool
Eq)
  deriving (HasID User) via HasIDField "id" (Partial User)

instance Aeson.FromJSON (Partial User) where
  parseJSON :: Value -> Parser (Partial User)
parseJSON = String
-> (Object -> Parser (Partial User))
-> Value
-> Parser (Partial User)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Partial User" ((Object -> Parser (Partial User))
 -> Value -> Parser (Partial User))
-> (Object -> Parser (Partial User))
-> Value
-> Parser (Partial User)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Snowflake User -> Partial User
PartialUser (Snowflake User -> Partial User)
-> Parser (Snowflake User) -> Parser (Partial User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Snowflake User)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"

data StatusType
  = Idle
  | DND
  | Online
  | Offline
  | Invisible
  deriving (StatusType -> StatusType -> Bool
(StatusType -> StatusType -> Bool)
-> (StatusType -> StatusType -> Bool) -> Eq StatusType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusType -> StatusType -> Bool
$c/= :: StatusType -> StatusType -> Bool
== :: StatusType -> StatusType -> Bool
$c== :: StatusType -> StatusType -> Bool
Eq, Int -> StatusType -> ShowS
[StatusType] -> ShowS
StatusType -> String
(Int -> StatusType -> ShowS)
-> (StatusType -> String)
-> ([StatusType] -> ShowS)
-> Show StatusType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusType] -> ShowS
$cshowList :: [StatusType] -> ShowS
show :: StatusType -> String
$cshow :: StatusType -> String
showsPrec :: Int -> StatusType -> ShowS
$cshowsPrec :: Int -> StatusType -> ShowS
Show, Int -> StatusType
StatusType -> Int
StatusType -> [StatusType]
StatusType -> StatusType
StatusType -> StatusType -> [StatusType]
StatusType -> StatusType -> StatusType -> [StatusType]
(StatusType -> StatusType)
-> (StatusType -> StatusType)
-> (Int -> StatusType)
-> (StatusType -> Int)
-> (StatusType -> [StatusType])
-> (StatusType -> StatusType -> [StatusType])
-> (StatusType -> StatusType -> [StatusType])
-> (StatusType -> StatusType -> StatusType -> [StatusType])
-> Enum StatusType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StatusType -> StatusType -> StatusType -> [StatusType]
$cenumFromThenTo :: StatusType -> StatusType -> StatusType -> [StatusType]
enumFromTo :: StatusType -> StatusType -> [StatusType]
$cenumFromTo :: StatusType -> StatusType -> [StatusType]
enumFromThen :: StatusType -> StatusType -> [StatusType]
$cenumFromThen :: StatusType -> StatusType -> [StatusType]
enumFrom :: StatusType -> [StatusType]
$cenumFrom :: StatusType -> [StatusType]
fromEnum :: StatusType -> Int
$cfromEnum :: StatusType -> Int
toEnum :: Int -> StatusType
$ctoEnum :: Int -> StatusType
pred :: StatusType -> StatusType
$cpred :: StatusType -> StatusType
succ :: StatusType -> StatusType
$csucc :: StatusType -> StatusType
Enum)

instance Aeson.FromJSON StatusType where
  parseJSON :: Value -> Parser StatusType
parseJSON = String -> (Text -> Parser StatusType) -> Value -> Parser StatusType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"StatusType" ((Text -> Parser StatusType) -> Value -> Parser StatusType)
-> (Text -> Parser StatusType) -> Value -> Parser StatusType
forall a b. (a -> b) -> a -> b
$ \case
    Text
"idle" -> StatusType -> Parser StatusType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StatusType
Idle
    Text
"dnd" -> StatusType -> Parser StatusType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StatusType
DND
    Text
"online" -> StatusType -> Parser StatusType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StatusType
Online
    Text
"offline" -> StatusType -> Parser StatusType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StatusType
Offline
    Text
"invisible" -> StatusType -> Parser StatusType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StatusType
Invisible
    Text
_ -> String -> Parser StatusType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown status type"

instance Aeson.ToJSON StatusType where
  toJSON :: StatusType -> Value
toJSON =
    forall a. ToJSON a => a -> Value
Aeson.toJSON @Text (Text -> Value) -> (StatusType -> Text) -> StatusType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      StatusType
Idle -> Text
"idle"
      StatusType
DND -> Text
"dnd"
      StatusType
Online -> Text
"online"
      StatusType
Offline -> Text
"offline"
      StatusType
Invisible -> Text
"invisible"

$(deriveTextShow ''User)
$(deriveTextShow 'PartialUser)
$(deriveTextShow ''StatusType)
$(makeFieldLabelsNoPrefix ''User)
$(makeFieldLabelsNoPrefix 'PartialUser)
$(makeFieldLabelsNoPrefix ''StatusType)