{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Telegram.Bot.API.Types.BotCommandScope where

import Data.Aeson (KeyValue ((.=)), FromJSON (..), ToJSON (..), object, withObject, (.:))
import Data.Aeson.Types (Parser)
import Data.Text (Text)

import qualified Data.Text as Text

import Telegram.Bot.API.Types.Common

data BotCommandScope
  = BotCommandScopeDefault -- ^ Represents the default scope of bot commands. Default commands are used if no commands with a narrower scope are specified for the user.
  | BotCommandScopeAllPrivateChats -- ^ Represents the scope of bot commands, covering all private chats.
  | BotCommandScopeAllGroupChats -- ^ Represents the scope of bot commands, covering all group and supergroup chats.
  | BotCommandScopeAllChatAdministrators -- ^ Represents the scope of bot commands, covering all group and supergroup chat administrators.
  | BotCommandScopeChat SomeChatId -- ^ Represents the scope of bot commands, covering a specific chat.
  | BotCommandScopeChatAdministrators SomeChatId -- ^ Represents the scope of bot commands, covering all administrators of a specific group or supergroup chat.
  | BotCommandScopeChatMember SomeChatId UserId -- ^ Represents the scope of bot commands, covering a specific member of a group or supergroup chat.

instance ToJSON BotCommandScope where
  toJSON :: BotCommandScope -> Value
toJSON = \case
    BotCommandScope
BotCommandScopeDefault ->
      [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"default" []
    BotCommandScope
BotCommandScopeAllPrivateChats ->
      [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"all_private_chats" []
    BotCommandScope
BotCommandScopeAllGroupChats ->
      [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"all_group_chats" []
    BotCommandScope
BotCommandScopeAllChatAdministrators ->
      [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"all_chat_administrators" []
    BotCommandScopeChat SomeChatId
sci ->
      [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"chat" [Key
"chat_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SomeChatId
sci]
    BotCommandScopeChatAdministrators SomeChatId
sci ->
      [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"chat_administrators" [Key
"chat_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SomeChatId
sci]
    BotCommandScopeChatMember SomeChatId
sci UserId
ui ->
      [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"chat_member" [Key
"chat_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SomeChatId
sci, Key
"user_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UserId
ui]

instance FromJSON BotCommandScope where
  parseJSON :: Value -> Parser BotCommandScope
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BotCommandScope" \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
"default" ->                forall (f :: * -> *) a. Applicative f => a -> f a
pure BotCommandScope
BotCommandScopeDefault
    Text
"all_private_chats" ->      forall (f :: * -> *) a. Applicative f => a -> f a
pure BotCommandScope
BotCommandScopeAllPrivateChats
    Text
"all_group_chats" ->        forall (f :: * -> *) a. Applicative f => a -> f a
pure BotCommandScope
BotCommandScopeAllGroupChats
    Text
"all_chat_administrators"-> forall (f :: * -> *) a. Applicative f => a -> f a
pure BotCommandScope
BotCommandScopeAllChatAdministrators
    Text
"chat" ->                        SomeChatId -> BotCommandScope
BotCommandScopeChat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chat_id"
    Text
"chat_administrators"->          SomeChatId -> BotCommandScope
BotCommandScopeChatAdministrators forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chat_id"
    Text
"chat_member"->                  SomeChatId -> UserId -> BotCommandScope
BotCommandScopeChatMember forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chat_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
"user_id"
    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)