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

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

-- ** 'sendLocation'

-- | Request parameters for 'sendLocation'.
data SendLocationRequest = SendLocationRequest
  { SendLocationRequest -> Maybe BusinessConnectionId
sendLocationBusinessConnectionId :: Maybe BusinessConnectionId -- ^ Unique identifier of the business connection on behalf of which the message will be sent.
  , SendLocationRequest -> SomeChatId
sendLocationChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername).
  , SendLocationRequest -> Maybe MessageThreadId
sendLocationMessageThreadId :: Maybe MessageThreadId -- ^ Unique identifier for the target message thread (topic) of the forum; for forum supergroups only.
  , SendLocationRequest -> Float
sendLocationLatitude :: Float -- ^ Latitude of new location
  , SendLocationRequest -> Float
sendLocationLongitude :: Float -- ^ Longitude of new location
  , SendLocationRequest -> Maybe Float
sendLocationHorizontalAccuracy :: Maybe Float -- ^ The radius of uncertainty for the location, measured in meters; 0-1500
  , SendLocationRequest -> Int
sendLocationLivePeriod :: Int -- ^ Period in seconds for which the location will be updated (see Live Locations, should be between 60 and 86400.)
  , SendLocationRequest -> Maybe Int
sendLocationHeading :: Maybe Int -- ^ Direction in which the user is moving, in degrees. Must be between 1 and 360 if specified.
  , SendLocationRequest -> Maybe Int
sendLocationProximityAlertRadius :: Maybe Int  -- ^ Maximum distance for proximity alerts about approaching another chat member, in meters. Must be between 1 and 100000 if specified.
  , SendLocationRequest -> Maybe Bool
sendLocationDisableNotification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound.
  , SendLocationRequest -> Maybe Bool
sendLocationProtectContent :: Maybe Bool -- ^ Protects the contents of the sent message from forwarding and saving.
  , SendLocationRequest -> Maybe Text
sendLocationMessageEffectId :: Maybe Text -- ^ Unique identifier of the message effect to be added to the message; for private chats only.
  , SendLocationRequest -> Maybe MessageId
sendLocationReplyToMessageId :: Maybe MessageId -- ^ If the message is a reply, ID of the original message.
  , SendLocationRequest -> Maybe ReplyParameters
sendLocationReplyParameters :: Maybe ReplyParameters -- ^ Description of the message to reply to.
  , SendLocationRequest -> Maybe InlineKeyboardMarkup
sendLocationReplyMarkup :: 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. SendLocationRequest -> Rep SendLocationRequest x)
-> (forall x. Rep SendLocationRequest x -> SendLocationRequest)
-> Generic SendLocationRequest
forall x. Rep SendLocationRequest x -> SendLocationRequest
forall x. SendLocationRequest -> Rep SendLocationRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SendLocationRequest -> Rep SendLocationRequest x
from :: forall x. SendLocationRequest -> Rep SendLocationRequest x
$cto :: forall x. Rep SendLocationRequest x -> SendLocationRequest
to :: forall x. Rep SendLocationRequest x -> SendLocationRequest
Generic

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


type SendLocation = "sendLocation"
  :> ReqBody '[JSON] SendLocationRequest
  :> Post '[JSON] (Response Message)

-- | Use this method to send point on the map.
--   On success, the sent Message is returned.
sendLocation :: SendLocationRequest ->  ClientM (Response Message)
sendLocation :: SendLocationRequest -> ClientM (Response Message)
sendLocation = Proxy SendLocation -> Client ClientM SendLocation
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SendLocation)

makeDefault ''SendLocationRequest