{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Telegram.Bot.API.InlineMode where
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Hashable (Hashable)
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.InlineMode.InlineQueryResult
import Telegram.Bot.API.Internal.TH (makeDefault)
data InlineQuery = InlineQuery
{ InlineQuery -> InlineQueryId
inlineQueryId :: InlineQueryId
, InlineQuery -> User
inlineQueryFrom :: User
, InlineQuery -> Maybe Location
inlineQueryLocation :: Maybe Location
, InlineQuery -> Text
inlineQueryQuery :: Text
, InlineQuery -> Text
inlineQueryOffset :: Text
, InlineQuery -> Maybe ChatType
inlineQueryChatType :: Maybe ChatType
} deriving ((forall x. InlineQuery -> Rep InlineQuery x)
-> (forall x. Rep InlineQuery x -> InlineQuery)
-> Generic InlineQuery
forall x. Rep InlineQuery x -> InlineQuery
forall x. InlineQuery -> Rep InlineQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InlineQuery -> Rep InlineQuery x
from :: forall x. InlineQuery -> Rep InlineQuery x
$cto :: forall x. Rep InlineQuery x -> InlineQuery
to :: forall x. Rep InlineQuery x -> InlineQuery
Generic, Int -> InlineQuery -> ShowS
[InlineQuery] -> ShowS
InlineQuery -> String
(Int -> InlineQuery -> ShowS)
-> (InlineQuery -> String)
-> ([InlineQuery] -> ShowS)
-> Show InlineQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InlineQuery -> ShowS
showsPrec :: Int -> InlineQuery -> ShowS
$cshow :: InlineQuery -> String
show :: InlineQuery -> String
$cshowList :: [InlineQuery] -> ShowS
showList :: [InlineQuery] -> ShowS
Show)
newtype InlineQueryId = InlineQueryId Text
deriving (InlineQueryId -> InlineQueryId -> Bool
(InlineQueryId -> InlineQueryId -> Bool)
-> (InlineQueryId -> InlineQueryId -> Bool) -> Eq InlineQueryId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InlineQueryId -> InlineQueryId -> Bool
== :: InlineQueryId -> InlineQueryId -> Bool
$c/= :: InlineQueryId -> InlineQueryId -> Bool
/= :: InlineQueryId -> InlineQueryId -> Bool
Eq, Int -> InlineQueryId -> ShowS
[InlineQueryId] -> ShowS
InlineQueryId -> String
(Int -> InlineQueryId -> ShowS)
-> (InlineQueryId -> String)
-> ([InlineQueryId] -> ShowS)
-> Show InlineQueryId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InlineQueryId -> ShowS
showsPrec :: Int -> InlineQueryId -> ShowS
$cshow :: InlineQueryId -> String
show :: InlineQueryId -> String
$cshowList :: [InlineQueryId] -> ShowS
showList :: [InlineQueryId] -> ShowS
Show, [InlineQueryId] -> Value
[InlineQueryId] -> Encoding
InlineQueryId -> Bool
InlineQueryId -> Value
InlineQueryId -> Encoding
(InlineQueryId -> Value)
-> (InlineQueryId -> Encoding)
-> ([InlineQueryId] -> Value)
-> ([InlineQueryId] -> Encoding)
-> (InlineQueryId -> Bool)
-> ToJSON InlineQueryId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: InlineQueryId -> Value
toJSON :: InlineQueryId -> Value
$ctoEncoding :: InlineQueryId -> Encoding
toEncoding :: InlineQueryId -> Encoding
$ctoJSONList :: [InlineQueryId] -> Value
toJSONList :: [InlineQueryId] -> Value
$ctoEncodingList :: [InlineQueryId] -> Encoding
toEncodingList :: [InlineQueryId] -> Encoding
$comitField :: InlineQueryId -> Bool
omitField :: InlineQueryId -> Bool
ToJSON, Maybe InlineQueryId
Value -> Parser [InlineQueryId]
Value -> Parser InlineQueryId
(Value -> Parser InlineQueryId)
-> (Value -> Parser [InlineQueryId])
-> Maybe InlineQueryId
-> FromJSON InlineQueryId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser InlineQueryId
parseJSON :: Value -> Parser InlineQueryId
$cparseJSONList :: Value -> Parser [InlineQueryId]
parseJSONList :: Value -> Parser [InlineQueryId]
$comittedField :: Maybe InlineQueryId
omittedField :: Maybe InlineQueryId
FromJSON, Eq InlineQueryId
Eq InlineQueryId =>
(Int -> InlineQueryId -> Int)
-> (InlineQueryId -> Int) -> Hashable InlineQueryId
Int -> InlineQueryId -> Int
InlineQueryId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> InlineQueryId -> Int
hashWithSalt :: Int -> InlineQueryId -> Int
$chash :: InlineQueryId -> Int
hash :: InlineQueryId -> Int
Hashable, (forall x. InlineQueryId -> Rep InlineQueryId x)
-> (forall x. Rep InlineQueryId x -> InlineQueryId)
-> Generic InlineQueryId
forall x. Rep InlineQueryId x -> InlineQueryId
forall x. InlineQueryId -> Rep InlineQueryId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InlineQueryId -> Rep InlineQueryId x
from :: forall x. InlineQueryId -> Rep InlineQueryId x
$cto :: forall x. Rep InlineQueryId x -> InlineQueryId
to :: forall x. Rep InlineQueryId x -> InlineQueryId
Generic)
type AnswerInlineQuery
= "answerInlineQuery" :> ReqBody '[JSON] AnswerInlineQueryRequest :> Post '[JSON] (Response Bool)
answerInlineQuery :: AnswerInlineQueryRequest -> ClientM (Response Bool)
answerInlineQuery :: AnswerInlineQueryRequest -> ClientM (Response Bool)
answerInlineQuery = Proxy AnswerInlineQuery -> Client ClientM AnswerInlineQuery
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @AnswerInlineQuery)
data AnswerInlineQueryRequest = AnswerInlineQueryRequest
{ AnswerInlineQueryRequest -> InlineQueryId
answerInlineQueryRequestInlineQueryId :: InlineQueryId
, AnswerInlineQueryRequest -> [InlineQueryResult]
answerInlineQueryRequestResults :: [InlineQueryResult]
, AnswerInlineQueryRequest -> Maybe Seconds
answerInlineQueryCacheTime :: Maybe Seconds
, AnswerInlineQueryRequest -> Maybe Bool
answerInlineQueryIsPersonal :: Maybe Bool
, AnswerInlineQueryRequest -> Maybe Text
answerInlineQueryNextOffset :: Maybe Text
, AnswerInlineQueryRequest -> Maybe InlineQueryResultsButton
answerInlineQueryButton :: Maybe InlineQueryResultsButton
} deriving ((forall x.
AnswerInlineQueryRequest -> Rep AnswerInlineQueryRequest x)
-> (forall x.
Rep AnswerInlineQueryRequest x -> AnswerInlineQueryRequest)
-> Generic AnswerInlineQueryRequest
forall x.
Rep AnswerInlineQueryRequest x -> AnswerInlineQueryRequest
forall x.
AnswerInlineQueryRequest -> Rep AnswerInlineQueryRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
AnswerInlineQueryRequest -> Rep AnswerInlineQueryRequest x
from :: forall x.
AnswerInlineQueryRequest -> Rep AnswerInlineQueryRequest x
$cto :: forall x.
Rep AnswerInlineQueryRequest x -> AnswerInlineQueryRequest
to :: forall x.
Rep AnswerInlineQueryRequest x -> AnswerInlineQueryRequest
Generic)
instance ToJSON AnswerInlineQueryRequest where toJSON :: AnswerInlineQueryRequest -> Value
toJSON = AnswerInlineQueryRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance FromJSON AnswerInlineQueryRequest where parseJSON :: Value -> Parser AnswerInlineQueryRequest
parseJSON = Value -> Parser AnswerInlineQueryRequest
forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON
data ChosenInlineResult = ChosenInlineResult
{ ChosenInlineResult -> InlineQueryResultId
chosenInlineResultResultId :: InlineQueryResultId
, ChosenInlineResult -> User
chosenInlineResultFrom :: User
, ChosenInlineResult -> Maybe Location
chosenInlineResultLocation :: Maybe Location
, ChosenInlineResult -> Maybe InlineMessageId
chosenInlineResultInlineMessageId :: Maybe InlineMessageId
, ChosenInlineResult -> InlineQueryId
chosenInlineResultQuery :: InlineQueryId
} deriving ((forall x. ChosenInlineResult -> Rep ChosenInlineResult x)
-> (forall x. Rep ChosenInlineResult x -> ChosenInlineResult)
-> Generic ChosenInlineResult
forall x. Rep ChosenInlineResult x -> ChosenInlineResult
forall x. ChosenInlineResult -> Rep ChosenInlineResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChosenInlineResult -> Rep ChosenInlineResult x
from :: forall x. ChosenInlineResult -> Rep ChosenInlineResult x
$cto :: forall x. Rep ChosenInlineResult x -> ChosenInlineResult
to :: forall x. Rep ChosenInlineResult x -> ChosenInlineResult
Generic, Int -> ChosenInlineResult -> ShowS
[ChosenInlineResult] -> ShowS
ChosenInlineResult -> String
(Int -> ChosenInlineResult -> ShowS)
-> (ChosenInlineResult -> String)
-> ([ChosenInlineResult] -> ShowS)
-> Show ChosenInlineResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChosenInlineResult -> ShowS
showsPrec :: Int -> ChosenInlineResult -> ShowS
$cshow :: ChosenInlineResult -> String
show :: ChosenInlineResult -> String
$cshowList :: [ChosenInlineResult] -> ShowS
showList :: [ChosenInlineResult] -> ShowS
Show)
instance ToJSON ChosenInlineResult where toJSON :: ChosenInlineResult -> Value
toJSON = ChosenInlineResult -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance FromJSON ChosenInlineResult where parseJSON :: Value -> Parser ChosenInlineResult
parseJSON = Value -> Parser ChosenInlineResult
forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON
deriveJSON' ''InlineQuery
makeDefault ''AnswerInlineQueryRequest