{-# LANGUAGE DeriveGeneric              #-}
module Telegram.Bot.API.InlineMode.InputMessageContent (InputMessageContent(..), defaultInputTextMessageContent, defaultInputLocationMessageContent) where

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

import           Telegram.Bot.API.Internal.Utils

-- | Represents the content of a text message to be sent as the result of an inline query.
data InputMessageContent =
  InputTextMessageContent -- ^ Represents the [content](https://core.telegram.org/bots/api#inputmessagecontent) of a text message to be sent as the result of an inline query.
  { InputMessageContent -> Text
inputMessageContentMessageText :: Text -- ^ Text of the message to be sent, 1-4096 characters
  , InputMessageContent -> Maybe Text
inputMessageContentParseMode :: Maybe Text -- ^ Mode for parsing entities in the message text. See [formatting options](https://core.telegram.org/bots/api#formatting-options) for more details.
  , InputMessageContent -> Maybe Bool
inputMessageContentDisableWebPagePrefiew :: Maybe Bool -- ^ Disables link previews for links in the sent message
  }
  | InputLocationMessageContent                                      -- ^ Represents the [content](https://core.telegram.org/bots/api#inputmessagecontent) of a location message to be sent as the result of an inline query.
  { InputMessageContent -> Float
inputMessageContentLatitude :: Float                     -- ^ Latitude of the location in degrees
  , InputMessageContent -> Float
inputMessageContentLongitude :: Float                    -- ^ Longitude of the location in degrees
  , InputMessageContent -> Maybe Float
inputMessageContentHorizontalAccuracy :: Maybe Float     -- ^ The radius of uncertainty for the location, measured in meters; 0-1500
  , InputMessageContent -> Maybe Integer
inputMessageContentLivePeriod :: Maybe Integer           -- ^ Period in seconds for which the location can be updated, should be between 60 and 86400.
  , InputMessageContent -> Maybe Integer
inputMessageContentHeading :: Maybe Integer              -- ^ For live locations, a direction in which the user is moving, in degrees. Must be between 1 and 360 if specified.
  , InputMessageContent -> Maybe Integer
inputMessageContentProximityAlertRadius :: Maybe Integer -- ^ For live locations, a maximum distance for proximity alerts about approaching another chat member, in meters. Must be between 1 and 100000 if specified.
  }
  | InputVenueMessageContent                              -- ^ Represents the content of a [venue](https://core.telegram.org/bots/api#inputmessagecontent) message to be sent as the result of an inline query.
  { inputMessageContentLatitude :: Float             -- ^ Latitude of the venue in degrees
  , inputMessageContentLongitude :: Float            -- ^ Longitude of the venue in degrees
  , InputMessageContent -> Text
inputMessageContentTitle :: Text                 -- ^ Name of the venue
  , InputMessageContent -> Text
inputMessageContentAddress :: Text               -- ^ Address of the venue
  , InputMessageContent -> Maybe Text
inputMessageContentFoursquareId :: Maybe Text    -- ^ Foursquare identifier of the venue, if known
  , InputMessageContent -> Maybe Text
inputMessageContentFoursquareType :: Maybe Text  -- ^ Foursquare type of the venue, if known. (For example, “arts_entertainment\/default”, “arts_entertainment\/aquarium” or “food\/icecream”.)
  , InputMessageContent -> Maybe Text
inputMessageContentGooglePlaceId :: Maybe Text   -- ^ Google Places identifier of the venue
  , InputMessageContent -> Maybe Text
inputMessageContentGooglePlaceType :: Maybe Text -- ^ Google Places type of the venue. (See [supported types](https://developers.google.com/places/web-service/supported_types).)
  }
  | InputContactMessageContent                         -- ^ Represents the [content](https://core.telegram.org/bots/api#inputmessagecontent) of a contact message to be sent as the result of an inline query.
  { InputMessageContent -> Text
inputMessageContentPhoneNumber :: Text      -- ^ Contact's phone number
  , InputMessageContent -> Text
inputMessageContentFirstName :: Text        -- ^ Contact's first name
  , InputMessageContent -> Maybe Text
inputMessageContentSecondName :: Maybe Text -- ^ Contact's last name
  , InputMessageContent -> Maybe Text
inputMessageContentVcard :: Maybe Text      -- ^ Additional data about the contact in the form of a [vCard](https://en.wikipedia.org/wiki/VCard), 0-2048 bytes
  } deriving ((forall x. InputMessageContent -> Rep InputMessageContent x)
-> (forall x. Rep InputMessageContent x -> InputMessageContent)
-> Generic InputMessageContent
forall x. Rep InputMessageContent x -> InputMessageContent
forall x. InputMessageContent -> Rep InputMessageContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InputMessageContent x -> InputMessageContent
$cfrom :: forall x. InputMessageContent -> Rep InputMessageContent x
Generic, Int -> InputMessageContent -> ShowS
[InputMessageContent] -> ShowS
InputMessageContent -> String
(Int -> InputMessageContent -> ShowS)
-> (InputMessageContent -> String)
-> ([InputMessageContent] -> ShowS)
-> Show InputMessageContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputMessageContent] -> ShowS
$cshowList :: [InputMessageContent] -> ShowS
show :: InputMessageContent -> String
$cshow :: InputMessageContent -> String
showsPrec :: Int -> InputMessageContent -> ShowS
$cshowsPrec :: Int -> InputMessageContent -> ShowS
Show)

-- ** Helper functions to easily construct 'InputMessageContent'

defaultInputTextMessageContent :: Text -> InputMessageContent
defaultInputTextMessageContent :: Text -> InputMessageContent
defaultInputTextMessageContent Text
text = Text -> Maybe Text -> Maybe Bool -> InputMessageContent
InputTextMessageContent Text
text Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

defaultInputLocationMessageContent :: Float -> Float -> InputMessageContent
defaultInputLocationMessageContent :: Float -> Float -> InputMessageContent
defaultInputLocationMessageContent Float
lat Float
long = Float
-> Float
-> Maybe Float
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> InputMessageContent
InputLocationMessageContent Float
lat Float
long Maybe Float
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing 

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