{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
module Telegram.Bot.API.InlineMode.InlineQueryResult where

import           Data.Aeson
                 ( FromJSON (..), ToJSON (..), KeyValue ((.=)), Value (..)
                 , withObject, (.:), (.:?)
                 )
import           Data.Aeson.Types (Parser)
import           Data.Hashable                   (Hashable)
import           Data.Text                       (Text)
import           GHC.Generics                    (Generic)

import           Telegram.Bot.API.Internal.Utils
import           Telegram.Bot.API.Types
import           Telegram.Bot.API.InlineMode.InputMessageContent
import           Telegram.Bot.API.Internal.TH (makeDefault)

import qualified Data.Text as Text

newtype InlineQueryResultId = InlineQueryResultId Text
  deriving (InlineQueryResultId -> InlineQueryResultId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InlineQueryResultId -> InlineQueryResultId -> Bool
$c/= :: InlineQueryResultId -> InlineQueryResultId -> Bool
== :: InlineQueryResultId -> InlineQueryResultId -> Bool
$c== :: InlineQueryResultId -> InlineQueryResultId -> Bool
Eq, Int -> InlineQueryResultId -> ShowS
[InlineQueryResultId] -> ShowS
InlineQueryResultId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineQueryResultId] -> ShowS
$cshowList :: [InlineQueryResultId] -> ShowS
show :: InlineQueryResultId -> String
$cshow :: InlineQueryResultId -> String
showsPrec :: Int -> InlineQueryResultId -> ShowS
$cshowsPrec :: Int -> InlineQueryResultId -> ShowS
Show, forall x. Rep InlineQueryResultId x -> InlineQueryResultId
forall x. InlineQueryResultId -> Rep InlineQueryResultId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InlineQueryResultId x -> InlineQueryResultId
$cfrom :: forall x. InlineQueryResultId -> Rep InlineQueryResultId x
Generic, [InlineQueryResultId] -> Encoding
[InlineQueryResultId] -> Value
InlineQueryResultId -> Encoding
InlineQueryResultId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [InlineQueryResultId] -> Encoding
$ctoEncodingList :: [InlineQueryResultId] -> Encoding
toJSONList :: [InlineQueryResultId] -> Value
$ctoJSONList :: [InlineQueryResultId] -> Value
toEncoding :: InlineQueryResultId -> Encoding
$ctoEncoding :: InlineQueryResultId -> Encoding
toJSON :: InlineQueryResultId -> Value
$ctoJSON :: InlineQueryResultId -> Value
ToJSON, Value -> Parser [InlineQueryResultId]
Value -> Parser InlineQueryResultId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [InlineQueryResultId]
$cparseJSONList :: Value -> Parser [InlineQueryResultId]
parseJSON :: Value -> Parser InlineQueryResultId
$cparseJSON :: Value -> Parser InlineQueryResultId
FromJSON, Eq InlineQueryResultId
Int -> InlineQueryResultId -> Int
InlineQueryResultId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: InlineQueryResultId -> Int
$chash :: InlineQueryResultId -> Int
hashWithSalt :: Int -> InlineQueryResultId -> Int
$chashWithSalt :: Int -> InlineQueryResultId -> Int
Hashable)

data InlineQueryResultGeneric = InlineQueryResultGeneric
  { InlineQueryResultGeneric -> InlineQueryResultId
inlineQueryResultId :: InlineQueryResultId -- ^ Unique identifier for this result, 1-64 Bytes
  , InlineQueryResultGeneric -> Maybe Text
inlineQueryResultTitle :: Maybe Text -- ^ Title of the result (only valid for "Article", "Photo", "Gif", "Mpeg4Gif", "Video", "Audio", "Voice", "Document", "Location", "Venue", "CachedPhoto", "CachedGif", "CachedMpeg4Gif", "CachedDocument", "CachedVideo", "CachedVoice" types of results)
  , InlineQueryResultGeneric -> Maybe Text
inlineQueryResultCaption :: Maybe Text -- ^ Caption of the media to be sent, 0-1024 characters after entities parsing.
  , InlineQueryResultGeneric -> Maybe Text
inlineQueryResultParseMode :: Maybe Text -- ^ Mode for parsing entities in the photo caption. See formatting options <https:\/\/core.telegram.org\/bots\/api#formatting-options> for more details.
  , InlineQueryResultGeneric -> Maybe [MessageEntity]
inlineQueryResultCaptionEntities :: Maybe [MessageEntity] -- ^ List of special entities that appear in the caption, which can be specified instead of @parse_mode@.
  , InlineQueryResultGeneric -> Maybe InlineKeyboardMarkup
inlineQueryResultReplyMarkup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message.
  , InlineQueryResultGeneric -> Maybe InputMessageContent
inlineQueryResultInputMessageContent :: Maybe InputMessageContent -- ^  Content of the message to be sent instead of the media.
  , InlineQueryResultGeneric -> Maybe Text
inlineQueryResultDescription :: Maybe Text -- ^ Short description of the result.
  }
  deriving (forall x.
Rep InlineQueryResultGeneric x -> InlineQueryResultGeneric
forall x.
InlineQueryResultGeneric -> Rep InlineQueryResultGeneric x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep InlineQueryResultGeneric x -> InlineQueryResultGeneric
$cfrom :: forall x.
InlineQueryResultGeneric -> Rep InlineQueryResultGeneric x
Generic, Int -> InlineQueryResultGeneric -> ShowS
[InlineQueryResultGeneric] -> ShowS
InlineQueryResultGeneric -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineQueryResultGeneric] -> ShowS
$cshowList :: [InlineQueryResultGeneric] -> ShowS
show :: InlineQueryResultGeneric -> String
$cshow :: InlineQueryResultGeneric -> String
showsPrec :: Int -> InlineQueryResultGeneric -> ShowS
$cshowsPrec :: Int -> InlineQueryResultGeneric -> ShowS
Show)

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

data InlineQueryResultGenericThumbnail = InlineQueryResultGenericThumbnail
  { InlineQueryResultGenericThumbnail -> InlineQueryResultGeneric
inlineQueryResultGenericGeneric :: InlineQueryResultGeneric
  , InlineQueryResultGenericThumbnail -> Maybe Text
inlineQueryResultGenericThumbnailUrl :: Maybe Text -- ^ URL of the thumbnail for the media.
  , InlineQueryResultGenericThumbnail -> Maybe Text
inlineQueryResultGenericThumbnailMimeType :: Maybe Text -- ^ MIME type of the thumbnail, must be one of @image/jpeg@, @image/gif@, or @video/mp4@. Defaults to @image/jpeg@.
  , InlineQueryResultGenericThumbnail -> Maybe Integer
inlineQueryResultGenericThumbnailWidth :: Maybe Integer -- ^ Media width.
  , InlineQueryResultGenericThumbnail -> Maybe Integer
inlineQueryResultGenericThumbnailHeight :: Maybe Integer -- ^ Media height.
  }
  deriving (forall x.
Rep InlineQueryResultGenericThumbnail x
-> InlineQueryResultGenericThumbnail
forall x.
InlineQueryResultGenericThumbnail
-> Rep InlineQueryResultGenericThumbnail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep InlineQueryResultGenericThumbnail x
-> InlineQueryResultGenericThumbnail
$cfrom :: forall x.
InlineQueryResultGenericThumbnail
-> Rep InlineQueryResultGenericThumbnail x
Generic, Int -> InlineQueryResultGenericThumbnail -> ShowS
[InlineQueryResultGenericThumbnail] -> ShowS
InlineQueryResultGenericThumbnail -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineQueryResultGenericThumbnail] -> ShowS
$cshowList :: [InlineQueryResultGenericThumbnail] -> ShowS
show :: InlineQueryResultGenericThumbnail -> String
$cshow :: InlineQueryResultGenericThumbnail -> String
showsPrec :: Int -> InlineQueryResultGenericThumbnail -> ShowS
$cshowsPrec :: Int -> InlineQueryResultGenericThumbnail -> ShowS
Show)

instance ToJSON InlineQueryResultGenericThumbnail where
  toJSON :: InlineQueryResultGenericThumbnail -> Value
toJSON InlineQueryResultGenericThumbnail{Maybe Integer
Maybe Text
InlineQueryResultGeneric
inlineQueryResultGenericThumbnailHeight :: Maybe Integer
inlineQueryResultGenericThumbnailWidth :: Maybe Integer
inlineQueryResultGenericThumbnailMimeType :: Maybe Text
inlineQueryResultGenericThumbnailUrl :: Maybe Text
inlineQueryResultGenericGeneric :: InlineQueryResultGeneric
inlineQueryResultGenericThumbnailHeight :: InlineQueryResultGenericThumbnail -> Maybe Integer
inlineQueryResultGenericThumbnailWidth :: InlineQueryResultGenericThumbnail -> Maybe Integer
inlineQueryResultGenericThumbnailMimeType :: InlineQueryResultGenericThumbnail -> Maybe Text
inlineQueryResultGenericThumbnailUrl :: InlineQueryResultGenericThumbnail -> Maybe Text
inlineQueryResultGenericGeneric :: InlineQueryResultGenericThumbnail -> InlineQueryResultGeneric
..}
    = Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGeneric
inlineQueryResultGenericGeneric)
      [ Key
"thumbnail_url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
inlineQueryResultGenericThumbnailUrl
      , Key
"thumbnail_mime_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
inlineQueryResultGenericThumbnailMimeType
      , Key
"thumbnail_width" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
inlineQueryResultGenericThumbnailWidth
      , Key
"thumbnail_height" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
inlineQueryResultGenericThumbnailHeight
      ]

instance FromJSON InlineQueryResultGenericThumbnail where
  parseJSON :: Value -> Parser InlineQueryResultGenericThumbnail
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InlineQueryResult" \Object
o -> InlineQueryResultGeneric
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> InlineQueryResultGenericThumbnail
InlineQueryResultGenericThumbnail
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"thumbnail_url"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"thumbnail_mime_type"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"thumbnail_width"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"thumbnail_height"

-- | This object represents one result of an inline query
data InlineQueryResult
  = InlineQueryResultArticle
    { InlineQueryResult -> InlineQueryResultGenericThumbnail
inlineQueryResultArticleGeneric :: InlineQueryResultGenericThumbnail
    , InlineQueryResult -> Maybe Text
inlineQueryResultArticleUrl :: Maybe Text -- ^ URL of the result.
    , InlineQueryResult -> Maybe Bool
inlineQueryResultArticleHideUrl :: Maybe Bool -- ^ 'True' if you don't want the URL to be shown in the message.
    }
  | InlineQueryResultPhoto
    { InlineQueryResult -> InlineQueryResultGenericThumbnail
inlineQueryResultPhotoGeneric :: InlineQueryResultGenericThumbnail
    , InlineQueryResult -> Text
inlineQueryResultPhotoPhotoUrl :: Text -- ^ A valid URL of the photo. Photo must be in **JPEG** format. Photo size must not exceed 5MB.
    , InlineQueryResult -> Maybe Integer
inlineQueryResultPhotoPhotoWidth :: Maybe Integer -- ^ Width of the photo.
    , InlineQueryResult -> Maybe Integer
inlineQueryResultPhotoPhotoHeight :: Maybe Integer -- ^ Height of the photo.
    }
  | InlineQueryResultGif
    { InlineQueryResult -> InlineQueryResultGenericThumbnail
inlineQueryResultGifGeneric :: InlineQueryResultGenericThumbnail
    , InlineQueryResult -> Text
inlineQueryResultGifGifUrl :: Text -- ^ A valid URL for the GIF file. File size must not exceed 1MB.
    , InlineQueryResult -> Maybe Integer
inlineQueryResultGifGifWidth :: Maybe Integer -- ^ Width of the GIF.
    , InlineQueryResult -> Maybe Integer
inlineQueryResultGifGifHeight :: Maybe Integer -- ^ Height of the GIF.
    , InlineQueryResult -> Maybe Integer
inlineQueryResultGifGifDuration :: Maybe Integer -- ^ Duration of the GIF in seconds.
    }
  | InlineQueryResultMpeg4Gif
    { InlineQueryResult -> InlineQueryResultGenericThumbnail
inlineQueryResultMpeg4GifGeneric :: InlineQueryResultGenericThumbnail
    , InlineQueryResult -> Text
inlineQueryResultMpeg4GifMpeg4Url :: Text -- ^ A valid URL for the MPEG4 file. File size must not exceed 1MB.
    , InlineQueryResult -> Maybe Integer
inlineQueryResultMpeg4GifMpeg4Width :: Maybe Integer -- ^ Video width.
    , InlineQueryResult -> Maybe Integer
inlineQueryResultMpeg4GifMpeg4Height :: Maybe Integer -- ^ Video height.
    , InlineQueryResult -> Maybe Integer
inlineQueryResultMpeg4GifMpeg4Duration :: Maybe Integer -- ^ Video duration in seconds.
    }
  | InlineQueryResultVideo
    { InlineQueryResult -> InlineQueryResultGenericThumbnail
inlineQueryResultVideoGeneric :: InlineQueryResultGenericThumbnail
    , InlineQueryResult -> Text
inlineQueryResultVideoVideoUrl :: Text -- ^ A valid URL for the embedded video player or video file.
    , InlineQueryResult -> Text
inlineQueryResultVideoMimeType :: Text -- ^ MIME type of the content of the video URL, @text/html@ or @video/mp4@.
    , InlineQueryResult -> Maybe Integer
inlineQueryResultVideoVideoWidth :: Maybe Integer -- ^ Video width.
    , InlineQueryResult -> Maybe Integer
inlineQueryResultVideoVideoHeight :: Maybe Integer -- ^ Video height.
    , InlineQueryResult -> Maybe Integer
inlineQueryResultVideoVideoDuration :: Maybe Integer -- ^ Video duration in seconds.
    }
  | InlineQueryResultAudio
    { InlineQueryResult -> InlineQueryResultGeneric
inlineQueryResultAudioGeneric :: InlineQueryResultGeneric
    , InlineQueryResult -> Text
inlineQueryResultAudioAudioUrl :: Text -- ^ A valid URL for the audio file.
    , InlineQueryResult -> Maybe Text
inlineQueryResultAudioPerformer :: Maybe Text -- ^ Performer.
    , InlineQueryResult -> Maybe Integer
inlineQueryResultAudioAudioDuration :: Maybe Integer -- ^ Audio duration in seconds.
    }
  | InlineQueryResultVoice
    { InlineQueryResult -> InlineQueryResultGeneric
inlineQueryResultVoiceGeneric :: InlineQueryResultGeneric
    , InlineQueryResult -> Text
inlineQueryResultVoiceVoiceUrl :: Text -- ^ A valid URL for the voice recording.
    , InlineQueryResult -> Maybe Integer
inlineQueryResultVoiceVoiceDuration :: Maybe Integer -- ^ Recording duration in seconds.
    }
  | InlineQueryResultDocument
    { InlineQueryResult -> InlineQueryResultGenericThumbnail
inlineQueryResultDocumentGeneric :: InlineQueryResultGenericThumbnail
    , InlineQueryResult -> Text
inlineQueryResultDocumentDocumentUrl :: Text -- ^ A valid URL for the file.
    , InlineQueryResult -> Text
inlineQueryResultDocumentMimeType :: Text -- ^ MIME type of the content of the file, either @application/pdf@ or @application/zip@.
    }
  | InlineQueryResultLocation
    { InlineQueryResult -> InlineQueryResultGenericThumbnail
inlineQueryResultLocationGeneric :: InlineQueryResultGenericThumbnail
    , InlineQueryResult -> Float
inlineQueryResultLocationLatitude :: Float -- ^ Location latitude in degrees.
    , InlineQueryResult -> Float
inlineQueryResultLocationLongitude :: Float -- ^ Location longitude in degrees.
    , InlineQueryResult -> Maybe Float
inlineQueryResultLocationHorizontalAccuracy :: Maybe Float -- ^ The radius of uncertainty for the location, measured in meters; 0-1500.
    , InlineQueryResult -> Maybe Seconds
inlineQueryResultLocationLivePeriod :: Maybe Seconds -- ^ Period in seconds for which the location can be updated, should be between 60 and 86400.
    , InlineQueryResult -> Maybe Int
inlineQueryResultLocationHeading :: Maybe Int -- ^ For live locations, a direction in which the user is moving, in degrees. Must be between 1 and 360 if specified.
    , InlineQueryResult -> Maybe Int
inlineQueryResultLocationProximityAlertRadius :: Maybe Int -- ^ For live locations, a maximum distance for proximity alerts about approaching another chat member, in meters. Must be between 1 and 100000 if specified.
    }
  | InlineQueryResultVenue
    { InlineQueryResult -> InlineQueryResultGenericThumbnail
inlineQueryResultVenueGeneric :: InlineQueryResultGenericThumbnail
    , InlineQueryResult -> Float
inlineQueryResultVenueLatitude :: Float -- ^ Latitude of the venue location in degrees.
    , InlineQueryResult -> Float
inlineQueryResultVenueLongitude :: Float -- ^ Longitude of the venue location in degrees.
    , InlineQueryResult -> Text
inlineQueryResultVenueAddress :: Text -- ^ Address of the venue.
    , InlineQueryResult -> Maybe Text
inlineQueryResultVenueFoursquareId :: Maybe Text -- ^ Foursquare identifier of the venue if known.
    , InlineQueryResult -> Maybe Text
inlineQueryResultVenueFoursquareType :: Maybe Text -- ^ Foursquare type of the venue, if known. (For example, @arts_entertainment/default@, @arts_entertainment/aquarium@ or @food/icecream@.)
    , InlineQueryResult -> Maybe Text
inlineQueryResultVenueGooglePlaceId :: Maybe Text -- ^ Google Places identifier of the venue.
    , InlineQueryResult -> Maybe Text
inlineQueryResultVenueGooglePlaceType :: Maybe Text -- ^ Google Places type of the venue. (See supported types <https:\/\/developers.google.com\/places\/web-service\/supported_types>.)
    }
  | InlineQueryResultContact
    { InlineQueryResult -> InlineQueryResultGenericThumbnail
inlineQueryResultContactGeneric :: InlineQueryResultGenericThumbnail
    , InlineQueryResult -> Text
inlineQueryResultContactPhoneNumber :: Text -- ^ Contact's phone number.
    , InlineQueryResult -> Text
inlineQueryResultContactFirstName :: Text -- ^ Contact's first name.
    , InlineQueryResult -> Maybe Text
inlineQueryResultContactLastName :: Maybe Text -- ^ Contact's last name.
    , InlineQueryResult -> Maybe Text
inlineQueryResultContactVcard :: Maybe Text -- ^ Additional data about the contact in the form of a vCard <https:\/\/en.wikipedia.org\/wiki\/VCard>, 0-2048 bytes.
    }
  | InlineQueryResultGame
    { InlineQueryResult -> InlineQueryResultGeneric
inlineQueryResultGameGeneric :: InlineQueryResultGeneric
    , InlineQueryResult -> Text
inlineQueryResultGameGameShortName :: Text -- ^ Short name of the game.
    }
  | InlineQueryResultCachedPhoto
    { InlineQueryResult -> InlineQueryResultGeneric
inlineQueryResultCachedPhotoGeneric :: InlineQueryResultGeneric
    , InlineQueryResult -> FileId
inlineQueryResultCachedPhotoPhotoFileId :: FileId -- ^ A valid file identifier of the photo.
    }
  | InlineQueryResultCachedGif
    { InlineQueryResult -> InlineQueryResultGeneric
inlineQueryResultCachedGifGeneric :: InlineQueryResultGeneric
    , InlineQueryResult -> FileId
iinlineQueryResultCachedGifGifFileId :: FileId -- ^ A valid file identifier for the GIF file.
    }
  | InlineQueryResultCachedMpeg4Gif
    { InlineQueryResult -> InlineQueryResultGeneric
inlineQueryResultCachedMpeg4GifGeneric :: InlineQueryResultGeneric
    , InlineQueryResult -> FileId
inlineQueryResultCachedMpeg4GifMpeg4FileId :: FileId -- ^ A valid file identifier for the MPEG4 file.
    }
  | InlineQueryResultCachedSticker
    { InlineQueryResult -> InlineQueryResultGeneric
inlineQueryResultCachedStickerGeneric :: InlineQueryResultGeneric
    , InlineQueryResult -> FileId
inlineQueryResultCachedStickerStickerFileId :: FileId -- ^ A valid file identifier of the sticker.
    }
  | InlineQueryResultCachedDocument
    { InlineQueryResult -> InlineQueryResultGeneric
inlineQueryResultCachedDocumentGeneric :: InlineQueryResultGeneric
    , InlineQueryResult -> FileId
inlineQueryResultCachedDocumentDocumentFileId :: FileId -- ^ A valid file identifier for the file.
    }
  | InlineQueryResultCachedVideo
    { InlineQueryResult -> InlineQueryResultGeneric
inlineQueryResultCachedVideoGeneric :: InlineQueryResultGeneric
    , InlineQueryResult -> FileId
inlineQueryResultCachedVideoVideoFileId :: FileId -- ^ A valid file identifier for the video file.
    }
  | InlineQueryResultCachedVoice
    { InlineQueryResult -> InlineQueryResultGeneric
inlineQueryResultCachedVoiceGeneric :: InlineQueryResultGeneric
    , InlineQueryResult -> FileId
inlineQueryResultCachedVoiceVoiceFileId :: FileId -- ^ A valid file identifier for the voice message.
    }
  | InlineQueryResultCachedAudio
    { InlineQueryResult -> InlineQueryResultGeneric
inlineQueryResultCachedAudioGeneric :: InlineQueryResultGeneric
    , InlineQueryResult -> FileId
inlineQueryResultCachedAudioAudioFileId :: FileId -- ^ A valid file identifier for the audio file.
    }
  deriving (forall x. Rep InlineQueryResult x -> InlineQueryResult
forall x. InlineQueryResult -> Rep InlineQueryResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InlineQueryResult x -> InlineQueryResult
$cfrom :: forall x. InlineQueryResult -> Rep InlineQueryResult x
Generic, Int -> InlineQueryResult -> ShowS
[InlineQueryResult] -> ShowS
InlineQueryResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineQueryResult] -> ShowS
$cshowList :: [InlineQueryResult] -> ShowS
show :: InlineQueryResult -> String
$cshow :: InlineQueryResult -> String
showsPrec :: Int -> InlineQueryResult -> ShowS
$cshowsPrec :: Int -> InlineQueryResult -> ShowS
Show)

instance ToJSON InlineQueryResult where
  toJSON :: InlineQueryResult -> Value
toJSON = \case
    InlineQueryResultArticle InlineQueryResultGenericThumbnail
g Maybe Text
url Maybe Bool
hideUrl ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGenericThumbnail
g)
        (Text -> [Pair] -> [Pair]
addType Text
"article"
        [ Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
url
        , Key
"hide_url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
hideUrl
        ])
    InlineQueryResultPhoto InlineQueryResultGenericThumbnail
g Text
photoUrl Maybe Integer
photoWidth Maybe Integer
photoHeight ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGenericThumbnail
g)
        (Text -> [Pair] -> [Pair]
addType Text
"photo"
        [ Key
"photo_url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
photoUrl
        , Key
"photo_width" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
photoWidth
        , Key
"photo_height" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
photoHeight
        ])
    InlineQueryResultGif InlineQueryResultGenericThumbnail
g Text
gifUrl Maybe Integer
gifWidth Maybe Integer
gifHeight Maybe Integer
gifDuration ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGenericThumbnail
g)
        (Text -> [Pair] -> [Pair]
addType Text
"gif"
        [ Key
"gif_url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
gifUrl
        , Key
"gif_width" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
gifWidth
        , Key
"gif_height" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
gifHeight
        , Key
"gif_duration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
gifDuration
        ])
    InlineQueryResultMpeg4Gif InlineQueryResultGenericThumbnail
g Text
mpeg4Url Maybe Integer
mpeg4Width Maybe Integer
mpeg4Height Maybe Integer
mpeg4Duration ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGenericThumbnail
g)
        (Text -> [Pair] -> [Pair]
addType Text
"mpeg4_gif"
        [ Key
"mpeg4_url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
mpeg4Url
        , Key
"mpeg4_width" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
mpeg4Width
        , Key
"mpeg4_height" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
mpeg4Height
        , Key
"mpeg4_duration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
mpeg4Duration
        ])
    InlineQueryResultVideo InlineQueryResultGenericThumbnail
g Text
videoUrl Text
mimeType Maybe Integer
videoWidth Maybe Integer
videoHeight Maybe Integer
videoDuration ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGenericThumbnail
g)
        (Text -> [Pair] -> [Pair]
addType Text
"video"
        [ Key
"video_url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
videoUrl
        , Key
"mime_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
mimeType
        , Key
"video_width" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
videoWidth
        , Key
"video_height" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
videoHeight
        , Key
"video_duration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
videoDuration
        ])
    InlineQueryResultAudio InlineQueryResultGeneric
g Text
audioUrl Maybe Text
performer Maybe Integer
audioDuration ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGeneric
g)
        (Text -> [Pair] -> [Pair]
addType Text
"audio"
        [ Key
"audio_url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
audioUrl
        , Key
"performer" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
performer
        , Key
"audio_duration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
audioDuration
        ])
    InlineQueryResultVoice InlineQueryResultGeneric
g Text
voiceUrl Maybe Integer
voiceDuration ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGeneric
g)
        (Text -> [Pair] -> [Pair]
addType Text
"voice"
        [ Key
"voice_url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
voiceUrl
        , Key
"voice_duration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Integer
voiceDuration
        ])
    InlineQueryResultDocument InlineQueryResultGenericThumbnail
g Text
documentUrl Text
mimeType ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGenericThumbnail
g)
        (Text -> [Pair] -> [Pair]
addType Text
"document"
        [ Key
"document_url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
documentUrl
        , Key
"mime_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
mimeType
        ])
    InlineQueryResultLocation InlineQueryResultGenericThumbnail
g Float
latitude Float
longitude Maybe Float
horizontalAccuracy Maybe Seconds
livePeriod Maybe Int
heading Maybe Int
proximityAlertRadius ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGenericThumbnail
g)
        (Text -> [Pair] -> [Pair]
addType Text
"location"
        [ Key
"latitude" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Float
latitude
        , Key
"longitude" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Float
longitude
        , Key
"horizontal_accuracy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Float
horizontalAccuracy
        , Key
"live_period" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Seconds
livePeriod
        , Key
"heading" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
heading
        , Key
"proximity_alert_radius" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
proximityAlertRadius
        ])
    InlineQueryResultVenue InlineQueryResultGenericThumbnail
g Float
latitude Float
longitude Text
address Maybe Text
foursquareId Maybe Text
foursquareType Maybe Text
googlePlaceId Maybe Text
googlePlaceType ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGenericThumbnail
g)
        (Text -> [Pair] -> [Pair]
addType Text
"venue"
        [ Key
"latitude" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Float
latitude
        , Key
"longitude" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Float
longitude
        , Key
"address" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
address
        , Key
"foursquare_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
foursquareId
        , Key
"foursquare_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
foursquareType
        , Key
"google_place_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
googlePlaceId
        , Key
"google_place_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
googlePlaceType
        ])
    InlineQueryResultContact InlineQueryResultGenericThumbnail
g Text
phoneNumber Text
firstName Maybe Text
lastName Maybe Text
vcard ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGenericThumbnail
g)
        (Text -> [Pair] -> [Pair]
addType Text
"contact"
        [ Key
"phone_number" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
phoneNumber
        , Key
"first_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
firstName
        , Key
"last_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
lastName
        , Key
"vcard" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
vcard
        ])
    InlineQueryResultGame InlineQueryResultGeneric
g Text
gameShortName ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGeneric
g)
        (Text -> [Pair] -> [Pair]
addType Text
"game"
        [ Key
"game_short_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
gameShortName
        ])
    InlineQueryResultCachedPhoto InlineQueryResultGeneric
g FileId
photoFileId ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGeneric
g)
        (Text -> [Pair] -> [Pair]
addType Text
"photo"
        [ Key
"photo_file_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FileId
photoFileId
        ])
    InlineQueryResultCachedGif InlineQueryResultGeneric
g FileId
gifFileId ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGeneric
g)
        (Text -> [Pair] -> [Pair]
addType Text
"gif"
        [ Key
"gif_file_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FileId
gifFileId
        ])
    InlineQueryResultCachedMpeg4Gif InlineQueryResultGeneric
g FileId
mpeg4FileId ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGeneric
g)
        (Text -> [Pair] -> [Pair]
addType Text
"mpeg4_gif"
        [ Key
"mpeg4_file_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FileId
mpeg4FileId
        ])
    InlineQueryResultCachedSticker InlineQueryResultGeneric
g FileId
stickerFileId ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGeneric
g)
        (Text -> [Pair] -> [Pair]
addType Text
"sticker"
        [ Key
"sticker_file_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FileId
stickerFileId
        ])
    InlineQueryResultCachedDocument InlineQueryResultGeneric
g FileId
documentFileId ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGeneric
g)
        (Text -> [Pair] -> [Pair]
addType Text
"document"
        [ Key
"document_file_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FileId
documentFileId
        ])
    InlineQueryResultCachedVideo InlineQueryResultGeneric
g FileId
videoFileId ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGeneric
g)
        (Text -> [Pair] -> [Pair]
addType Text
"video"
        [ Key
"video_file_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FileId
videoFileId
        ])
    InlineQueryResultCachedVoice InlineQueryResultGeneric
g FileId
voiceFileId ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGeneric
g)
        (Text -> [Pair] -> [Pair]
addType Text
"voice"
        [ Key
"voice_file_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FileId
voiceFileId
        ])
    InlineQueryResultCachedAudio InlineQueryResultGeneric
g FileId
audioFileId ->
      Value -> [Pair] -> Value
addJsonFields (forall a. ToJSON a => a -> Value
toJSON InlineQueryResultGeneric
g)
        (Text -> [Pair] -> [Pair]
addType Text
"audio"
        [ Key
"audio_file_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FileId
audioFileId
        ])

instance FromJSON InlineQueryResult where
  parseJSON :: Value -> Parser InlineQueryResult
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InlineQueryResult" \Object
o ->
    (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Text) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
"article" -> InlineQueryResultGenericThumbnail
-> Maybe Text -> Maybe Bool -> InlineQueryResult
InlineQueryResultArticle
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hide_url"
    Text
"photo" -> Object -> Key -> Parser (Maybe FileId)
parseFileId Object
o Key
"photo_file_id" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe FileId
Nothing -> InlineQueryResultGenericThumbnail
-> Text -> Maybe Integer -> Maybe Integer -> InlineQueryResult
InlineQueryResultPhoto
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o) -- generic thumbnail
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"photo_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"photo_width"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"photo_height"
      Just FileId
fileId -> InlineQueryResultGeneric -> FileId -> InlineQueryResult
InlineQueryResultCachedPhoto forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure FileId
fileId
    Text
"gif" -> Object -> Key -> Parser (Maybe FileId)
parseFileId Object
o Key
"gif_file_id" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe FileId
Nothing -> InlineQueryResultGenericThumbnail
-> Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> InlineQueryResult
InlineQueryResultGif
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o) -- generic thumbnail
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gif_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gif_width"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gif_height"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gif_duration"
      Just FileId
fileId -> InlineQueryResultGeneric -> FileId -> InlineQueryResult
InlineQueryResultCachedGif forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure FileId
fileId
    Text
"mpeg4_gif" -> Object -> Key -> Parser (Maybe FileId)
parseFileId Object
o Key
"mpeg4_file_id" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe FileId
Nothing -> InlineQueryResultGenericThumbnail
-> Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> InlineQueryResult
InlineQueryResultMpeg4Gif
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o) -- generic thumbnail
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mpeg4_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mpeg4_width"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mpeg4_height"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mpeg4_duration"
      Just FileId
fileId -> InlineQueryResultGeneric -> FileId -> InlineQueryResult
InlineQueryResultCachedMpeg4Gif
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure FileId
fileId
    Text
"video" -> Object -> Key -> Parser (Maybe FileId)
parseFileId Object
o Key
"video_file_id" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe FileId
Nothing -> InlineQueryResultGenericThumbnail
-> Text
-> Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> InlineQueryResult
InlineQueryResultVideo
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"video_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mime_type"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"video_width"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"video_height"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"video_duration"
      Just FileId
fileId -> InlineQueryResultGeneric -> FileId -> InlineQueryResult
InlineQueryResultCachedVideo
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure FileId
fileId
    Text
"audio" -> Object -> Key -> Parser (Maybe FileId)
parseFileId Object
o Key
"audio_file_id" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe FileId
Nothing -> InlineQueryResultGeneric
-> Text -> Maybe Text -> Maybe Integer -> InlineQueryResult
InlineQueryResultAudio
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"audio_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"performer"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"duration"
      Just FileId
fileId -> InlineQueryResultGeneric -> FileId -> InlineQueryResult
InlineQueryResultCachedAudio forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure FileId
fileId
    Text
"voice" -> Object -> Key -> Parser (Maybe FileId)
parseFileId Object
o Key
"voice_file_id" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe FileId
Nothing -> InlineQueryResultGeneric
-> Text -> Maybe Integer -> InlineQueryResult
InlineQueryResultVoice
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"voice_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"voice_duration"
      Just FileId
fileId -> InlineQueryResultGeneric -> FileId -> InlineQueryResult
InlineQueryResultCachedVoice forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure FileId
fileId
    Text
"document" -> Object -> Key -> Parser (Maybe FileId)
parseFileId Object
o Key
"document_file_id" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe FileId
Nothing -> InlineQueryResultGenericThumbnail
-> Text -> Text -> InlineQueryResult
InlineQueryResultDocument
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"document_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mime_type"
      Just FileId
fileId -> InlineQueryResultGeneric -> FileId -> InlineQueryResult
InlineQueryResultCachedDocument forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure FileId
fileId
    Text
"location" -> InlineQueryResultGenericThumbnail
-> Float
-> Float
-> Maybe Float
-> Maybe Seconds
-> Maybe Int
-> Maybe Int
-> InlineQueryResult
InlineQueryResultLocation
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"latitude"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"longitude"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"horizontal_accuracy"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"live_period"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"heading"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"proximity_alert_radius"
    Text
"venue" -> InlineQueryResultGenericThumbnail
-> Float
-> Float
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> InlineQueryResult
InlineQueryResultVenue
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"latitude"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"longitude"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"foursquare_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"foursquare_type"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"google_place_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"google_place_type"
    Text
"contact" -> InlineQueryResultGenericThumbnail
-> Text -> Text -> Maybe Text -> Maybe Text -> InlineQueryResult
InlineQueryResultContact
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"phone_number"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"first_name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"last_name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vcard"
    Text
"game" -> InlineQueryResultGeneric -> Text -> InlineQueryResult
InlineQueryResultGame
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"game_short_name"
    Text
t -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text
"Unknown type: " forall a. Semigroup a => a -> a -> a
<> Text
t)
    where
      parseFileId :: Object -> Key -> Parser (Maybe FileId)
parseFileId Object
o Key
fileField = Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
fileField :: Parser (Maybe FileId)
    
defInlineQueryResultArticle :: InlineQueryResultGenericThumbnail -> InlineQueryResult
defInlineQueryResultArticle :: InlineQueryResultGenericThumbnail -> InlineQueryResult
defInlineQueryResultArticle InlineQueryResultGenericThumbnail
g = InlineQueryResultGenericThumbnail
-> Maybe Text -> Maybe Bool -> InlineQueryResult
InlineQueryResultArticle InlineQueryResultGenericThumbnail
g forall a. Maybe a
Nothing forall a. Maybe a
Nothing

defInlineQueryResultPhotoUrl :: InlineQueryResultGenericThumbnail -> Text -> InlineQueryResult
defInlineQueryResultPhotoUrl :: InlineQueryResultGenericThumbnail -> Text -> InlineQueryResult
defInlineQueryResultPhotoUrl InlineQueryResultGenericThumbnail
g Text
photoUrl = InlineQueryResultGenericThumbnail
-> Text -> Maybe Integer -> Maybe Integer -> InlineQueryResult
InlineQueryResultPhoto InlineQueryResultGenericThumbnail
g Text
photoUrl forall a. Maybe a
Nothing forall a. Maybe a
Nothing

defInlineQueryResultGif :: InlineQueryResultGenericThumbnail -> Text -> InlineQueryResult
defInlineQueryResultGif :: InlineQueryResultGenericThumbnail -> Text -> InlineQueryResult
defInlineQueryResultGif InlineQueryResultGenericThumbnail
g Text
gifUrl = InlineQueryResultGenericThumbnail
-> Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> InlineQueryResult
InlineQueryResultGif InlineQueryResultGenericThumbnail
g Text
gifUrl forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

defInlineQueryResultMpeg4Gif :: InlineQueryResultGenericThumbnail -> Text -> InlineQueryResult
defInlineQueryResultMpeg4Gif :: InlineQueryResultGenericThumbnail -> Text -> InlineQueryResult
defInlineQueryResultMpeg4Gif InlineQueryResultGenericThumbnail
g Text
mpeg4Url = InlineQueryResultGenericThumbnail
-> Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> InlineQueryResult
InlineQueryResultMpeg4Gif InlineQueryResultGenericThumbnail
g Text
mpeg4Url forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

defInlineQueryResultVideo :: InlineQueryResultGenericThumbnail -> Text -> Text -> InlineQueryResult
defInlineQueryResultVideo :: InlineQueryResultGenericThumbnail
-> Text -> Text -> InlineQueryResult
defInlineQueryResultVideo InlineQueryResultGenericThumbnail
g Text
videoUrl Text
mimeType
  = InlineQueryResultGenericThumbnail
-> Text
-> Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> InlineQueryResult
InlineQueryResultVideo InlineQueryResultGenericThumbnail
g Text
videoUrl Text
mimeType forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

defInlineQueryResultAudio :: InlineQueryResultGeneric -> Text -> InlineQueryResult
defInlineQueryResultAudio :: InlineQueryResultGeneric -> Text -> InlineQueryResult
defInlineQueryResultAudio InlineQueryResultGeneric
g Text
audioUrl = InlineQueryResultGeneric
-> Text -> Maybe Text -> Maybe Integer -> InlineQueryResult
InlineQueryResultAudio InlineQueryResultGeneric
g Text
audioUrl forall a. Maybe a
Nothing forall a. Maybe a
Nothing

defInlineQueryResultVoice :: InlineQueryResultGeneric -> Text -> InlineQueryResult
defInlineQueryResultVoice :: InlineQueryResultGeneric -> Text -> InlineQueryResult
defInlineQueryResultVoice InlineQueryResultGeneric
g Text
voiceUrl = InlineQueryResultGeneric
-> Text -> Maybe Integer -> InlineQueryResult
InlineQueryResultVoice InlineQueryResultGeneric
g Text
voiceUrl forall a. Maybe a
Nothing

defInlineQueryResultDocument :: InlineQueryResultGenericThumbnail -> Text -> Text -> InlineQueryResult
defInlineQueryResultDocument :: InlineQueryResultGenericThumbnail
-> Text -> Text -> InlineQueryResult
defInlineQueryResultDocument = InlineQueryResultGenericThumbnail
-> Text -> Text -> InlineQueryResult
InlineQueryResultDocument

defInlineQueryResultLocation :: InlineQueryResultGenericThumbnail -> Float -> Float -> InlineQueryResult
defInlineQueryResultLocation :: InlineQueryResultGenericThumbnail
-> Float -> Float -> InlineQueryResult
defInlineQueryResultLocation InlineQueryResultGenericThumbnail
g Float
lat Float
lon
  = InlineQueryResultGenericThumbnail
-> Float
-> Float
-> Maybe Float
-> Maybe Seconds
-> Maybe Int
-> Maybe Int
-> InlineQueryResult
InlineQueryResultLocation InlineQueryResultGenericThumbnail
g Float
lat Float
lon forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

defInlineQueryResultVenue :: InlineQueryResultGenericThumbnail -> Float -> Float -> Text -> InlineQueryResult
defInlineQueryResultVenue :: InlineQueryResultGenericThumbnail
-> Float -> Float -> Text -> InlineQueryResult
defInlineQueryResultVenue InlineQueryResultGenericThumbnail
g Float
lat Float
lon Text
address
  = InlineQueryResultGenericThumbnail
-> Float
-> Float
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> InlineQueryResult
InlineQueryResultVenue InlineQueryResultGenericThumbnail
g Float
lat Float
lon Text
address forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

defInlineQueryResultContact :: InlineQueryResultGenericThumbnail -> Text -> Text -> InlineQueryResult
defInlineQueryResultContact :: InlineQueryResultGenericThumbnail
-> Text -> Text -> InlineQueryResult
defInlineQueryResultContact InlineQueryResultGenericThumbnail
g Text
phoneNumber Text
firstName
  = InlineQueryResultGenericThumbnail
-> Text -> Text -> Maybe Text -> Maybe Text -> InlineQueryResult
InlineQueryResultContact InlineQueryResultGenericThumbnail
g Text
phoneNumber Text
firstName forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | This object represents a button to be shown above inline query results. You must use exactly one of the optional fields.
data InlineQueryResultsButton = InlineQueryResultsButton
  { InlineQueryResultsButton -> Text
inlineQueryResultsButtonText :: Text 
  , InlineQueryResultsButton -> Maybe WebAppInfo
inlineQueryResultsButtonWebApp :: Maybe WebAppInfo
  , InlineQueryResultsButton -> Maybe Text
inlineQueryResultsButtonStartParameter :: Maybe Text -- ^ [Deep-linking](https://core.telegram.org/bots/features#deep-linking) parameter for the /start message sent to the bot when a user presses the button. 1-64 characters, only @A-Z@, @a-z@, @0-9@, @_@ and @-@ are allowed.
-- 
-- Example: An inline bot that sends YouTube videos can ask the user to connect the bot to their YouTube account to adapt search results accordingly. To do this, it displays a 'Connect your YouTube account' button above the results, or even before showing any. The user presses the button, switches to a private chat with the bot and, in doing so, passes a start parameter that instructs the bot to return an OAuth link. Once done, the bot can offer a [switch_inline](https://core.telegram.org/bots/api#inlinekeyboardmarkup) button so that the user can easily return to the chat where they wanted to use the bot's inline capabilities.
  }
  deriving forall x.
Rep InlineQueryResultsButton x -> InlineQueryResultsButton
forall x.
InlineQueryResultsButton -> Rep InlineQueryResultsButton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep InlineQueryResultsButton x -> InlineQueryResultsButton
$cfrom :: forall x.
InlineQueryResultsButton -> Rep InlineQueryResultsButton x
Generic

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

foldMap makeDefault
  [ ''InlineQueryResultGeneric
  , ''InlineQueryResultGenericThumbnail
  ]