{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Telegram.Bot.API.Methods.GetMyName where

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Proxy
import GHC.Generics (Generic)
import Data.Text (Text)
import Servant.API
import Servant.Client hiding (Response)

import Telegram.Bot.API.Internal.Utils
import Telegram.Bot.API.MakingRequests
import Telegram.Bot.API.Types
import Telegram.Bot.API.Internal.TH

-- ** 'GetMyName'

newtype GetMyNameRequest = GetMyNameRequest
  { GetMyNameRequest -> Maybe Text
getMyNameLanguageCode :: Maybe Text -- ^ A two-letter ISO 639-1 language code or an empty string.
  }
  deriving (forall x. GetMyNameRequest -> Rep GetMyNameRequest x)
-> (forall x. Rep GetMyNameRequest x -> GetMyNameRequest)
-> Generic GetMyNameRequest
forall x. Rep GetMyNameRequest x -> GetMyNameRequest
forall x. GetMyNameRequest -> Rep GetMyNameRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetMyNameRequest -> Rep GetMyNameRequest x
from :: forall x. GetMyNameRequest -> Rep GetMyNameRequest x
$cto :: forall x. Rep GetMyNameRequest x -> GetMyNameRequest
to :: forall x. Rep GetMyNameRequest x -> GetMyNameRequest
Generic

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

type GetMyName = "getMyName"
  :> ReqBody '[JSON] GetMyNameRequest
  :> Post '[JSON] (Response BotName)

-- | Use this method to get the current bot name for the given user language.
--   Returns 'BotName' on success.
getMyName :: GetMyNameRequest -> ClientM (Response BotName)
getMyName :: GetMyNameRequest -> ClientM (Response BotName)
getMyName = Proxy GetMyName -> Client ClientM GetMyName
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @GetMyName)

makeDefault ''GetMyNameRequest