Emoji.hs

{-# 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
  { id :: Snowflake Emoji
  , name :: T.Text
  , roles :: Vector (Snowflake Role)
  , user :: Maybe User
  , requireColons :: Bool
  , managed :: Bool
  , animated :: Bool
  }
  deriving (Eq, Show)
  deriving (TextShow.TextShow) via TextShow.FromStringShow Emoji
  deriving (HasID Emoji) via HasIDField "id" Emoji

instance Aeson.FromJSON Emoji where
  parseJSON = Aeson.withObject "Emoji" $ \v ->
    Emoji
      <$> v .: "id"
      <*> v .: "name"
      <*> (fmap unAesonVector <$> v .:? "roles") .!= mempty
      <*> v .:? "user"
      <*> v .:? "require_colons" .!= False
      <*> v .:? "managed" .!= False
      <*> v .:? "animated" .!= False

instance CDNAsset Emoji where
  assetURL Emoji {id, animated} =
    cdnURL /: "emojis" /: (showt id <> if animated then ".gif" else ".png")

emojiAsRawEmoji :: Emoji -> RawEmoji
emojiAsRawEmoji Emoji {id, name, animated} = CustomEmoji $ PartialEmoji id name animated

data instance Partial Emoji = PartialEmoji
  { id :: Snowflake Emoji
  , name :: T.Text
  , animated :: Bool
  }
  deriving (Eq)
  deriving (HasID Emoji) via HasIDField "id" (Partial Emoji)
  deriving (Aeson.ToJSON) via CalamityToJSON (Partial Emoji)

instance Aeson.FromJSON (Partial Emoji) where
  parseJSON = Aeson.withObject "Partial Emoji" $ \v ->
    PartialEmoji
      <$> v .: "id"
      <*> v .: "name"
      <*> v .:? "animated" .!= False

instance CalamityToJSON' (Partial Emoji) where
  toPairs PartialEmoji {..} =
    [ "id" .= id
    , "name" .= name
    , "animated" .= animated
    ]

instance Show (Partial Emoji) where
  show PartialEmoji {id, name, animated} =
    "<" <> a <> ":" <> T.unpack name <> ":" <> show id <> ">"
    where
      a = if animated then "a" else ""

instance TextShow.TextShow (Partial Emoji) where
  showb PartialEmoji {id, name, animated} =
    "<" <> a <> ":" <> TextShow.fromText name <> ":" <> TextShow.showb id <> ">"
    where
      a = if animated then "a" else ""

data RawEmoji
  = UnicodeEmoji T.Text
  | CustomEmoji (Partial Emoji)
  deriving (Eq)

instance Show RawEmoji where
  show (UnicodeEmoji v) = T.unpack v
  show (CustomEmoji p) = show p

instance TextShow.TextShow RawEmoji where
  showb (UnicodeEmoji v) = TextShow.fromText v
  showb (CustomEmoji p) = TextShow.showb p

instance Aeson.ToJSON RawEmoji where
  toJSON (CustomEmoji e) = Aeson.toJSON e
  toJSON (UnicodeEmoji s) = Aeson.object ["name" Aeson..= s, "id" Aeson..= Nothing @()]
  toEncoding (CustomEmoji e) = Aeson.toEncoding e
  toEncoding (UnicodeEmoji s) = Aeson.pairs . mconcat $ ["name" Aeson..= s, "id" Aeson..= Nothing @()]

instance Aeson.FromJSON RawEmoji where
  parseJSON = Aeson.withObject "RawEmoji" $ \v -> do
    m_id :: Maybe (Snowflake Emoji) <- v .:? "id"
    anim <- v .:? "animated" .!= False
    name :: T.Text <- v .: "name"

    pure $ case m_id of
      Just id -> CustomEmoji $ PartialEmoji id name anim
      Nothing -> UnicodeEmoji name

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