{-# LANGUAGE DeriveGeneric #-}
module Telegram.Bot.API.Types.SomeReplyMarkup where

import Data.Aeson
import GHC.Generics (Generic)

import Telegram.Bot.API.Internal.Utils
import Telegram.Bot.API.Types.ForceReply
import Telegram.Bot.API.Types.InlineKeyboardMarkup
import Telegram.Bot.API.Types.ReplyKeyboardMarkup
import Telegram.Bot.API.Types.ReplyKeyboardRemove

-- | Additional interface options.
-- A JSON-serialized object for an inline keyboard, custom reply keyboard,
-- instructions to remove reply keyboard or to force a reply from the user.
data SomeReplyMarkup
  = SomeInlineKeyboardMarkup InlineKeyboardMarkup
  | SomeReplyKeyboardMarkup  ReplyKeyboardMarkup
  | SomeReplyKeyboardRemove  ReplyKeyboardRemove
  | SomeForceReply           ForceReply
  deriving ((forall x. SomeReplyMarkup -> Rep SomeReplyMarkup x)
-> (forall x. Rep SomeReplyMarkup x -> SomeReplyMarkup)
-> Generic SomeReplyMarkup
forall x. Rep SomeReplyMarkup x -> SomeReplyMarkup
forall x. SomeReplyMarkup -> Rep SomeReplyMarkup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SomeReplyMarkup -> Rep SomeReplyMarkup x
from :: forall x. SomeReplyMarkup -> Rep SomeReplyMarkup x
$cto :: forall x. Rep SomeReplyMarkup x -> SomeReplyMarkup
to :: forall x. Rep SomeReplyMarkup x -> SomeReplyMarkup
Generic)

instance ToJSON   SomeReplyMarkup where toJSON :: SomeReplyMarkup -> Value
toJSON = SomeReplyMarkup -> Value
forall a. (Generic a, GSomeJSON (Rep a)) => a -> Value
genericSomeToJSON
instance FromJSON SomeReplyMarkup where parseJSON :: Value -> Parser SomeReplyMarkup
parseJSON = Value -> Parser SomeReplyMarkup
forall a. (Generic a, GSomeJSON (Rep a)) => Value -> Parser a
genericSomeParseJSON