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

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Proxy
import Data.Text
import GHC.Generics (Generic)
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

-- ** 'sendVenue'

-- | Request parameters for 'sendVenue'.
data SendVenueRequest = SendVenueRequest
  { SendVenueRequest -> SomeChatId
sendVenueChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername).
  , SendVenueRequest -> Maybe MessageThreadId
sendVenueMessageThreadId :: Maybe MessageThreadId -- ^ Unique identifier for the target message thread (topic) of the forum; for forum supergroups only.
  , SendVenueRequest -> Float
sendVenueLatitude :: Float -- ^ Latitude of the venue
  , SendVenueRequest -> Float
sendVenueLongitude :: Float -- ^ Longitude of the venue
  , SendVenueRequest -> Text
sendVenueTitle :: Text -- ^ Name of the venue
  , SendVenueRequest -> Text
sendVenueAddress :: Text -- ^ Address of the venue
  , SendVenueRequest -> Maybe Text
sendVenueFoursquareId :: Maybe Text -- ^ Foursquare identifier of the venue
  , SendVenueRequest -> Maybe Text
sendVenueFoursquareType :: Maybe Text -- ^ Foursquare type of the venue, if known. (For example, “arts_entertainment/default”, “arts_entertainment/aquarium” or “food/icecream”.)
  , SendVenueRequest -> Maybe Text
sendVenueGooglePlaceId :: Maybe Text -- ^ Google Places identifier of the venue
  , SendVenueRequest -> Maybe Text
sendVenueGooglePlaceType :: Maybe Text -- ^ Google Places type of the venue. (See supported types <https:\/\/developers.google.com\/maps\/documentation\/places\/web-service\/supported_types>.)
  , SendVenueRequest -> Maybe Bool
sendVenueDisableNotification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound.
  , SendVenueRequest -> Maybe Bool
sendVenueProtectContent :: Maybe Bool -- ^ Protects the contents of the sent message from forwarding and saving
  , SendVenueRequest -> Maybe MessageId
sendVenueReplyToMessageId :: Maybe MessageId -- ^ If the message is a reply, ID of the original message
  , SendVenueRequest -> Maybe ReplyParameters
sendVenueReplyParameters :: Maybe ReplyParameters -- ^ Description of the message to reply to.
  , SendVenueRequest -> Maybe InlineKeyboardMarkup
sendVenueReplyMarkup :: Maybe InlineKeyboardMarkup -- ^ 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.
  }
  deriving (forall x. SendVenueRequest -> Rep SendVenueRequest x)
-> (forall x. Rep SendVenueRequest x -> SendVenueRequest)
-> Generic SendVenueRequest
forall x. Rep SendVenueRequest x -> SendVenueRequest
forall x. SendVenueRequest -> Rep SendVenueRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SendVenueRequest -> Rep SendVenueRequest x
from :: forall x. SendVenueRequest -> Rep SendVenueRequest x
$cto :: forall x. Rep SendVenueRequest x -> SendVenueRequest
to :: forall x. Rep SendVenueRequest x -> SendVenueRequest
Generic

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

type SendVenue = "sendVenue"
  :> ReqBody '[JSON] SendVenueRequest
  :> Post '[JSON] (Response Message)

-- | Use this method to send information about a venue.
--   On success, the sent Message is returned.
sendVenue :: SendVenueRequest ->  ClientM (Response Message)
sendVenue :: SendVenueRequest -> ClientM (Response Message)
sendVenue = Proxy SendVenue -> Client ClientM SendVenue
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SendVenue)

makeDefault ''SendVenueRequest