-- | Message components
module Calamity.Types.Model.Channel.Component (
  CustomID (..),
  Component (..),
  Button (..),
  LinkButton (..),
  button,
  button',
  lbutton,
  lbutton',
  ButtonStyle (..),
  Select (..),
  select,
  SelectOption (..),
  sopt,
  TextInput (..),
  TextInputStyle (..),
  textInput,
  ComponentType (..),
  componentType,
) where

import Calamity.Internal.AesonThings
import Calamity.Types.Model.Guild.Emoji
import Control.Monad (replicateM)
import Data.Aeson
import Data.Scientific (toBoundedInteger)
import qualified Data.Text as T
import GHC.Generics
import System.Random (Uniform)
import System.Random.Stateful (Uniform (uniformM), UniformRange (uniformRM))
import TextShow
import qualified TextShow.Generic as TSG

newtype CustomID = CustomID T.Text
  deriving stock (CustomID -> CustomID -> Bool
(CustomID -> CustomID -> Bool)
-> (CustomID -> CustomID -> Bool) -> Eq CustomID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomID -> CustomID -> Bool
$c/= :: CustomID -> CustomID -> Bool
== :: CustomID -> CustomID -> Bool
$c== :: CustomID -> CustomID -> Bool
Eq, Eq CustomID
Eq CustomID
-> (CustomID -> CustomID -> Ordering)
-> (CustomID -> CustomID -> Bool)
-> (CustomID -> CustomID -> Bool)
-> (CustomID -> CustomID -> Bool)
-> (CustomID -> CustomID -> Bool)
-> (CustomID -> CustomID -> CustomID)
-> (CustomID -> CustomID -> CustomID)
-> Ord CustomID
CustomID -> CustomID -> Bool
CustomID -> CustomID -> Ordering
CustomID -> CustomID -> CustomID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CustomID -> CustomID -> CustomID
$cmin :: CustomID -> CustomID -> CustomID
max :: CustomID -> CustomID -> CustomID
$cmax :: CustomID -> CustomID -> CustomID
>= :: CustomID -> CustomID -> Bool
$c>= :: CustomID -> CustomID -> Bool
> :: CustomID -> CustomID -> Bool
$c> :: CustomID -> CustomID -> Bool
<= :: CustomID -> CustomID -> Bool
$c<= :: CustomID -> CustomID -> Bool
< :: CustomID -> CustomID -> Bool
$c< :: CustomID -> CustomID -> Bool
compare :: CustomID -> CustomID -> Ordering
$ccompare :: CustomID -> CustomID -> Ordering
$cp1Ord :: Eq CustomID
Ord, Int -> CustomID -> ShowS
[CustomID] -> ShowS
CustomID -> String
(Int -> CustomID -> ShowS)
-> (CustomID -> String) -> ([CustomID] -> ShowS) -> Show CustomID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomID] -> ShowS
$cshowList :: [CustomID] -> ShowS
show :: CustomID -> String
$cshow :: CustomID -> String
showsPrec :: Int -> CustomID -> ShowS
$cshowsPrec :: Int -> CustomID -> ShowS
Show, (forall x. CustomID -> Rep CustomID x)
-> (forall x. Rep CustomID x -> CustomID) -> Generic CustomID
forall x. Rep CustomID x -> CustomID
forall x. CustomID -> Rep CustomID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CustomID x -> CustomID
$cfrom :: forall x. CustomID -> Rep CustomID x
Generic)
  deriving (Int -> CustomID -> Builder
Int -> CustomID -> Text
Int -> CustomID -> Text
[CustomID] -> Builder
[CustomID] -> Text
[CustomID] -> Text
CustomID -> Builder
CustomID -> Text
CustomID -> Text
(Int -> CustomID -> Builder)
-> (CustomID -> Builder)
-> ([CustomID] -> Builder)
-> (Int -> CustomID -> Text)
-> (CustomID -> Text)
-> ([CustomID] -> Text)
-> (Int -> CustomID -> Text)
-> (CustomID -> Text)
-> ([CustomID] -> Text)
-> TextShow CustomID
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 :: [CustomID] -> Text
$cshowtlList :: [CustomID] -> Text
showtl :: CustomID -> Text
$cshowtl :: CustomID -> Text
showtlPrec :: Int -> CustomID -> Text
$cshowtlPrec :: Int -> CustomID -> Text
showtList :: [CustomID] -> Text
$cshowtList :: [CustomID] -> Text
showt :: CustomID -> Text
$cshowt :: CustomID -> Text
showtPrec :: Int -> CustomID -> Text
$cshowtPrec :: Int -> CustomID -> Text
showbList :: [CustomID] -> Builder
$cshowbList :: [CustomID] -> Builder
showb :: CustomID -> Builder
$cshowb :: CustomID -> Builder
showbPrec :: Int -> CustomID -> Builder
$cshowbPrec :: Int -> CustomID -> Builder
TextShow) via TSG.FromGeneric CustomID
  deriving ([CustomID] -> Encoding
[CustomID] -> Value
CustomID -> Encoding
CustomID -> Value
(CustomID -> Value)
-> (CustomID -> Encoding)
-> ([CustomID] -> Value)
-> ([CustomID] -> Encoding)
-> ToJSON CustomID
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CustomID] -> Encoding
$ctoEncodingList :: [CustomID] -> Encoding
toJSONList :: [CustomID] -> Value
$ctoJSONList :: [CustomID] -> Value
toEncoding :: CustomID -> Encoding
$ctoEncoding :: CustomID -> Encoding
toJSON :: CustomID -> Value
$ctoJSON :: CustomID -> Value
ToJSON, Value -> Parser [CustomID]
Value -> Parser CustomID
(Value -> Parser CustomID)
-> (Value -> Parser [CustomID]) -> FromJSON CustomID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CustomID]
$cparseJSONList :: Value -> Parser [CustomID]
parseJSON :: Value -> Parser CustomID
$cparseJSON :: Value -> Parser CustomID
FromJSON) via T.Text

instance Uniform CustomID where
  uniformM :: g -> m CustomID
uniformM = ((Text -> CustomID
CustomID (Text -> CustomID) -> (String -> Text) -> String -> CustomID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (String -> CustomID) -> m String -> m CustomID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m String -> m CustomID) -> (g -> m String) -> g -> m CustomID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m Char -> m String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
16 (m Char -> m String) -> (g -> m Char) -> g -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Char) -> g -> m Char
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Char
'a', Char
'z')

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

data ButtonStyle
  = ButtonPrimary
  | ButtonSecondary
  | ButtonSuccess
  | ButtonDanger
  | ButtonLink
  deriving (ButtonStyle -> ButtonStyle -> Bool
(ButtonStyle -> ButtonStyle -> Bool)
-> (ButtonStyle -> ButtonStyle -> Bool) -> Eq ButtonStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ButtonStyle -> ButtonStyle -> Bool
$c/= :: ButtonStyle -> ButtonStyle -> Bool
== :: ButtonStyle -> ButtonStyle -> Bool
$c== :: ButtonStyle -> ButtonStyle -> Bool
Eq, 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

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
"ButtonStyle" ((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

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

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

{- | Constuct a non-disabled 'LinkButton' with the given 'ButtonStyle', link, all
   other fields are set to 'Nothing'
-}
lbutton ::
  ButtonStyle ->
  -- | The link to use
  T.Text ->
  LinkButton
lbutton :: ButtonStyle -> Text -> LinkButton
lbutton ButtonStyle
s Text
lnk = ButtonStyle
-> Maybe Text -> Maybe RawEmoji -> Text -> Bool -> LinkButton
LinkButton ButtonStyle
s Maybe Text
forall a. Maybe a
Nothing Maybe RawEmoji
forall a. Maybe a
Nothing Text
lnk Bool
False

{- | Constuct a non-disabled 'LinkButton' with the given 'ButtonStyle', link,
 and label, all other fields are set to 'Nothing'
-}
lbutton' ::
  ButtonStyle ->
  -- | The link to use
  T.Text ->
  -- | The label to use
  T.Text ->
  LinkButton
lbutton' :: ButtonStyle -> Text -> Text -> LinkButton
lbutton' ButtonStyle
s Text
lnk Text
lbl = ButtonStyle
-> Maybe Text -> Maybe RawEmoji -> Text -> Bool -> LinkButton
LinkButton ButtonStyle
s (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lbl) Maybe RawEmoji
forall a. Maybe a
Nothing Text
lnk Bool
False

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

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

select :: [SelectOption] -> CustomID -> Select
select :: [SelectOption] -> CustomID -> Select
select [SelectOption]
o = [SelectOption]
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Bool
-> CustomID
-> Select
Select [SelectOption]
o Maybe Text
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Bool
False

sopt ::
  -- | Label
  T.Text ->
  -- | Value
  T.Text ->
  SelectOption
sopt :: Text -> Text -> SelectOption
sopt Text
l Text
v = Text
-> Text -> Maybe Text -> Maybe RawEmoji -> Bool -> SelectOption
SelectOption Text
l Text
v Maybe Text
forall a. Maybe a
Nothing Maybe RawEmoji
forall a. Maybe a
Nothing Bool
False

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

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

instance ToJSON TextInputStyle where
  toJSON :: TextInputStyle -> Value
toJSON TextInputStyle
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 TextInputStyle
t of
    TextInputStyle
TextInputShort -> Int
1
    TextInputStyle
TextInputParagraph -> Int
2

instance FromJSON TextInputStyle where
  parseJSON :: Value -> Parser TextInputStyle
parseJSON = String
-> (Scientific -> Parser TextInputStyle)
-> Value
-> Parser TextInputStyle
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"TextInputStyle" ((Scientific -> Parser TextInputStyle)
 -> Value -> Parser TextInputStyle)
-> (Scientific -> Parser TextInputStyle)
-> Value
-> Parser TextInputStyle
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 -> TextInputStyle -> Parser TextInputStyle
forall (f :: * -> *) a. Applicative f => a -> f a
pure TextInputStyle
TextInputShort
      Int
2 -> TextInputStyle -> Parser TextInputStyle
forall (f :: * -> *) a. Applicative f => a -> f a
pure TextInputStyle
TextInputParagraph
      Int
_ -> String -> Parser TextInputStyle
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser TextInputStyle)
-> String -> Parser TextInputStyle
forall a b. (a -> b) -> a -> b
$ String
"Invalid TextInputStyle: " 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 TextInputStyle
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser TextInputStyle)
-> String -> Parser TextInputStyle
forall a b. (a -> b) -> a -> b
$ String
"Invalid TextInputStyle: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
n

textInput ::
  TextInputStyle ->
  -- | Label
  T.Text ->
  CustomID ->
  TextInput
textInput :: TextInputStyle -> Text -> CustomID -> TextInput
textInput TextInputStyle
s Text
l = TextInputStyle
-> Text
-> Maybe Int
-> Maybe Int
-> Bool
-> Maybe Text
-> Maybe Text
-> CustomID
-> TextInput
TextInput TextInputStyle
s Text
l Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Bool
True Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing

data Component
  = ActionRow' [Component]
  | Button' Button
  | LinkButton' LinkButton
  | Select' Select
  | TextInput' TextInput
  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 (Key
"components" Key -> [Component] -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Component]
xs), Int
1 :: Int)
          Button' Button
b -> (Button -> Value
forall a. ToJSON a => a -> Value
toJSON Button
b, Int
2 :: Int)
          LinkButton' LinkButton
lb -> (LinkButton -> Value
forall a. ToJSON a => a -> Value
toJSON LinkButton
lb, Int
2 :: Int)
          Select' Select
s -> (Select -> Value
forall a. ToJSON a => a -> Value
toJSON Select
s, Int
3 :: Int)
          TextInput' TextInput
ti -> (TextInput -> Value
forall a. ToJSON a => a -> Value
toJSON TextInput
ti, Int
4 :: Int)
     in Object -> Value
Object (Object
inner Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> (Key
"type" Key -> Int -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"

    case Int
type_ of
      Int
1 -> [Component] -> Component
ActionRow' ([Component] -> Component)
-> Parser [Component] -> Parser Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser [Component]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"components"
      Int
2 -> do
        Maybe CustomID
cid :: Maybe CustomID <- Object
v Object -> Key -> Parser (Maybe CustomID)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_id"
        Maybe Text
url :: Maybe T.Text <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url"
        case (Maybe CustomID
cid, Maybe Text
url) of
          (Just CustomID
_, Maybe Text
_) -> 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)
          (Maybe CustomID
_, Just Text
_) -> LinkButton -> Component
LinkButton' (LinkButton -> Component) -> Parser LinkButton -> Parser Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LinkButton
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
          (Maybe CustomID, Maybe Text)
_ -> 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
"Impossible button: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Object -> String
forall a. Show a => a -> String
show Object
v
      Int
3 -> Select -> Component
Select' (Select -> Component) -> Parser Select -> Parser Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Select
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
      Int
4 -> TextInput -> Component
TextInput' (TextInput -> Component) -> Parser TextInput -> Parser Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TextInput
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
componentType (LinkButton' LinkButton
_) = ComponentType
ButtonType
componentType (Select' Select
_) = ComponentType
SelectType
componentType (TextInput' TextInput
_) = ComponentType
TextInputType

data ComponentType
  = ActionRowType
  | ButtonType
  | SelectType
  | TextInputType
  deriving (ComponentType -> ComponentType -> Bool
(ComponentType -> ComponentType -> Bool)
-> (ComponentType -> ComponentType -> Bool) -> Eq ComponentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentType -> ComponentType -> Bool
$c/= :: ComponentType -> ComponentType -> Bool
== :: ComponentType -> ComponentType -> Bool
$c== :: ComponentType -> ComponentType -> Bool
Eq, 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
    ComponentType
SelectType -> Int
3
    ComponentType
TextInputType -> Int
4

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
    Just Int
3 -> ComponentType -> Parser ComponentType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComponentType
SelectType
    Just Int
4 -> ComponentType -> Parser ComponentType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComponentType
TextInputType
    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