-- | Message components
module Calamity.Types.Model.Channel.Component (
    Component (..),
    Button (..),
    button,
    button',
    ButtonStyle (..),
    ComponentType (..),
    componentType,
) where

import Calamity.Internal.AesonThings
import Calamity.Types.Model.Guild.Emoji
import Data.Aeson
import Data.Scientific (toBoundedInteger)
import qualified Data.Text.Lazy as L
import GHC.Generics
import TextShow
import qualified TextShow.Generic as TSG

data Button = Button
    { Button -> ButtonStyle
style :: ButtonStyle
    , Button -> Maybe Text
label :: Maybe L.Text
    , Button -> Maybe (Partial Emoji)
emoji :: Maybe (Partial Emoji)
    , Button -> Maybe Text
customID :: Maybe L.Text
    , Button -> Maybe Text
url :: Maybe L.Text
    , Button -> Bool
disabled :: Bool
    }
    deriving (Int -> Button -> ShowS
[Button] -> ShowS
Button -> String
(Int -> Button -> ShowS)
-> (Button -> String) -> ([Button] -> ShowS) -> Show Button
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Button] -> ShowS
$cshowList :: [Button] -> ShowS
show :: Button -> String
$cshow :: Button -> String
showsPrec :: Int -> Button -> ShowS
$cshowsPrec :: Int -> Button -> ShowS
Show, (forall x. Button -> Rep Button x)
-> (forall x. Rep Button x -> Button) -> Generic Button
forall x. Rep Button x -> Button
forall x. Button -> Rep Button x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Button x -> Button
$cfrom :: forall x. Button -> Rep Button x
Generic)
    deriving (Int -> Button -> Builder
Int -> Button -> Text
Int -> Button -> Text
[Button] -> Builder
[Button] -> Text
[Button] -> Text
Button -> Builder
Button -> Text
Button -> Text
(Int -> Button -> Builder)
-> (Button -> Builder)
-> ([Button] -> Builder)
-> (Int -> Button -> Text)
-> (Button -> Text)
-> ([Button] -> Text)
-> (Int -> Button -> Text)
-> (Button -> Text)
-> ([Button] -> Text)
-> TextShow Button
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 :: [Button] -> Text
$cshowtlList :: [Button] -> Text
showtl :: Button -> Text
$cshowtl :: Button -> Text
showtlPrec :: Int -> Button -> Text
$cshowtlPrec :: Int -> Button -> Text
showtList :: [Button] -> Text
$cshowtList :: [Button] -> Text
showt :: Button -> Text
$cshowt :: Button -> Text
showtPrec :: Int -> Button -> Text
$cshowtPrec :: Int -> Button -> Text
showbList :: [Button] -> Builder
$cshowbList :: [Button] -> Builder
showb :: Button -> Builder
$cshowb :: Button -> Builder
showbPrec :: Int -> Button -> Builder
$cshowbPrec :: Int -> Button -> Builder
TextShow) via TSG.FromGeneric Button
    deriving ([Button] -> Encoding
[Button] -> Value
Button -> Encoding
Button -> Value
(Button -> Value)
-> (Button -> Encoding)
-> ([Button] -> Value)
-> ([Button] -> Encoding)
-> ToJSON Button
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Button] -> Encoding
$ctoEncodingList :: [Button] -> Encoding
toJSONList :: [Button] -> Value
$ctoJSONList :: [Button] -> Value
toEncoding :: Button -> Encoding
$ctoEncoding :: Button -> Encoding
toJSON :: Button -> Value
$ctoJSON :: Button -> Value
ToJSON) via CalamityJSONKeepNothing Button
    deriving
        (Value -> Parser [Button]
Value -> Parser Button
(Value -> Parser Button)
-> (Value -> Parser [Button]) -> FromJSON Button
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Button]
$cparseJSONList :: Value -> Parser [Button]
parseJSON :: Value -> Parser Button
$cparseJSON :: Value -> Parser Button
FromJSON)
        via WithSpecialCases
                '["disabled" `IfNoneThen` DefaultToFalse]
                Button

data ButtonStyle
    = ButtonPrimary
    | ButtonSecondary
    | ButtonSuccess
    | ButtonDanger
    | ButtonLink
    deriving (Int -> ButtonStyle -> ShowS
[ButtonStyle] -> ShowS
ButtonStyle -> String
(Int -> ButtonStyle -> ShowS)
-> (ButtonStyle -> String)
-> ([ButtonStyle] -> ShowS)
-> Show ButtonStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ButtonStyle] -> ShowS
$cshowList :: [ButtonStyle] -> ShowS
show :: ButtonStyle -> String
$cshow :: ButtonStyle -> String
showsPrec :: Int -> ButtonStyle -> ShowS
$cshowsPrec :: Int -> ButtonStyle -> ShowS
Show, (forall x. ButtonStyle -> Rep ButtonStyle x)
-> (forall x. Rep ButtonStyle x -> ButtonStyle)
-> Generic ButtonStyle
forall x. Rep ButtonStyle x -> ButtonStyle
forall x. ButtonStyle -> Rep ButtonStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ButtonStyle x -> ButtonStyle
$cfrom :: forall x. ButtonStyle -> Rep ButtonStyle x
Generic)
    deriving (Int -> ButtonStyle -> Builder
Int -> ButtonStyle -> Text
Int -> ButtonStyle -> Text
[ButtonStyle] -> Builder
[ButtonStyle] -> Text
[ButtonStyle] -> Text
ButtonStyle -> Builder
ButtonStyle -> Text
ButtonStyle -> Text
(Int -> ButtonStyle -> Builder)
-> (ButtonStyle -> Builder)
-> ([ButtonStyle] -> Builder)
-> (Int -> ButtonStyle -> Text)
-> (ButtonStyle -> Text)
-> ([ButtonStyle] -> Text)
-> (Int -> ButtonStyle -> Text)
-> (ButtonStyle -> Text)
-> ([ButtonStyle] -> Text)
-> TextShow ButtonStyle
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 :: [ButtonStyle] -> Text
$cshowtlList :: [ButtonStyle] -> Text
showtl :: ButtonStyle -> Text
$cshowtl :: ButtonStyle -> Text
showtlPrec :: Int -> ButtonStyle -> Text
$cshowtlPrec :: Int -> ButtonStyle -> Text
showtList :: [ButtonStyle] -> Text
$cshowtList :: [ButtonStyle] -> Text
showt :: ButtonStyle -> Text
$cshowt :: ButtonStyle -> Text
showtPrec :: Int -> ButtonStyle -> Text
$cshowtPrec :: Int -> ButtonStyle -> Text
showbList :: [ButtonStyle] -> Builder
$cshowbList :: [ButtonStyle] -> Builder
showb :: ButtonStyle -> Builder
$cshowb :: ButtonStyle -> Builder
showbPrec :: Int -> ButtonStyle -> Builder
$cshowbPrec :: Int -> ButtonStyle -> Builder
TextShow) via TSG.FromGeneric ButtonStyle

{- | Constuct a non-disabled 'Button' with the given 'ButtonStyle', all other
 fields are set to 'Nothing'
-}
button :: ButtonStyle -> Button
button :: ButtonStyle -> Button
button ButtonStyle
s = ButtonStyle
-> Maybe Text
-> Maybe (Partial Emoji)
-> Maybe Text
-> Maybe Text
-> Bool
-> Button
Button ButtonStyle
s Maybe Text
forall a. Maybe a
Nothing Maybe (Partial Emoji)
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Bool
False

{- | Constuct a non-disabled 'Button' with the given 'ButtonStyle' and label,
 all other fields are set to 'Nothing'
-}
button' :: ButtonStyle -> L.Text -> Button
button' :: ButtonStyle -> Text -> Button
button' ButtonStyle
s Text
l = ButtonStyle
-> Maybe Text
-> Maybe (Partial Emoji)
-> Maybe Text
-> Maybe Text
-> Bool
-> Button
Button ButtonStyle
s (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l) Maybe (Partial Emoji)
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Bool
False

instance ToJSON ButtonStyle where
    toJSON :: ButtonStyle -> Value
toJSON ButtonStyle
t = ToJSON Int => Int -> Value
forall a. ToJSON a => a -> Value
toJSON @Int (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ case ButtonStyle
t of
        ButtonStyle
ButtonPrimary -> Int
1
        ButtonStyle
ButtonSecondary -> Int
2
        ButtonStyle
ButtonSuccess -> Int
3
        ButtonStyle
ButtonDanger -> Int
4
        ButtonStyle
ButtonLink -> Int
5

instance FromJSON ButtonStyle where
    parseJSON :: Value -> Parser ButtonStyle
parseJSON = String
-> (Scientific -> Parser ButtonStyle)
-> Value
-> Parser ButtonStyle
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"ChannelType" ((Scientific -> Parser ButtonStyle) -> Value -> Parser ButtonStyle)
-> (Scientific -> Parser ButtonStyle)
-> Value
-> Parser ButtonStyle
forall a b. (a -> b) -> a -> b
$ \Scientific
n -> case Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger @Int Scientific
n of
        Just Int
v -> case Int
v of
            Int
1 -> ButtonStyle -> Parser ButtonStyle
forall (f :: * -> *) a. Applicative f => a -> f a
pure ButtonStyle
ButtonPrimary
            Int
2 -> ButtonStyle -> Parser ButtonStyle
forall (f :: * -> *) a. Applicative f => a -> f a
pure ButtonStyle
ButtonSecondary
            Int
3 -> ButtonStyle -> Parser ButtonStyle
forall (f :: * -> *) a. Applicative f => a -> f a
pure ButtonStyle
ButtonSuccess
            Int
4 -> ButtonStyle -> Parser ButtonStyle
forall (f :: * -> *) a. Applicative f => a -> f a
pure ButtonStyle
ButtonDanger
            Int
5 -> ButtonStyle -> Parser ButtonStyle
forall (f :: * -> *) a. Applicative f => a -> f a
pure ButtonStyle
ButtonLink
            Int
_ -> String -> Parser ButtonStyle
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ButtonStyle) -> String -> Parser ButtonStyle
forall a b. (a -> b) -> a -> b
$ String
"Invalid ButtonStyle: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
n
        Maybe Int
Nothing -> String -> Parser ButtonStyle
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ButtonStyle) -> String -> Parser ButtonStyle
forall a b. (a -> b) -> a -> b
$ String
"Invalid ButtonStyle: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
n

data Component
    = Button' Button
    | ActionRow' [Component]
    deriving (Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
(Int -> Component -> ShowS)
-> (Component -> String)
-> ([Component] -> ShowS)
-> Show Component
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Int -> Component -> ShowS
$cshowsPrec :: Int -> Component -> ShowS
Show, (forall x. Component -> Rep Component x)
-> (forall x. Rep Component x -> Component) -> Generic Component
forall x. Rep Component x -> Component
forall x. Component -> Rep Component x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Component x -> Component
$cfrom :: forall x. Component -> Rep Component x
Generic)
    deriving (Int -> Component -> Builder
Int -> Component -> Text
Int -> Component -> Text
[Component] -> Builder
[Component] -> Text
[Component] -> Text
Component -> Builder
Component -> Text
Component -> Text
(Int -> Component -> Builder)
-> (Component -> Builder)
-> ([Component] -> Builder)
-> (Int -> Component -> Text)
-> (Component -> Text)
-> ([Component] -> Text)
-> (Int -> Component -> Text)
-> (Component -> Text)
-> ([Component] -> Text)
-> TextShow Component
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 :: [Component] -> Text
$cshowtlList :: [Component] -> Text
showtl :: Component -> Text
$cshowtl :: Component -> Text
showtlPrec :: Int -> Component -> Text
$cshowtlPrec :: Int -> Component -> Text
showtList :: [Component] -> Text
$cshowtList :: [Component] -> Text
showt :: Component -> Text
$cshowt :: Component -> Text
showtPrec :: Int -> Component -> Text
$cshowtPrec :: Int -> Component -> Text
showbList :: [Component] -> Builder
$cshowbList :: [Component] -> Builder
showb :: Component -> Builder
$cshowb :: Component -> Builder
showbPrec :: Int -> Component -> Builder
$cshowbPrec :: Int -> Component -> Builder
TextShow) via TSG.FromGeneric Component

instance ToJSON Component where
    toJSON :: Component -> Value
toJSON Component
t =
        let (Object Object
inner, Int
type_) = case Component
t of
                ActionRow' [Component]
xs -> (Object -> Value
Object (Text
"components" Text -> [Component] -> Object
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Component]
xs), Int
1 :: Int)
                Button' Button
b -> (Button -> Value
forall a. ToJSON a => a -> Value
toJSON Button
b, Int
2 :: Int)
         in Object -> Value
Object (Object
inner Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> (Text
"type" Text -> Int -> Object
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
type_))

instance FromJSON Component where
    parseJSON :: Value -> Parser Component
parseJSON = String -> (Object -> Parser Component) -> Value -> Parser Component
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Component" ((Object -> Parser Component) -> Value -> Parser Component)
-> (Object -> Parser Component) -> Value -> Parser Component
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
        Int
type_ :: Int <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"

        case Int
type_ of
            Int
1 -> do
                [Component] -> Component
ActionRow' ([Component] -> Component)
-> Parser [Component] -> Parser Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Component]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"components"
            Int
2 -> Button -> Component
Button' (Button -> Component) -> Parser Button -> Parser Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Button
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
            Int
_ -> String -> Parser Component
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Component) -> String -> Parser Component
forall a b. (a -> b) -> a -> b
$ String
"Invalid ComponentType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
type_

componentType :: Component -> ComponentType
componentType :: Component -> ComponentType
componentType (ActionRow' [Component]
_) = ComponentType
ActionRowType
componentType (Button' Button
_) = ComponentType
ButtonType

data ComponentType
    = ActionRowType
    | ButtonType
    deriving (Int -> ComponentType -> ShowS
[ComponentType] -> ShowS
ComponentType -> String
(Int -> ComponentType -> ShowS)
-> (ComponentType -> String)
-> ([ComponentType] -> ShowS)
-> Show ComponentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentType] -> ShowS
$cshowList :: [ComponentType] -> ShowS
show :: ComponentType -> String
$cshow :: ComponentType -> String
showsPrec :: Int -> ComponentType -> ShowS
$cshowsPrec :: Int -> ComponentType -> ShowS
Show, (forall x. ComponentType -> Rep ComponentType x)
-> (forall x. Rep ComponentType x -> ComponentType)
-> Generic ComponentType
forall x. Rep ComponentType x -> ComponentType
forall x. ComponentType -> Rep ComponentType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComponentType x -> ComponentType
$cfrom :: forall x. ComponentType -> Rep ComponentType x
Generic)
    deriving (Int -> ComponentType -> Builder
Int -> ComponentType -> Text
Int -> ComponentType -> Text
[ComponentType] -> Builder
[ComponentType] -> Text
[ComponentType] -> Text
ComponentType -> Builder
ComponentType -> Text
ComponentType -> Text
(Int -> ComponentType -> Builder)
-> (ComponentType -> Builder)
-> ([ComponentType] -> Builder)
-> (Int -> ComponentType -> Text)
-> (ComponentType -> Text)
-> ([ComponentType] -> Text)
-> (Int -> ComponentType -> Text)
-> (ComponentType -> Text)
-> ([ComponentType] -> Text)
-> TextShow ComponentType
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 :: [ComponentType] -> Text
$cshowtlList :: [ComponentType] -> Text
showtl :: ComponentType -> Text
$cshowtl :: ComponentType -> Text
showtlPrec :: Int -> ComponentType -> Text
$cshowtlPrec :: Int -> ComponentType -> Text
showtList :: [ComponentType] -> Text
$cshowtList :: [ComponentType] -> Text
showt :: ComponentType -> Text
$cshowt :: ComponentType -> Text
showtPrec :: Int -> ComponentType -> Text
$cshowtPrec :: Int -> ComponentType -> Text
showbList :: [ComponentType] -> Builder
$cshowbList :: [ComponentType] -> Builder
showb :: ComponentType -> Builder
$cshowb :: ComponentType -> Builder
showbPrec :: Int -> ComponentType -> Builder
$cshowbPrec :: Int -> ComponentType -> Builder
TextShow) via TSG.FromGeneric ComponentType

instance ToJSON ComponentType where
    toJSON :: ComponentType -> Value
toJSON ComponentType
x = ToJSON Int => Int -> Value
forall a. ToJSON a => a -> Value
toJSON @Int (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ case ComponentType
x of
        ComponentType
ActionRowType -> Int
1
        ComponentType
ButtonType -> Int
2

instance FromJSON ComponentType where
    parseJSON :: Value -> Parser ComponentType
parseJSON = String
-> (Scientific -> Parser ComponentType)
-> Value
-> Parser ComponentType
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"ComponentType" ((Scientific -> Parser ComponentType)
 -> Value -> Parser ComponentType)
-> (Scientific -> Parser ComponentType)
-> Value
-> Parser ComponentType
forall a b. (a -> b) -> a -> b
$ \Scientific
n -> case Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger @Int Scientific
n of
        Just Int
1 -> ComponentType -> Parser ComponentType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComponentType
ActionRowType
        Just Int
2 -> ComponentType -> Parser ComponentType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComponentType
ButtonType
        Maybe Int
_ -> String -> Parser ComponentType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ComponentType) -> String -> Parser ComponentType
forall a b. (a -> b) -> a -> b
$ String
"Invalid ComponentType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
n