{-# LANGUAGE TemplateHaskell #-}

-- | Discord emojis
module Calamity.Types.Model.Guild.Emoji (
  Emoji (..),
  Partial (PartialEmoji),
  RawEmoji (..),
  emojiAsRawEmoji,
) where

import Calamity.Internal.Utils (
  AesonVector (unAesonVector),
  CalamityToJSON (..),
  CalamityToJSON' (..),
  (.=),
 )
import Calamity.Types.CDNAsset (CDNAsset (..))
import {-# SOURCE #-} Calamity.Types.Model.Guild.Role
import Calamity.Types.Model.User
import Calamity.Types.Snowflake
import Calamity.Utils.CDNUrl (cdnURL)
import Data.Aeson ((.!=), (.:), (.:?))
import Data.Aeson qualified as Aeson
import Data.Text qualified as T
import Data.Vector.Unboxing (Vector)
import Network.HTTP.Req ((/:))
import Optics.TH
import TextShow (showt)
import TextShow qualified

data Emoji = Emoji
  { Emoji -> Snowflake Emoji
id :: Snowflake Emoji
  , Emoji -> Text
name :: T.Text
  , Emoji -> Vector (Snowflake Role)
roles :: Vector (Snowflake Role)
  , Emoji -> Maybe User
user :: Maybe User
  , Emoji -> Bool
requireColons :: Bool
  , Emoji -> Bool
managed :: Bool
  , Emoji -> Bool
animated :: Bool
  }
  deriving (Emoji -> Emoji -> Bool
(Emoji -> Emoji -> Bool) -> (Emoji -> Emoji -> Bool) -> Eq Emoji
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Emoji -> Emoji -> Bool
== :: Emoji -> Emoji -> Bool
$c/= :: Emoji -> Emoji -> Bool
/= :: Emoji -> Emoji -> Bool
Eq, Int -> Emoji -> ShowS
[Emoji] -> ShowS
Emoji -> String
(Int -> Emoji -> ShowS)
-> (Emoji -> String) -> ([Emoji] -> ShowS) -> Show Emoji
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Emoji -> ShowS
showsPrec :: Int -> Emoji -> ShowS
$cshow :: Emoji -> String
show :: Emoji -> String
$cshowList :: [Emoji] -> ShowS
showList :: [Emoji] -> ShowS
Show)
  deriving (Int -> Emoji -> Text
Int -> Emoji -> Builder
Int -> Emoji -> Text
[Emoji] -> Text
[Emoji] -> Builder
[Emoji] -> Text
Emoji -> Text
Emoji -> Builder
Emoji -> Text
(Int -> Emoji -> Builder)
-> (Emoji -> Builder)
-> ([Emoji] -> Builder)
-> (Int -> Emoji -> Text)
-> (Emoji -> Text)
-> ([Emoji] -> Text)
-> (Int -> Emoji -> Text)
-> (Emoji -> Text)
-> ([Emoji] -> Text)
-> TextShow Emoji
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 -> Emoji -> Builder
showbPrec :: Int -> Emoji -> Builder
$cshowb :: Emoji -> Builder
showb :: Emoji -> Builder
$cshowbList :: [Emoji] -> Builder
showbList :: [Emoji] -> Builder
$cshowtPrec :: Int -> Emoji -> Text
showtPrec :: Int -> Emoji -> Text
$cshowt :: Emoji -> Text
showt :: Emoji -> Text
$cshowtList :: [Emoji] -> Text
showtList :: [Emoji] -> Text
$cshowtlPrec :: Int -> Emoji -> Text
showtlPrec :: Int -> Emoji -> Text
$cshowtl :: Emoji -> Text
showtl :: Emoji -> Text
$cshowtlList :: [Emoji] -> Text
showtlList :: [Emoji] -> Text
TextShow.TextShow) via TextShow.FromStringShow Emoji
  deriving (HasID Emoji) via HasIDField "id" Emoji

instance Aeson.FromJSON Emoji where
  parseJSON :: Value -> Parser Emoji
parseJSON = String -> (Object -> Parser Emoji) -> Value -> Parser Emoji
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Emoji" ((Object -> Parser Emoji) -> Value -> Parser Emoji)
-> (Object -> Parser Emoji) -> Value -> Parser Emoji
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Snowflake Emoji
-> Text
-> Vector (Snowflake Role)
-> Maybe User
-> Bool
-> Bool
-> Bool
-> Emoji
Emoji
      (Snowflake Emoji
 -> Text
 -> Vector (Snowflake Role)
 -> Maybe User
 -> Bool
 -> Bool
 -> Bool
 -> Emoji)
-> Parser (Snowflake Emoji)
-> Parser
     (Text
      -> Vector (Snowflake Role)
      -> Maybe User
      -> Bool
      -> Bool
      -> Bool
      -> Emoji)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Snowflake Emoji)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Parser
  (Text
   -> Vector (Snowflake Role)
   -> Maybe User
   -> Bool
   -> Bool
   -> Bool
   -> Emoji)
-> Parser Text
-> Parser
     (Vector (Snowflake Role)
      -> Maybe User -> Bool -> Bool -> Bool -> Emoji)
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 Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser
  (Vector (Snowflake Role)
   -> Maybe User -> Bool -> Bool -> Bool -> Emoji)
-> Parser (Vector (Snowflake Role))
-> Parser (Maybe User -> Bool -> Bool -> Bool -> Emoji)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((AesonVector (Snowflake Role) -> Vector (Snowflake Role))
-> Maybe (AesonVector (Snowflake Role))
-> Maybe (Vector (Snowflake Role))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AesonVector (Snowflake Role) -> Vector (Snowflake Role)
forall a. AesonVector a -> Vector a
unAesonVector (Maybe (AesonVector (Snowflake Role))
 -> Maybe (Vector (Snowflake Role)))
-> Parser (Maybe (AesonVector (Snowflake Role)))
-> Parser (Maybe (Vector (Snowflake Role)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe (AesonVector (Snowflake Role)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"roles") Parser (Maybe (Vector (Snowflake Role)))
-> Vector (Snowflake Role) -> Parser (Vector (Snowflake Role))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Vector (Snowflake Role)
forall a. Monoid a => a
mempty
      Parser (Maybe User -> Bool -> Bool -> Bool -> Emoji)
-> Parser (Maybe User) -> Parser (Bool -> Bool -> Bool -> Emoji)
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
"user"
      Parser (Bool -> Bool -> Bool -> Emoji)
-> Parser Bool -> Parser (Bool -> Bool -> Emoji)
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 Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"require_colons" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Parser (Bool -> Bool -> Emoji)
-> Parser Bool -> Parser (Bool -> Emoji)
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 Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"managed" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Parser (Bool -> Emoji) -> Parser Bool -> Parser Emoji
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 Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"animated" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

instance CDNAsset Emoji where
  assetURL :: Emoji -> Url 'Https
assetURL Emoji {Snowflake Emoji
$sel:id:Emoji :: Emoji -> Snowflake Emoji
id :: Snowflake Emoji
id, Bool
$sel:animated:Emoji :: Emoji -> Bool
animated :: Bool
animated} =
    Url 'Https
cdnURL Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"emojis" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: (Snowflake Emoji -> Text
forall a. TextShow a => a -> Text
showt Snowflake Emoji
id Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Bool
animated then Text
".gif" else Text
".png")

emojiAsRawEmoji :: Emoji -> RawEmoji
emojiAsRawEmoji :: Emoji -> RawEmoji
emojiAsRawEmoji Emoji {Snowflake Emoji
$sel:id:Emoji :: Emoji -> Snowflake Emoji
id :: Snowflake Emoji
id, Text
$sel:name:Emoji :: Emoji -> Text
name :: Text
name, Bool
$sel:animated:Emoji :: Emoji -> Bool
animated :: Bool
animated} = Partial Emoji -> RawEmoji
CustomEmoji (Partial Emoji -> RawEmoji) -> Partial Emoji -> RawEmoji
forall a b. (a -> b) -> a -> b
$ Snowflake Emoji -> Text -> Bool -> Partial Emoji
PartialEmoji Snowflake Emoji
id Text
name Bool
animated

data instance Partial Emoji = PartialEmoji
  { Partial Emoji -> Snowflake Emoji
id :: Snowflake Emoji
  , Partial Emoji -> Text
name :: T.Text
  , Partial Emoji -> Bool
animated :: Bool
  }
  deriving (Partial Emoji -> Partial Emoji -> Bool
(Partial Emoji -> Partial Emoji -> Bool)
-> (Partial Emoji -> Partial Emoji -> Bool) -> Eq (Partial Emoji)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Partial Emoji -> Partial Emoji -> Bool
== :: Partial Emoji -> Partial Emoji -> Bool
$c/= :: Partial Emoji -> Partial Emoji -> Bool
/= :: Partial Emoji -> Partial Emoji -> Bool
Eq)
  deriving (HasID Emoji) via HasIDField "id" (Partial Emoji)
  deriving ([Partial Emoji] -> Value
[Partial Emoji] -> Encoding
Partial Emoji -> Value
Partial Emoji -> Encoding
(Partial Emoji -> Value)
-> (Partial Emoji -> Encoding)
-> ([Partial Emoji] -> Value)
-> ([Partial Emoji] -> Encoding)
-> ToJSON (Partial Emoji)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Partial Emoji -> Value
toJSON :: Partial Emoji -> Value
$ctoEncoding :: Partial Emoji -> Encoding
toEncoding :: Partial Emoji -> Encoding
$ctoJSONList :: [Partial Emoji] -> Value
toJSONList :: [Partial Emoji] -> Value
$ctoEncodingList :: [Partial Emoji] -> Encoding
toEncodingList :: [Partial Emoji] -> Encoding
Aeson.ToJSON) via CalamityToJSON (Partial Emoji)

instance Aeson.FromJSON (Partial Emoji) where
  parseJSON :: Value -> Parser (Partial Emoji)
parseJSON = String
-> (Object -> Parser (Partial Emoji))
-> Value
-> Parser (Partial Emoji)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Partial Emoji" ((Object -> Parser (Partial Emoji))
 -> Value -> Parser (Partial Emoji))
-> (Object -> Parser (Partial Emoji))
-> Value
-> Parser (Partial Emoji)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Snowflake Emoji -> Text -> Bool -> Partial Emoji
PartialEmoji
      (Snowflake Emoji -> Text -> Bool -> Partial Emoji)
-> Parser (Snowflake Emoji)
-> Parser (Text -> Bool -> Partial Emoji)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Snowflake Emoji)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Parser (Text -> Bool -> Partial Emoji)
-> Parser Text -> Parser (Bool -> Partial Emoji)
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 Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser (Bool -> Partial Emoji)
-> Parser Bool -> Parser (Partial Emoji)
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 Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"animated" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

instance CalamityToJSON' (Partial Emoji) where
  toPairs :: forall kv. KeyValue kv => Partial Emoji -> [Maybe kv]
toPairs PartialEmoji {Bool
Text
Snowflake Emoji
$sel:id:PartialEmoji :: Partial Emoji -> Snowflake Emoji
$sel:name:PartialEmoji :: Partial Emoji -> Text
$sel:animated:PartialEmoji :: Partial Emoji -> Bool
id :: Snowflake Emoji
name :: Text
animated :: Bool
..} =
    [ Key
"id" Key -> Snowflake Emoji -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Snowflake Emoji
id
    , Key
"name" Key -> Text -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Text
name
    , Key
"animated" Key -> Bool -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Bool
animated
    ]

instance Show (Partial Emoji) where
  show :: Partial Emoji -> String
show PartialEmoji {Snowflake Emoji
$sel:id:PartialEmoji :: Partial Emoji -> Snowflake Emoji
id :: Snowflake Emoji
id, Text
$sel:name:PartialEmoji :: Partial Emoji -> Text
name :: Text
name, Bool
$sel:animated:PartialEmoji :: Partial Emoji -> Bool
animated :: Bool
animated} =
    String
"<" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Snowflake Emoji -> String
forall a. Show a => a -> String
show Snowflake Emoji
id String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
">"
    where
      a :: String
a = if Bool
animated then String
"a" else String
""

instance TextShow.TextShow (Partial Emoji) where
  showb :: Partial Emoji -> Builder
showb PartialEmoji {Snowflake Emoji
$sel:id:PartialEmoji :: Partial Emoji -> Snowflake Emoji
id :: Snowflake Emoji
id, Text
$sel:name:PartialEmoji :: Partial Emoji -> Text
name :: Text
name, Bool
$sel:animated:PartialEmoji :: Partial Emoji -> Bool
animated :: Bool
animated} =
    Builder
"<" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TextShow.fromText Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Snowflake Emoji -> Builder
forall a. TextShow a => a -> Builder
TextShow.showb Snowflake Emoji
id Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">"
    where
      a :: Builder
a = if Bool
animated then Builder
"a" else Builder
""

data RawEmoji
  = UnicodeEmoji T.Text
  | CustomEmoji (Partial Emoji)
  deriving (RawEmoji -> RawEmoji -> Bool
(RawEmoji -> RawEmoji -> Bool)
-> (RawEmoji -> RawEmoji -> Bool) -> Eq RawEmoji
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawEmoji -> RawEmoji -> Bool
== :: RawEmoji -> RawEmoji -> Bool
$c/= :: RawEmoji -> RawEmoji -> Bool
/= :: RawEmoji -> RawEmoji -> Bool
Eq)

instance Show RawEmoji where
  show :: RawEmoji -> String
show (UnicodeEmoji Text
v) = Text -> String
T.unpack Text
v
  show (CustomEmoji Partial Emoji
p) = Partial Emoji -> String
forall a. Show a => a -> String
show Partial Emoji
p

instance TextShow.TextShow RawEmoji where
  showb :: RawEmoji -> Builder
showb (UnicodeEmoji Text
v) = Text -> Builder
TextShow.fromText Text
v
  showb (CustomEmoji Partial Emoji
p) = Partial Emoji -> Builder
forall a. TextShow a => a -> Builder
TextShow.showb Partial Emoji
p

instance Aeson.ToJSON RawEmoji where
  toJSON :: RawEmoji -> Value
toJSON (CustomEmoji Partial Emoji
e) = Partial Emoji -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Partial Emoji
e
  toJSON (UnicodeEmoji Text
s) = [Pair] -> Value
Aeson.object [Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= Text
s, Key
"id" Key -> Maybe () -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= forall a. Maybe a
Nothing @()]
  toEncoding :: RawEmoji -> Encoding
toEncoding (CustomEmoji Partial Emoji
e) = Partial Emoji -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding Partial Emoji
e
  toEncoding (UnicodeEmoji Text
s) = Series -> Encoding
Aeson.pairs (Series -> Encoding)
-> ([Series] -> Series) -> [Series] -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Encoding) -> [Series] -> Encoding
forall a b. (a -> b) -> a -> b
$ [Key
"name" Key -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Aeson..= Text
s, Key
"id" Key -> Maybe () -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Aeson..= forall a. Maybe a
Nothing @()]

instance Aeson.FromJSON RawEmoji where
  parseJSON :: Value -> Parser RawEmoji
parseJSON = String -> (Object -> Parser RawEmoji) -> Value -> Parser RawEmoji
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"RawEmoji" ((Object -> Parser RawEmoji) -> Value -> Parser RawEmoji)
-> (Object -> Parser RawEmoji) -> Value -> Parser RawEmoji
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Maybe (Snowflake Emoji)
m_id :: Maybe (Snowflake Emoji) <- Object
v Object -> Key -> Parser (Maybe (Snowflake Emoji))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
    Bool
anim <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"animated" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Text
name :: T.Text <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

    RawEmoji -> Parser RawEmoji
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawEmoji -> Parser RawEmoji) -> RawEmoji -> Parser RawEmoji
forall a b. (a -> b) -> a -> b
$ case Maybe (Snowflake Emoji)
m_id of
      Just Snowflake Emoji
id -> Partial Emoji -> RawEmoji
CustomEmoji (Partial Emoji -> RawEmoji) -> Partial Emoji -> RawEmoji
forall a b. (a -> b) -> a -> b
$ Snowflake Emoji -> Text -> Bool -> Partial Emoji
PartialEmoji Snowflake Emoji
id Text
name Bool
anim
      Maybe (Snowflake Emoji)
Nothing -> Text -> RawEmoji
UnicodeEmoji Text
name

$(makeFieldLabelsNoPrefix ''Emoji)
$(makeFieldLabelsNoPrefix 'PartialEmoji)
$(makeFieldLabelsNoPrefix ''RawEmoji)