{-# LANGUAGE TemplateHaskell #-}

-- | 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.Utils (CalamityToJSON (..), CalamityToJSON' (..), (.=), (.?=))
import Calamity.Types.Model.Guild.Emoji
import Control.Monad (replicateM)
import Data.Aeson ((.!=), (.:), (.:?))
import qualified Data.Aeson as Aeson
import Data.Scientific (toBoundedInteger)
import qualified Data.Text as T
import Optics.TH
import System.Random (Uniform)
import System.Random.Stateful (Uniform (uniformM), UniformRange (uniformRM))
import TextShow.TH
import Data.Maybe (catMaybes)

newtype CustomID = CustomID T.Text
  deriving stock (CustomID -> CustomID -> Bool
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
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
Ord, Int -> CustomID -> ShowS
[CustomID] -> ShowS
CustomID -> String
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)
  deriving ([CustomID] -> Encoding
[CustomID] -> Value
CustomID -> Encoding
CustomID -> Value
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
Aeson.ToJSON, Value -> Parser [CustomID]
Value -> Parser 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
Aeson.FromJSON) via T.Text

$(deriveTextShow ''CustomID)

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

data ComponentType
  = ActionRowType
  | ButtonType
  | SelectType
  | TextInputType
  deriving (ComponentType -> ComponentType -> Bool
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
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)

$(deriveTextShow ''ComponentType)

instance Aeson.ToJSON ComponentType where
  toJSON :: ComponentType -> Value
toJSON ComponentType
x = forall a. ToJSON a => a -> Value
Aeson.toJSON @Int 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
  toEncoding :: ComponentType -> Encoding
toEncoding ComponentType
x = forall a. ToJSON a => a -> Encoding
Aeson.toEncoding @Int 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 Aeson.FromJSON ComponentType where
  parseJSON :: Value -> Parser ComponentType
parseJSON = forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
Aeson.withScientific String
"Components.ComponentType" forall a b. (a -> b) -> a -> b
$ \Scientific
n -> case forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger @Int Scientific
n of
    Just Int
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ComponentType
ActionRowType
    Just Int
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ComponentType
ButtonType
    Just Int
3 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ComponentType
SelectType
    Just Int
4 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ComponentType
TextInputType
    Maybe Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid ComponentType: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Scientific
n

data ButtonStyle
  = ButtonPrimary
  | ButtonSecondary
  | ButtonSuccess
  | ButtonDanger
  | ButtonLink
  deriving (ButtonStyle -> ButtonStyle -> Bool
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
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)

$(deriveTextShow ''ButtonStyle)

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

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
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)
  deriving ([Button] -> Encoding
[Button] -> Value
Button -> Encoding
Button -> Value
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
Aeson.ToJSON) via CalamityToJSON Button

instance CalamityToJSON' Button where
  toPairs :: forall kv. KeyValue kv => Button -> [Maybe kv]
toPairs Button {Bool
Maybe Text
Maybe RawEmoji
CustomID
ButtonStyle
customID :: CustomID
disabled :: Bool
emoji :: Maybe RawEmoji
label :: Maybe Text
style :: ButtonStyle
$sel:customID:Button :: Button -> CustomID
$sel:disabled:Button :: Button -> Bool
$sel:emoji:Button :: Button -> Maybe RawEmoji
$sel:label:Button :: Button -> Maybe Text
$sel:style:Button :: Button -> ButtonStyle
..} =
    [ Key
"style" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= ButtonStyle
style
    , Key
"label" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe Text
label
    , Key
"emoji" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe RawEmoji
emoji
    , Key
"disabled" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Bool
disabled
    , Key
"custom_id" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= CustomID
customID
    , Key
"type" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= ComponentType
ButtonType
    ]

$(deriveTextShow ''Button)
$(makeFieldLabelsNoPrefix ''Button)


instance Aeson.FromJSON Button where
  parseJSON :: Value -> Parser Button
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Components.Button" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    ButtonStyle
-> Maybe Text -> Maybe RawEmoji -> Bool -> CustomID -> Button
Button
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"style"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"label"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"emoji"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disabled" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"custom_id"

data LinkButton = LinkButton
  { LinkButton -> ButtonStyle
style :: 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
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)
  deriving ([LinkButton] -> Encoding
[LinkButton] -> Value
LinkButton -> Encoding
LinkButton -> Value
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
Aeson.ToJSON) via CalamityToJSON LinkButton

instance CalamityToJSON' LinkButton where
  toPairs :: forall kv. KeyValue kv => LinkButton -> [Maybe kv]
toPairs LinkButton {Bool
Maybe Text
Maybe RawEmoji
Text
ButtonStyle
disabled :: Bool
url :: Text
emoji :: Maybe RawEmoji
label :: Maybe Text
style :: ButtonStyle
$sel:disabled:LinkButton :: LinkButton -> Bool
$sel:url:LinkButton :: LinkButton -> Text
$sel:emoji:LinkButton :: LinkButton -> Maybe RawEmoji
$sel:label:LinkButton :: LinkButton -> Maybe Text
$sel:style:LinkButton :: LinkButton -> ButtonStyle
..} =
      [ Key
"style" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= ButtonStyle
style
      , Key
"label" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe Text
label
      , Key
"emoji" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe RawEmoji
emoji
      , Key
"url" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Text
url
      , Key
"disabled" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Bool
disabled
      , Key
"type" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= ComponentType
ButtonType
      ]

instance Aeson.FromJSON LinkButton where
  parseJSON :: Value -> Parser LinkButton
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Components.Linkbutton" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    ButtonStyle
-> Maybe Text -> Maybe RawEmoji -> Text -> Bool -> LinkButton
LinkButton
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"style"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"label"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"emoji"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disabled" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

$(deriveTextShow ''LinkButton)
$(makeFieldLabelsNoPrefix ''LinkButton)

{- | 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 forall a. Maybe a
Nothing 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 (forall a. a -> Maybe a
Just Text
l) 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 forall a. Maybe a
Nothing 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 (forall a. a -> Maybe a
Just Text
lbl) forall a. Maybe a
Nothing Text
lnk Bool
False

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
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)
  deriving ([SelectOption] -> Encoding
[SelectOption] -> Value
SelectOption -> Encoding
SelectOption -> Value
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
Aeson.ToJSON) via CalamityToJSON SelectOption

instance CalamityToJSON' SelectOption where
  toPairs :: forall kv. KeyValue kv => SelectOption -> [Maybe kv]
toPairs SelectOption {Bool
Maybe Text
Maybe RawEmoji
Text
default_ :: Bool
emoji :: Maybe RawEmoji
description :: Maybe Text
value :: Text
label :: Text
$sel:default_:SelectOption :: SelectOption -> Bool
$sel:emoji:SelectOption :: SelectOption -> Maybe RawEmoji
$sel:description:SelectOption :: SelectOption -> Maybe Text
$sel:value:SelectOption :: SelectOption -> Text
$sel:label:SelectOption :: SelectOption -> Text
..} =
      [ Key
"label" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Text
label
      , Key
"value" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Text
value
      , Key
"description" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe Text
description
      , Key
"emoji" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe RawEmoji
emoji
      , Key
"default" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Bool
default_
      ]

instance Aeson.FromJSON SelectOption where
  parseJSON :: Value -> Parser SelectOption
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Components.SelectOption" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text
-> Text -> Maybe Text -> Maybe RawEmoji -> Bool -> SelectOption
SelectOption
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"label"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"emoji"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

$(deriveTextShow ''SelectOption)
$(makeFieldLabelsNoPrefix ''SelectOption)

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
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)
  deriving ([Select] -> Encoding
[Select] -> Value
Select -> Encoding
Select -> Value
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
Aeson.ToJSON) via CalamityToJSON Select

instance CalamityToJSON' Select where
  toPairs :: forall kv. KeyValue kv => Select -> [Maybe kv]
toPairs Select {Bool
[SelectOption]
Maybe Int
Maybe Text
CustomID
customID :: CustomID
disabled :: Bool
maxValues :: Maybe Int
minValues :: Maybe Int
placeholder :: Maybe Text
options :: [SelectOption]
$sel:customID:Select :: Select -> CustomID
$sel:disabled:Select :: Select -> Bool
$sel:maxValues:Select :: Select -> Maybe Int
$sel:minValues:Select :: Select -> Maybe Int
$sel:placeholder:Select :: Select -> Maybe Text
$sel:options:Select :: Select -> [SelectOption]
..} =
      [ Key
"options" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= [SelectOption]
options
      , Key
"placeholder" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe Text
placeholder
      , Key
"min_values" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe Int
minValues
      , Key
"max_values" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe Int
maxValues
      , Key
"disabled" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Bool
disabled
      , Key
"custom_id" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= CustomID
customID
      , Key
"type" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= ComponentType
SelectType
      ]

instance Aeson.FromJSON Select where
  parseJSON :: Value -> Parser Select
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Components.Select" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    [SelectOption]
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Bool
-> CustomID
-> Select
Select
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"options"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"placeholder"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"min_values"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_values"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disabled" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"custom_id"

$(deriveTextShow ''Select)
$(makeFieldLabelsNoPrefix ''Select)

select :: [SelectOption] -> CustomID -> Select
select :: [SelectOption] -> CustomID -> Select
select [SelectOption]
o = [SelectOption]
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Bool
-> CustomID
-> Select
Select [SelectOption]
o forall a. Maybe a
Nothing forall a. Maybe a
Nothing 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing Bool
False

data TextInputStyle
  = TextInputShort
  | TextInputParagraph
  deriving (Int -> TextInputStyle -> ShowS
[TextInputStyle] -> ShowS
TextInputStyle -> String
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)

$(deriveTextShow ''TextInputStyle)

instance Aeson.ToJSON TextInputStyle where
  toJSON :: TextInputStyle -> Value
toJSON TextInputStyle
t = forall a. ToJSON a => a -> Value
Aeson.toJSON @Int forall a b. (a -> b) -> a -> b
$ case TextInputStyle
t of
    TextInputStyle
TextInputShort -> Int
1
    TextInputStyle
TextInputParagraph -> Int
2
  toEncoding :: TextInputStyle -> Encoding
toEncoding TextInputStyle
t = forall a. ToJSON a => a -> Encoding
Aeson.toEncoding @Int forall a b. (a -> b) -> a -> b
$ case TextInputStyle
t of
    TextInputStyle
TextInputShort -> Int
1
    TextInputStyle
TextInputParagraph -> Int
2

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

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
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)
  deriving ([TextInput] -> Encoding
[TextInput] -> Value
TextInput -> Encoding
TextInput -> Value
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
Aeson.ToJSON) via CalamityToJSON TextInput

instance CalamityToJSON' TextInput where
  toPairs :: forall kv. KeyValue kv => TextInput -> [Maybe kv]
toPairs TextInput {Bool
Maybe Int
Maybe Text
Text
CustomID
TextInputStyle
customID :: CustomID
placeholder :: Maybe Text
value :: Maybe Text
required :: Bool
maxLength :: Maybe Int
minLength :: Maybe Int
label :: Text
style :: TextInputStyle
$sel:customID:TextInput :: TextInput -> CustomID
$sel:placeholder:TextInput :: TextInput -> Maybe Text
$sel:value:TextInput :: TextInput -> Maybe Text
$sel:required:TextInput :: TextInput -> Bool
$sel:maxLength:TextInput :: TextInput -> Maybe Int
$sel:minLength:TextInput :: TextInput -> Maybe Int
$sel:label:TextInput :: TextInput -> Text
$sel:style:TextInput :: TextInput -> TextInputStyle
..} =
      [ Key
"style" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= TextInputStyle
style
      , Key
"label" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Text
label
      , Key
"min_length" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Maybe Int
minLength
      , Key
"max_length" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Maybe Int
maxLength
      , Key
"required" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Bool
required
      , Key
"value" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Maybe Text
value
      , Key
"placeholder" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Maybe Text
placeholder
      , Key
"custom_id" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= CustomID
customID
      , Key
"type" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= ComponentType
TextInputType
      ]

instance Aeson.FromJSON TextInput where
  parseJSON :: Value -> Parser TextInput
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Components.TextInput" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    TextInputStyle
-> Text
-> Maybe Int
-> Maybe Int
-> Bool
-> Maybe Text
-> Maybe Text
-> CustomID
-> TextInput
TextInput
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"style"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"label"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"min_length"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_length"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"required" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"value"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"placeholder"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"custom_id"

$(deriveTextShow ''TextInput)
$(makeFieldLabelsNoPrefix ''TextInput)

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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing Bool
True forall a. Maybe a
Nothing 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
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)

$(deriveTextShow ''Component)

instance Aeson.ToJSON Component where
  toJSON :: Component -> Value
toJSON Component
t =
    case Component
t of
      ActionRow' [Component]
xs -> [Pair] -> Value
Aeson.object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ [Key
"components" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= [Component]
xs, Key
"type" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= ComponentType
ActionRowType]
      Button' Button
b -> forall a. ToJSON a => a -> Value
Aeson.toJSON Button
b
      LinkButton' LinkButton
lb -> forall a. ToJSON a => a -> Value
Aeson.toJSON LinkButton
lb
      Select' Select
s -> forall a. ToJSON a => a -> Value
Aeson.toJSON Select
s
      TextInput' TextInput
ti -> forall a. ToJSON a => a -> Value
Aeson.toJSON TextInput
ti

  toEncoding :: Component -> Encoding
toEncoding Component
t =
    case Component
t of
      ActionRow' [Component]
xs -> Series -> Encoding
Aeson.pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ [Key
"components" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= [Component]
xs, Key
"type" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= ComponentType
ActionRowType]
      Button' Button
b -> forall a. ToJSON a => a -> Encoding
Aeson.toEncoding Button
b
      LinkButton' LinkButton
lb -> forall a. ToJSON a => a -> Encoding
Aeson.toEncoding LinkButton
lb
      Select' Select
s -> forall a. ToJSON a => a -> Encoding
Aeson.toEncoding Select
s
      TextInput' TextInput
ti -> forall a. ToJSON a => a -> Encoding
Aeson.toEncoding TextInput
ti

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

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

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