content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  
  -- | Message components
  module Discord.Internal.Types.Components
    ( ActionRow (..),
      Button (..),
      ButtonStyle (..),
      mkButton,
      SelectMenu (..),
      mkSelectMenu,
      SelectMenuData (..),
      SelectOption (..),
      mkSelectOption,
      TextInput (..),
      mkTextInput,
    )
  where
  
  import Data.Aeson
  import Data.Aeson.Types (Parser)
  import Data.Foldable (Foldable (toList))
  import Data.Scientific (Scientific)
  import qualified Data.Text as T
  import Discord.Internal.Types.Emoji (Emoji)
  import Discord.Internal.Types.Prelude (objectFromMaybes, (.==), (.=?), ChannelTypeOption)
  
  -- | Container for other message Components
  data ActionRow = ActionRowButtons [Button] | ActionRowSelectMenu SelectMenu
    deriving (Show, Read, Eq, Ord)
  
  instance FromJSON ActionRow where
    parseJSON =
      withObject
        "ActionRow"
        ( \cs -> do
            t <- cs .: "type" :: Parser Int
            case t of
              1 -> do
                a <- cs .: "components" :: Parser Array
                let a' = toList a
                case a' of
                  [] -> return $ ActionRowButtons []
                  (c : _) ->
                    withObject
                      "ActionRow item"
                      ( \v -> do
                          t' <- v .: "type" :: Parser Int
                          case t' of
                            2 -> ActionRowButtons <$> mapM parseJSON a'
                            _ | t' `elem` [3, 5, 6, 7, 8] -> ActionRowSelectMenu <$> parseJSON c
                            _ -> fail $ "unknown component type: " ++ show t'
                      )
                      c
              _ -> fail $ "expected action row type (1), got: " ++ show t
        )
  
  instance ToJSON ActionRow where
    toJSON (ActionRowButtons bs) = object [("type", Number 1), ("components", toJSON bs)]
    toJSON (ActionRowSelectMenu bs) = object [("type", Number 1), ("components", toJSON [bs])]
  
  -- | Component type for a button, split into URL button and not URL button.
  --
  -- Don't directly send button components - they need to be within an action row.
  data Button
    = Button
        { -- | Dev indentifier
          buttonCustomId :: T.Text,
          -- | Whether the button is disabled
          buttonDisabled :: Bool,
          -- | What is the style of the button
          buttonStyle :: ButtonStyle,
          -- | What is the user-facing label of the button
          buttonLabel :: Maybe T.Text,
          -- | What emoji is displayed on the button
          buttonEmoji :: Maybe Emoji
        }
    | ButtonUrl
        { -- | The url for the button. If this is not a valid url, everything will
          -- break
          buttonUrl :: T.Text,
          -- | Whether the button is disabled
          buttonDisabled :: Bool,
          -- | What is the user-facing label of the button
          buttonLabel :: Maybe T.Text,
          -- | What emoji is displayed on the button
          buttonEmoji :: Maybe Emoji
        }
    deriving (Show, Read, Eq, Ord)
  
  -- | Takes the label and the custom id of the button that is to be generated.
  mkButton :: T.Text -> T.Text -> Button
  mkButton label customId = Button customId False ButtonStyleSecondary (Just label) Nothing
  
  instance FromJSON Button where
    parseJSON =
      withObject
        "Button"
        ( \v -> do
            t <- v .: "type" :: Parser Int
            case t of
              2 -> do
                disabled <- v .:? "disabled" .!= False
                label <- v .:? "label"
                partialEmoji <- v .:? "emoji"
                style <- v .: "style" :: Parser Scientific
                case style of
                  5 ->
                    ButtonUrl
                      <$> v .: "url"
                      <*> return disabled
                      <*> return label
                      <*> return partialEmoji
                  _ ->
                    Button
                      <$> v .: "custom_id"
                      <*> return disabled
                      <*> parseJSON (Number style)
                      <*> return label
                      <*> return partialEmoji
              _ -> fail "expected button type, got a different component"
        )
  
  instance ToJSON Button where
    toJSON ButtonUrl {..} =
      objectFromMaybes
        [ "type" .== Number 2,
          "style" .== Number 5,
          "label" .=? buttonLabel,
          "disabled" .== buttonDisabled,
          "url" .== buttonUrl,
          "emoji" .=? buttonEmoji
        ]
    toJSON Button {..} =
      objectFromMaybes
        [ "type" .== Number 2,
          "style" .== buttonStyle,
          "label" .=? buttonLabel,
          "disabled" .== buttonDisabled,
          "custom_id" .== buttonCustomId,
          "emoji" .=? buttonEmoji
        ]
  
  -- | Buttton colors.
  data ButtonStyle
    = -- | Blurple button
      ButtonStylePrimary
    | -- | Grey button
      ButtonStyleSecondary
    | -- | Green button
      ButtonStyleSuccess
    | -- | Red button
      ButtonStyleDanger
    deriving (Show, Read, Eq, Ord)
  
  instance FromJSON ButtonStyle where
    parseJSON =
      withScientific
        "ButtonStyle"
        ( \case
            1 -> return ButtonStylePrimary
            2 -> return ButtonStyleSecondary
            3 -> return ButtonStyleSuccess
            4 -> return ButtonStyleDanger
            _ -> fail "unrecognised non-url button style"
        )
  
  instance ToJSON ButtonStyle where
    toJSON ButtonStylePrimary = Number 1
    toJSON ButtonStyleSecondary = Number 2
    toJSON ButtonStyleSuccess = Number 3
    toJSON ButtonStyleDanger = Number 4
  
  -- | Component type for a select menu.
  --
  -- Don't directly send select menus - they need to be within an action row.
  data SelectMenu = SelectMenu
    { -- | Dev identifier
      selectMenuCustomId :: T.Text,
      -- | Whether the select menu is disabled
      selectMenuDisabled :: Bool,
      -- | What type this select menu is, and the data it can hold
      selectMenuData :: SelectMenuData,
      -- | Placeholder text if nothing is selected
      selectMenuPlaceholder :: Maybe T.Text,
      -- | Minimum number of values to select (def 1, min 0, max 25)
      selectMenuMinValues :: Maybe Integer,
      -- | Maximum number of values to select (def 1, max 25)
      selectMenuMaxValues :: Maybe Integer
    }
    deriving (Show, Read, Eq, Ord)
  
  -- | Takes the custom id and the options of the select menu that is to be
  -- generated.
  mkSelectMenu :: T.Text -> [SelectOption] -> SelectMenu
  mkSelectMenu customId sos = SelectMenu customId False (SelectMenuDataText sos) Nothing Nothing Nothing
  
  instance FromJSON SelectMenu where
    parseJSON =
      withObject
        "SelectMenu"
        $ \v ->
            do
                  SelectMenu
                    <$> v .: "custom_id"
                    <*> v .:? "disabled" .!= False
                    <*> parseJSON (Object v)
                    <*> v .:? "placeholder"
                    <*> v .:? "min_values"
                    <*> v .:? "max_values"
        
  
  instance ToJSON SelectMenu where
    toJSON SelectMenu {..} =
      objectFromMaybes $
        [ "custom_id" .== selectMenuCustomId,
          "disabled" .== selectMenuDisabled,
          "placeholder" .=? selectMenuPlaceholder,
          "min_values" .=? selectMenuMinValues,
          "max_values" .=? selectMenuMaxValues
        ] <> case selectMenuData of
              SelectMenuDataText sos -> ["type" .== Number 3, "options" .== sos]
              SelectMenuDataUser -> ["type" .== Number 5]
              SelectMenuDataRole -> ["type" .== Number 6]
              SelectMenuDataMentionable -> ["type" .== Number 7]
              SelectMenuDataChannels ctos -> ["type" .== Number 8, "channel_types" .== ctos]
  
  data SelectMenuData = 
      SelectMenuDataText [SelectOption] -- ^ Text options
    | SelectMenuDataUser -- ^ Users
    | SelectMenuDataRole -- ^ Roles
    | SelectMenuDataMentionable -- ^ Anything mentionable (users and roles)
    | SelectMenuDataChannels [ChannelTypeOption] -- ^ Channels (of certain types)
    deriving (Show, Read, Eq, Ord)
  
  instance FromJSON SelectMenuData where
    parseJSON =
      withObject "SelectMenuData" $ \v ->
        do
          t <- v .: "type"
          case t::Int of
            3 -> SelectMenuDataText <$> v .: "options"
            5 -> pure SelectMenuDataUser
            6 -> pure SelectMenuDataRole
            7 -> pure SelectMenuDataMentionable
            8 -> SelectMenuDataChannels <$> v .: "channel_types"
            _ -> fail ("unknown select menu data type: " <> show t)
  
  -- | A single option in a select menu.
  data SelectOption = SelectOption
    { -- | User facing option name
      selectOptionLabel :: T.Text,
      -- | Dev facing option value
      selectOptionValue :: T.Text,
      -- | additional description
      selectOptionDescription :: Maybe T.Text,
      -- | A partial emoji to show with the object (id, name, animated)
      selectOptionEmoji :: Maybe Emoji,
      -- | Use this value by default
      selectOptionDefault :: Maybe Bool
    }
    deriving (Show, Read, Eq, Ord)
  
  -- | Make a select option from the given label and value.
  mkSelectOption :: T.Text -> T.Text -> SelectOption
  mkSelectOption label value = SelectOption label value Nothing Nothing Nothing
  
  instance FromJSON SelectOption where
    parseJSON = withObject "SelectOption" $ \o ->
      SelectOption <$> o .: "label"
        <*> o .: "value"
        <*> o .:? "description"
        <*> o .:? "emoji"
        <*> o .:? "default"
  
  instance ToJSON SelectOption where
    toJSON SelectOption {..} =
      objectFromMaybes
        [ "label" .== selectOptionLabel,
          "value" .== selectOptionValue,
          "description" .=? selectOptionDescription,
          "emoji" .=? selectOptionEmoji,
          "default" .=? selectOptionDefault
        ]
  
  data TextInput = TextInput
    { -- | Dev identifier
      textInputCustomId :: T.Text,
      -- | What style to use (short or paragraph)
      textInputIsParagraph :: Bool,
      -- | The label for this component
      textInputLabel :: T.Text,
      -- | The minimum input length for a text input (0-4000)
      textInputMinLength :: Maybe Integer,
      -- | The maximum input length for a text input (1-4000)
      textInputMaxLength :: Maybe Integer,
      -- | Whether this component is required to be filled
      textInputRequired :: Maybe Bool,
      -- | The prefilled value for this component (max 4000)
      textInputValue :: Maybe T.Text,
      -- | Placeholder text if empty (max 4000)
      textInputPlaceholder :: Maybe T.Text
    }
    deriving (Show, Read, Eq, Ord)
  
  instance ToJSON TextInput where
    toJSON TextInput {..} =
      objectFromMaybes
        [ "type" .== Number 4,
          "custom_id" .== textInputCustomId,
          "style" .== (1 + fromEnum textInputIsParagraph),
          "label" .== textInputLabel,
          "min_length" .=? textInputMinLength,
          "max_length" .=? textInputMaxLength,
          "required" .== textInputRequired,
          "value" .== textInputValue,
          "placeholder" .== textInputPlaceholder
        ]
  
  instance FromJSON TextInput where
    parseJSON = withObject "TextInput" $ \o -> do
      t <- o .: "type" :: Parser Int
      case t of
        4 ->
          TextInput <$> o .: "custom_id"
            <*> fmap (== (2 :: Int)) (o .:? "style" .!= 1)
            <*> o .:? "label" .!= ""
            <*> o .:? "min_length"
            <*> o .:? "max_length"
            <*> o .:? "required"
            <*> o .:? "value"
            <*> o .:? "placeholder"
        _ -> fail "expected text input, found other type of component"
  
  -- | Create a text input from an id and a label
  mkTextInput :: T.Text -> T.Text -> TextInput
  mkTextInput cid label = TextInput cid False label Nothing Nothing Nothing Nothing Nothing
  