{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Telegram.Bot.API.Types.MenuButton where

import Data.Aeson (KeyValue ((.=)), FromJSON (..), ToJSON (..), object)
import Data.Text (Text)
import GHC.Generics (Generic)

import Telegram.Bot.API.Types.Common
import Telegram.Bot.API.Internal.Utils

-- ** 'MenuButton'

-- | This object describes the bot's menu button in a private chat.
-- If a menu button other than @MenuButtonDefault@ is set for a private chat, then it is applied in the chat. Otherwise the default menu button is applied. By default, the menu button opens the list of bot commands.
data MenuButton
  = MenuButtonCommands -- ^ Represents a menu button, which opens the bot's list of commands.
  | MenuButtonWebApp -- ^ Represents a menu button, which launches a Web App.
      { MenuButton -> Text
menuButtonWebAppText :: Text
      , MenuButton -> WebAppInfo
menuButtonWebAppWebApp :: WebAppInfo
      } 
  | MenuButtonDefault -- ^ Describes that no specific value for the menu button was set.
  deriving forall x. Rep MenuButton x -> MenuButton
forall x. MenuButton -> Rep MenuButton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MenuButton x -> MenuButton
$cfrom :: forall x. MenuButton -> Rep MenuButton x
Generic

instance ToJSON MenuButton where
  toJSON :: MenuButton -> Value
toJSON = \case
    MenuButton
MenuButtonCommands ->
      [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"commands" []
    MenuButtonWebApp Text
txt WebAppInfo
wai ->
      [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"web_app" [Key
"text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
txt, Key
"web_app_info" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WebAppInfo
wai]
    MenuButton
MenuButtonDefault ->
      [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"default" []

instance FromJSON MenuButton where
  parseJSON :: Value -> Parser MenuButton
parseJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON