-- | User presences
module Calamity.Types.Model.Presence.Presence
    ( Presence(..)
    , ClientStatus(..) ) where

import           Calamity.Internal.AesonThings
import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild
import           Calamity.Types.Model.Presence.Activity
import           Calamity.Types.Model.User
import           Calamity.Types.Snowflake

import           Data.Aeson
import qualified Data.Override                          as O
import           Data.Override.Aeson                    ()
import           Data.Text.Lazy                         ( Text )

import           GHC.Generics

import           TextShow
import qualified TextShow.Generic                       as TSG

data Presence = Presence
  { Presence -> Snowflake User
user         :: Snowflake User
  , Presence -> Maybe Activity
game         :: Maybe Activity
  , Presence -> Snowflake Guild
guildID      :: Snowflake Guild
  , Presence -> StatusType
status       :: StatusType
  , Presence -> ClientStatus
clientStatus :: ClientStatus
  }
  deriving ( Presence -> Presence -> Bool
(Presence -> Presence -> Bool)
-> (Presence -> Presence -> Bool) -> Eq Presence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Presence -> Presence -> Bool
$c/= :: Presence -> Presence -> Bool
== :: Presence -> Presence -> Bool
$c== :: Presence -> Presence -> Bool
Eq, Int -> Presence -> ShowS
[Presence] -> ShowS
Presence -> String
(Int -> Presence -> ShowS)
-> (Presence -> String) -> ([Presence] -> ShowS) -> Show Presence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Presence] -> ShowS
$cshowList :: [Presence] -> ShowS
show :: Presence -> String
$cshow :: Presence -> String
showsPrec :: Int -> Presence -> ShowS
$cshowsPrec :: Int -> Presence -> ShowS
Show, (forall x. Presence -> Rep Presence x)
-> (forall x. Rep Presence x -> Presence) -> Generic Presence
forall x. Rep Presence x -> Presence
forall x. Presence -> Rep Presence x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Presence x -> Presence
$cfrom :: forall x. Presence -> Rep Presence x
Generic )
  deriving ( Int -> Presence -> Builder
Int -> Presence -> Text
Int -> Presence -> Text
[Presence] -> Builder
[Presence] -> Text
[Presence] -> Text
Presence -> Builder
Presence -> Text
Presence -> Text
(Int -> Presence -> Builder)
-> (Presence -> Builder)
-> ([Presence] -> Builder)
-> (Int -> Presence -> Text)
-> (Presence -> Text)
-> ([Presence] -> Text)
-> (Int -> Presence -> Text)
-> (Presence -> Text)
-> ([Presence] -> Text)
-> TextShow Presence
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 :: [Presence] -> Text
$cshowtlList :: [Presence] -> Text
showtl :: Presence -> Text
$cshowtl :: Presence -> Text
showtlPrec :: Int -> Presence -> Text
$cshowtlPrec :: Int -> Presence -> Text
showtList :: [Presence] -> Text
$cshowtList :: [Presence] -> Text
showt :: Presence -> Text
$cshowt :: Presence -> Text
showtPrec :: Int -> Presence -> Text
$cshowtPrec :: Int -> Presence -> Text
showbList :: [Presence] -> Builder
$cshowbList :: [Presence] -> Builder
showb :: Presence -> Builder
$cshowb :: Presence -> Builder
showbPrec :: Int -> Presence -> Builder
$cshowbPrec :: Int -> Presence -> Builder
TextShow ) via TSG.FromGeneric Presence
  deriving ( [Presence] -> Encoding
[Presence] -> Value
Presence -> Encoding
Presence -> Value
(Presence -> Value)
-> (Presence -> Encoding)
-> ([Presence] -> Value)
-> ([Presence] -> Encoding)
-> ToJSON Presence
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Presence] -> Encoding
$ctoEncodingList :: [Presence] -> Encoding
toJSONList :: [Presence] -> Value
$ctoJSONList :: [Presence] -> Value
toEncoding :: Presence -> Encoding
$ctoEncoding :: Presence -> Encoding
toJSON :: Presence -> Value
$ctoJSON :: Presence -> Value
ToJSON, Value -> Parser [Presence]
Value -> Parser Presence
(Value -> Parser Presence)
-> (Value -> Parser [Presence]) -> FromJSON Presence
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Presence]
$cparseJSONList :: Value -> Parser [Presence]
parseJSON :: Value -> Parser Presence
$cparseJSON :: Value -> Parser Presence
FromJSON ) via CalamityJSON
      (O.Override Presence '["user" `O.As` Partial User])
  deriving ( HasID User ) via HasIDField "user" Presence
  deriving ( HasID Guild ) via HasIDField "guildID" Presence

data ClientStatus = ClientStatus
  { ClientStatus -> Maybe Text
desktop :: Maybe Text
  , ClientStatus -> Maybe Text
mobile  :: Maybe Text
  , ClientStatus -> Maybe Text
web     :: Maybe Text
  }
  deriving ( ClientStatus -> ClientStatus -> Bool
(ClientStatus -> ClientStatus -> Bool)
-> (ClientStatus -> ClientStatus -> Bool) -> Eq ClientStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientStatus -> ClientStatus -> Bool
$c/= :: ClientStatus -> ClientStatus -> Bool
== :: ClientStatus -> ClientStatus -> Bool
$c== :: ClientStatus -> ClientStatus -> Bool
Eq, Int -> ClientStatus -> ShowS
[ClientStatus] -> ShowS
ClientStatus -> String
(Int -> ClientStatus -> ShowS)
-> (ClientStatus -> String)
-> ([ClientStatus] -> ShowS)
-> Show ClientStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientStatus] -> ShowS
$cshowList :: [ClientStatus] -> ShowS
show :: ClientStatus -> String
$cshow :: ClientStatus -> String
showsPrec :: Int -> ClientStatus -> ShowS
$cshowsPrec :: Int -> ClientStatus -> ShowS
Show, (forall x. ClientStatus -> Rep ClientStatus x)
-> (forall x. Rep ClientStatus x -> ClientStatus)
-> Generic ClientStatus
forall x. Rep ClientStatus x -> ClientStatus
forall x. ClientStatus -> Rep ClientStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientStatus x -> ClientStatus
$cfrom :: forall x. ClientStatus -> Rep ClientStatus x
Generic )
  deriving ( Int -> ClientStatus -> Builder
Int -> ClientStatus -> Text
Int -> ClientStatus -> Text
[ClientStatus] -> Builder
[ClientStatus] -> Text
[ClientStatus] -> Text
ClientStatus -> Builder
ClientStatus -> Text
ClientStatus -> Text
(Int -> ClientStatus -> Builder)
-> (ClientStatus -> Builder)
-> ([ClientStatus] -> Builder)
-> (Int -> ClientStatus -> Text)
-> (ClientStatus -> Text)
-> ([ClientStatus] -> Text)
-> (Int -> ClientStatus -> Text)
-> (ClientStatus -> Text)
-> ([ClientStatus] -> Text)
-> TextShow ClientStatus
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 :: [ClientStatus] -> Text
$cshowtlList :: [ClientStatus] -> Text
showtl :: ClientStatus -> Text
$cshowtl :: ClientStatus -> Text
showtlPrec :: Int -> ClientStatus -> Text
$cshowtlPrec :: Int -> ClientStatus -> Text
showtList :: [ClientStatus] -> Text
$cshowtList :: [ClientStatus] -> Text
showt :: ClientStatus -> Text
$cshowt :: ClientStatus -> Text
showtPrec :: Int -> ClientStatus -> Text
$cshowtPrec :: Int -> ClientStatus -> Text
showbList :: [ClientStatus] -> Builder
$cshowbList :: [ClientStatus] -> Builder
showb :: ClientStatus -> Builder
$cshowb :: ClientStatus -> Builder
showbPrec :: Int -> ClientStatus -> Builder
$cshowbPrec :: Int -> ClientStatus -> Builder
TextShow ) via TSG.FromGeneric ClientStatus
  deriving ( [ClientStatus] -> Encoding
[ClientStatus] -> Value
ClientStatus -> Encoding
ClientStatus -> Value
(ClientStatus -> Value)
-> (ClientStatus -> Encoding)
-> ([ClientStatus] -> Value)
-> ([ClientStatus] -> Encoding)
-> ToJSON ClientStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ClientStatus] -> Encoding
$ctoEncodingList :: [ClientStatus] -> Encoding
toJSONList :: [ClientStatus] -> Value
$ctoJSONList :: [ClientStatus] -> Value
toEncoding :: ClientStatus -> Encoding
$ctoEncoding :: ClientStatus -> Encoding
toJSON :: ClientStatus -> Value
$ctoJSON :: ClientStatus -> Value
ToJSON, Value -> Parser [ClientStatus]
Value -> Parser ClientStatus
(Value -> Parser ClientStatus)
-> (Value -> Parser [ClientStatus]) -> FromJSON ClientStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ClientStatus]
$cparseJSONList :: Value -> Parser [ClientStatus]
parseJSON :: Value -> Parser ClientStatus
$cparseJSON :: Value -> Parser ClientStatus
FromJSON ) via CalamityJSON ClientStatus