{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Telegram.Bot.API.Types.Common where

import Data.Aeson (FromJSON (..), ToJSON (..), KeyValue ((.=)))
import Data.Aeson.Types (Pair)
import Data.Coerce (coerce)
import Data.Hashable (Hashable)
import Data.Text (Text, pack)
import GHC.Generics (Generic)
import Servant.API (ToHttpApiData (..))

import Telegram.Bot.API.Internal.Utils

-- | Unique identifier for this file.
newtype FileId = FileId Text
  deriving (FileId -> FileId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileId -> FileId -> Bool
$c/= :: FileId -> FileId -> Bool
== :: FileId -> FileId -> Bool
$c== :: FileId -> FileId -> Bool
Eq, Int -> FileId -> ShowS
[FileId] -> ShowS
FileId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileId] -> ShowS
$cshowList :: [FileId] -> ShowS
show :: FileId -> String
$cshow :: FileId -> String
showsPrec :: Int -> FileId -> ShowS
$cshowsPrec :: Int -> FileId -> ShowS
Show, [FileId] -> Encoding
[FileId] -> Value
FileId -> Encoding
FileId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FileId] -> Encoding
$ctoEncodingList :: [FileId] -> Encoding
toJSONList :: [FileId] -> Value
$ctoJSONList :: [FileId] -> Value
toEncoding :: FileId -> Encoding
$ctoEncoding :: FileId -> Encoding
toJSON :: FileId -> Value
$ctoJSON :: FileId -> Value
ToJSON, Value -> Parser [FileId]
Value -> Parser FileId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FileId]
$cparseJSONList :: Value -> Parser [FileId]
parseJSON :: Value -> Parser FileId
$cparseJSON :: Value -> Parser FileId
FromJSON)

instance ToHttpApiData FileId where
  toUrlPiece :: FileId -> Text
toUrlPiece = coerce :: forall a b. Coercible a b => a -> b
coerce

newtype Seconds = Seconds Int
  deriving (Seconds -> Seconds -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Seconds -> Seconds -> Bool
$c/= :: Seconds -> Seconds -> Bool
== :: Seconds -> Seconds -> Bool
$c== :: Seconds -> Seconds -> Bool
Eq, Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seconds] -> ShowS
$cshowList :: [Seconds] -> ShowS
show :: Seconds -> String
$cshow :: Seconds -> String
showsPrec :: Int -> Seconds -> ShowS
$cshowsPrec :: Int -> Seconds -> ShowS
Show, Integer -> Seconds
Seconds -> Seconds
Seconds -> Seconds -> Seconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Seconds
$cfromInteger :: Integer -> Seconds
signum :: Seconds -> Seconds
$csignum :: Seconds -> Seconds
abs :: Seconds -> Seconds
$cabs :: Seconds -> Seconds
negate :: Seconds -> Seconds
$cnegate :: Seconds -> Seconds
* :: Seconds -> Seconds -> Seconds
$c* :: Seconds -> Seconds -> Seconds
- :: Seconds -> Seconds -> Seconds
$c- :: Seconds -> Seconds -> Seconds
+ :: Seconds -> Seconds -> Seconds
$c+ :: Seconds -> Seconds -> Seconds
Num, [Seconds] -> Encoding
[Seconds] -> Value
Seconds -> Encoding
Seconds -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Seconds] -> Encoding
$ctoEncodingList :: [Seconds] -> Encoding
toJSONList :: [Seconds] -> Value
$ctoJSONList :: [Seconds] -> Value
toEncoding :: Seconds -> Encoding
$ctoEncoding :: Seconds -> Encoding
toJSON :: Seconds -> Value
$ctoJSON :: Seconds -> Value
ToJSON, Value -> Parser [Seconds]
Value -> Parser Seconds
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Seconds]
$cparseJSONList :: Value -> Parser [Seconds]
parseJSON :: Value -> Parser Seconds
$cparseJSON :: Value -> Parser Seconds
FromJSON)

-- | Unique identifier for this user or bot.
newtype UserId = UserId Integer
  deriving (UserId -> UserId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserId -> UserId -> Bool
$c/= :: UserId -> UserId -> Bool
== :: UserId -> UserId -> Bool
$c== :: UserId -> UserId -> Bool
Eq, Int -> UserId -> ShowS
[UserId] -> ShowS
UserId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserId] -> ShowS
$cshowList :: [UserId] -> ShowS
show :: UserId -> String
$cshow :: UserId -> String
showsPrec :: Int -> UserId -> ShowS
$cshowsPrec :: Int -> UserId -> ShowS
Show, [UserId] -> Encoding
[UserId] -> Value
UserId -> Encoding
UserId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UserId] -> Encoding
$ctoEncodingList :: [UserId] -> Encoding
toJSONList :: [UserId] -> Value
$ctoJSONList :: [UserId] -> Value
toEncoding :: UserId -> Encoding
$ctoEncoding :: UserId -> Encoding
toJSON :: UserId -> Value
$ctoJSON :: UserId -> Value
ToJSON, Value -> Parser [UserId]
Value -> Parser UserId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UserId]
$cparseJSONList :: Value -> Parser [UserId]
parseJSON :: Value -> Parser UserId
$cparseJSON :: Value -> Parser UserId
FromJSON)

instance ToHttpApiData UserId where
  toUrlPiece :: UserId -> Text
toUrlPiece = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show @Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce

-- | Unique identifier for this chat.
newtype ChatId = ChatId Integer
  deriving (ChatId -> ChatId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChatId -> ChatId -> Bool
$c/= :: ChatId -> ChatId -> Bool
== :: ChatId -> ChatId -> Bool
$c== :: ChatId -> ChatId -> Bool
Eq, Int -> ChatId -> ShowS
[ChatId] -> ShowS
ChatId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChatId] -> ShowS
$cshowList :: [ChatId] -> ShowS
show :: ChatId -> String
$cshow :: ChatId -> String
showsPrec :: Int -> ChatId -> ShowS
$cshowsPrec :: Int -> ChatId -> ShowS
Show, [ChatId] -> Encoding
[ChatId] -> Value
ChatId -> Encoding
ChatId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChatId] -> Encoding
$ctoEncodingList :: [ChatId] -> Encoding
toJSONList :: [ChatId] -> Value
$ctoJSONList :: [ChatId] -> Value
toEncoding :: ChatId -> Encoding
$ctoEncoding :: ChatId -> Encoding
toJSON :: ChatId -> Value
$ctoJSON :: ChatId -> Value
ToJSON, Value -> Parser [ChatId]
Value -> Parser ChatId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ChatId]
$cparseJSONList :: Value -> Parser [ChatId]
parseJSON :: Value -> Parser ChatId
$cparseJSON :: Value -> Parser ChatId
FromJSON, Eq ChatId
Int -> ChatId -> Int
ChatId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ChatId -> Int
$chash :: ChatId -> Int
hashWithSalt :: Int -> ChatId -> Int
$chashWithSalt :: Int -> ChatId -> Int
Hashable)

instance ToHttpApiData ChatId where
  toUrlPiece :: ChatId -> Text
toUrlPiece ChatId
a = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show @Integer forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce ChatId
a

-- | Unique message identifier inside this chat.
newtype MessageId = MessageId Integer
  deriving (MessageId -> MessageId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageId -> MessageId -> Bool
$c/= :: MessageId -> MessageId -> Bool
== :: MessageId -> MessageId -> Bool
$c== :: MessageId -> MessageId -> Bool
Eq, Int -> MessageId -> ShowS
[MessageId] -> ShowS
MessageId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageId] -> ShowS
$cshowList :: [MessageId] -> ShowS
show :: MessageId -> String
$cshow :: MessageId -> String
showsPrec :: Int -> MessageId -> ShowS
$cshowsPrec :: Int -> MessageId -> ShowS
Show, [MessageId] -> Encoding
[MessageId] -> Value
MessageId -> Encoding
MessageId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MessageId] -> Encoding
$ctoEncodingList :: [MessageId] -> Encoding
toJSONList :: [MessageId] -> Value
$ctoJSONList :: [MessageId] -> Value
toEncoding :: MessageId -> Encoding
$ctoEncoding :: MessageId -> Encoding
toJSON :: MessageId -> Value
$ctoJSON :: MessageId -> Value
ToJSON, Value -> Parser [MessageId]
Value -> Parser MessageId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MessageId]
$cparseJSONList :: Value -> Parser [MessageId]
parseJSON :: Value -> Parser MessageId
$cparseJSON :: Value -> Parser MessageId
FromJSON, Eq MessageId
Int -> MessageId -> Int
MessageId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MessageId -> Int
$chash :: MessageId -> Int
hashWithSalt :: Int -> MessageId -> Int
$chashWithSalt :: Int -> MessageId -> Int
Hashable)

instance ToHttpApiData MessageId where
  toUrlPiece :: MessageId -> Text
toUrlPiece MessageId
a = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show @Integer forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce MessageId
a

-- | Unique identifier of a message thread to which the message belongs; for supergroups only.
newtype MessageThreadId = MessageThreadId Integer
  deriving (MessageThreadId -> MessageThreadId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageThreadId -> MessageThreadId -> Bool
$c/= :: MessageThreadId -> MessageThreadId -> Bool
== :: MessageThreadId -> MessageThreadId -> Bool
$c== :: MessageThreadId -> MessageThreadId -> Bool
Eq, Int -> MessageThreadId -> ShowS
[MessageThreadId] -> ShowS
MessageThreadId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageThreadId] -> ShowS
$cshowList :: [MessageThreadId] -> ShowS
show :: MessageThreadId -> String
$cshow :: MessageThreadId -> String
showsPrec :: Int -> MessageThreadId -> ShowS
$cshowsPrec :: Int -> MessageThreadId -> ShowS
Show, [MessageThreadId] -> Encoding
[MessageThreadId] -> Value
MessageThreadId -> Encoding
MessageThreadId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MessageThreadId] -> Encoding
$ctoEncodingList :: [MessageThreadId] -> Encoding
toJSONList :: [MessageThreadId] -> Value
$ctoJSONList :: [MessageThreadId] -> Value
toEncoding :: MessageThreadId -> Encoding
$ctoEncoding :: MessageThreadId -> Encoding
toJSON :: MessageThreadId -> Value
$ctoJSON :: MessageThreadId -> Value
ToJSON, Value -> Parser [MessageThreadId]
Value -> Parser MessageThreadId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MessageThreadId]
$cparseJSONList :: Value -> Parser [MessageThreadId]
parseJSON :: Value -> Parser MessageThreadId
$cparseJSON :: Value -> Parser MessageThreadId
FromJSON, Eq MessageThreadId
Int -> MessageThreadId -> Int
MessageThreadId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MessageThreadId -> Int
$chash :: MessageThreadId -> Int
hashWithSalt :: Int -> MessageThreadId -> Int
$chashWithSalt :: Int -> MessageThreadId -> Int
Hashable)

instance ToHttpApiData MessageThreadId where
  toUrlPiece :: MessageThreadId -> Text
toUrlPiece MessageThreadId
a = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show @Integer forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce MessageThreadId
a

-- | The unique identifier of a media message group a message belongs to.
newtype MediaGroupId = MediaGroupId Text
  deriving (MediaGroupId -> MediaGroupId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MediaGroupId -> MediaGroupId -> Bool
$c/= :: MediaGroupId -> MediaGroupId -> Bool
== :: MediaGroupId -> MediaGroupId -> Bool
$c== :: MediaGroupId -> MediaGroupId -> Bool
Eq, Int -> MediaGroupId -> ShowS
[MediaGroupId] -> ShowS
MediaGroupId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MediaGroupId] -> ShowS
$cshowList :: [MediaGroupId] -> ShowS
show :: MediaGroupId -> String
$cshow :: MediaGroupId -> String
showsPrec :: Int -> MediaGroupId -> ShowS
$cshowsPrec :: Int -> MediaGroupId -> ShowS
Show, [MediaGroupId] -> Encoding
[MediaGroupId] -> Value
MediaGroupId -> Encoding
MediaGroupId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MediaGroupId] -> Encoding
$ctoEncodingList :: [MediaGroupId] -> Encoding
toJSONList :: [MediaGroupId] -> Value
$ctoJSONList :: [MediaGroupId] -> Value
toEncoding :: MediaGroupId -> Encoding
$ctoEncoding :: MediaGroupId -> Encoding
toJSON :: MediaGroupId -> Value
$ctoJSON :: MediaGroupId -> Value
ToJSON, Value -> Parser [MediaGroupId]
Value -> Parser MediaGroupId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MediaGroupId]
$cparseJSONList :: Value -> Parser [MediaGroupId]
parseJSON :: Value -> Parser MediaGroupId
$cparseJSON :: Value -> Parser MediaGroupId
FromJSON)

-- | Signed 32-bit identifier of the request, which will be received back in the 'UserShared' or 'ChatShared' object. Must be unique within the message.
newtype RequestId = RequestId Integer
  deriving (RequestId -> RequestId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestId -> RequestId -> Bool
$c/= :: RequestId -> RequestId -> Bool
== :: RequestId -> RequestId -> Bool
$c== :: RequestId -> RequestId -> Bool
Eq, Int -> RequestId -> ShowS
[RequestId] -> ShowS
RequestId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestId] -> ShowS
$cshowList :: [RequestId] -> ShowS
show :: RequestId -> String
$cshow :: RequestId -> String
showsPrec :: Int -> RequestId -> ShowS
$cshowsPrec :: Int -> RequestId -> ShowS
Show, [RequestId] -> Encoding
[RequestId] -> Value
RequestId -> Encoding
RequestId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RequestId] -> Encoding
$ctoEncodingList :: [RequestId] -> Encoding
toJSONList :: [RequestId] -> Value
$ctoJSONList :: [RequestId] -> Value
toEncoding :: RequestId -> Encoding
$ctoEncoding :: RequestId -> Encoding
toJSON :: RequestId -> Value
$ctoJSON :: RequestId -> Value
ToJSON, Value -> Parser [RequestId]
Value -> Parser RequestId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RequestId]
$cparseJSONList :: Value -> Parser [RequestId]
parseJSON :: Value -> Parser RequestId
$cparseJSON :: Value -> Parser RequestId
FromJSON)

-- | Unique poll identifier.
newtype PollId = PollId Text
  deriving (PollId -> PollId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PollId -> PollId -> Bool
$c/= :: PollId -> PollId -> Bool
== :: PollId -> PollId -> Bool
$c== :: PollId -> PollId -> Bool
Eq, Int -> PollId -> ShowS
[PollId] -> ShowS
PollId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PollId] -> ShowS
$cshowList :: [PollId] -> ShowS
show :: PollId -> String
$cshow :: PollId -> String
showsPrec :: Int -> PollId -> ShowS
$cshowsPrec :: Int -> PollId -> ShowS
Show, [PollId] -> Encoding
[PollId] -> Value
PollId -> Encoding
PollId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PollId] -> Encoding
$ctoEncodingList :: [PollId] -> Encoding
toJSONList :: [PollId] -> Value
$ctoJSONList :: [PollId] -> Value
toEncoding :: PollId -> Encoding
$ctoEncoding :: PollId -> Encoding
toJSON :: PollId -> Value
$ctoJSON :: PollId -> Value
ToJSON, Value -> Parser [PollId]
Value -> Parser PollId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PollId]
$cparseJSONList :: Value -> Parser [PollId]
parseJSON :: Value -> Parser PollId
$cparseJSON :: Value -> Parser PollId
FromJSON)

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

newtype WebAppInfo = WebAppInfo { WebAppInfo -> Text
webAppInfoUrl :: Text }
  deriving (forall x. Rep WebAppInfo x -> WebAppInfo
forall x. WebAppInfo -> Rep WebAppInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WebAppInfo x -> WebAppInfo
$cfrom :: forall x. WebAppInfo -> Rep WebAppInfo x
Generic, Int -> WebAppInfo -> ShowS
[WebAppInfo] -> ShowS
WebAppInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebAppInfo] -> ShowS
$cshowList :: [WebAppInfo] -> ShowS
show :: WebAppInfo -> String
$cshow :: WebAppInfo -> String
showsPrec :: Int -> WebAppInfo -> ShowS
$cshowsPrec :: Int -> WebAppInfo -> ShowS
Show, [WebAppInfo] -> Encoding
[WebAppInfo] -> Value
WebAppInfo -> Encoding
WebAppInfo -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WebAppInfo] -> Encoding
$ctoEncodingList :: [WebAppInfo] -> Encoding
toJSONList :: [WebAppInfo] -> Value
$ctoJSONList :: [WebAppInfo] -> Value
toEncoding :: WebAppInfo -> Encoding
$ctoEncoding :: WebAppInfo -> Encoding
toJSON :: WebAppInfo -> Value
$ctoJSON :: WebAppInfo -> Value
ToJSON, Value -> Parser [WebAppInfo]
Value -> Parser WebAppInfo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WebAppInfo]
$cparseJSONList :: Value -> Parser [WebAppInfo]
parseJSON :: Value -> Parser WebAppInfo
$cparseJSON :: Value -> Parser WebAppInfo
FromJSON)

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

-- | Unique identifier for the target chat
-- or username of the target channel (in the format @\@channelusername@).
data SomeChatId
  = SomeChatId ChatId       -- ^ Unique chat ID.
  | SomeChatUsername Text   -- ^ Username of the target channel.
  deriving (forall x. Rep SomeChatId x -> SomeChatId
forall x. SomeChatId -> Rep SomeChatId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SomeChatId x -> SomeChatId
$cfrom :: forall x. SomeChatId -> Rep SomeChatId x
Generic)

instance ToJSON   SomeChatId where toJSON :: SomeChatId -> Value
toJSON = forall a. (Generic a, GSomeJSON (Rep a)) => a -> Value
genericSomeToJSON
instance FromJSON SomeChatId where parseJSON :: Value -> Parser SomeChatId
parseJSON = forall a. (Generic a, GSomeJSON (Rep a)) => Value -> Parser a
genericSomeParseJSON

instance ToHttpApiData SomeChatId where
  toUrlPiece :: SomeChatId -> Text
toUrlPiece (SomeChatId ChatId
chatid) = forall a. ToHttpApiData a => a -> Text
toUrlPiece ChatId
chatid
  toUrlPiece (SomeChatUsername Text
name) = Text
name

addType :: Text -> [Pair] -> [Pair]
addType :: Text -> [Pair] -> [Pair]
addType Text
name [Pair]
xs = (Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name) forall a. a -> [a] -> [a]
: [Pair]
xs