{-# 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
import           Telegram.Bot.API.Types.LabeledPrice

-- | 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
    }
  | InputInvoiceMessageContent                        -- ^ Represents the [content](https://core.telegram.org/bots/api#inputmessagecontent) of an invoice message to be sent as the result of an inline query.
    { inputMessageContentTitle :: Text -- ^ Product name, 1-32 characters.
    , InputMessageContent -> Text
inputMessageContentDescription :: Text -- ^ Product description, 1-255 characters.
    , InputMessageContent -> Text
inputMessageContentPayload :: Text -- ^ Bot-defined invoice payload, 1-128 bytes. This will not be displayed to the user, use for your internal processes.
    , InputMessageContent -> Text
inputMessageContentProviderToken :: Text -- ^ Payment provider token, obtained via [@BotFather](https://t.me/botfather).
    , InputMessageContent -> Text
inputMessageContentCurrency :: Text -- ^ Three-letter ISO 4217 currency code, see [more on currencies](https://core.telegram.org/bots/payments#supported-currencies).
    , InputMessageContent -> [LabeledPrice]
inputMessageContentPrices :: [LabeledPrice] -- ^ Price breakdown, a JSON-serialized list of components (e.g. product price, tax, discount, delivery cost, delivery tax, bonus, etc.).
    , InputMessageContent -> Maybe Integer
inputMessageContentMaxTipAmount :: Maybe Integer -- ^ The maximum accepted amount for tips in the smallest units of the currency (integer, not float/double). For example, for a maximum tip of @US$ 1.45@ pass @max_tip_amount = 145@. See the exp parameter in [currencies.json](https://core.telegram.org/bots/payments/currencies.json), it shows the number of digits past the decimal point for each currency (2 for the majority of currencies). Defaults to 0.
    , InputMessageContent -> Maybe [Integer]
inputMessageContentSuggestedTipAmounts :: Maybe [Integer] -- ^ A JSON-serialized array of suggested amounts of tip in the smallest units of the currency (integer, not float/double). At most 4 suggested tip amounts can be specified. The suggested tip amounts must be positive, passed in a strictly increased order and must not exceed @max_tip_amount@.
    , InputMessageContent -> Maybe Text
inputMessageContentProviderData :: Maybe Text -- ^ A JSON-serialized object for data about the invoice, which will be shared with the payment provider. A detailed description of the required fields should be provided by the payment provider.
    , InputMessageContent -> Maybe Text
inputMessageContentPhotoUrl :: Maybe Text -- ^ URL of the product photo for the invoice. Can be a photo of the goods or a marketing image for a service.
    , InputMessageContent -> Maybe Integer
inputMessageContentPhotoSize :: Maybe Integer -- ^ Photo size in bytes.
    , InputMessageContent -> Maybe Integer
inputMessageContentPhotoWidth :: Maybe Integer -- ^ Photo width.
    , InputMessageContent -> Maybe Integer
inputMessageContentPhotoHeight :: Maybe Integer -- ^ Photo height.
    , InputMessageContent -> Maybe Bool
inputMessageContentNeedName :: Maybe Bool -- ^ 'True' if you require the user's full name to complete the order.
    , InputMessageContent -> Maybe Bool
inputMessageContentNeedPhoneNumber :: Maybe Bool -- ^ 'True' if you require the user's phone number to complete the order.
    , InputMessageContent -> Maybe Bool
inputMessageContentNeedEmail :: Maybe Bool -- ^ 'True' if you require the user's email address to complete the order.
    , InputMessageContent -> Maybe Bool
inputMessageContentNeedShippingAddress :: Maybe Bool -- ^ 'True' if you require the user's shipping address to complete the order.
    , InputMessageContent -> Maybe Bool
inputMessageContentSendPhoneNumberToProvider :: Maybe Bool -- ^ 'True' if the user's phone number should be sent to provider.
    , InputMessageContent -> Maybe Bool
inputMessageContentSendEmailToProvider :: Maybe Bool -- ^ 'True' if the user's email address should be sent to provider.
    , InputMessageContent -> Maybe Bool
inputMessageContentIsFlexible :: Maybe Bool -- ^ 'True' if the final price depends on the shipping method.
    }
  deriving (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
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 forall a. Maybe a
Nothing 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing 

instance ToJSON InputMessageContent where toJSON :: InputMessageContent -> Value
toJSON = 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 = forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON