{-# 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 ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"default" []
    BotCommandScope
BotCommandScopeAllPrivateChats ->
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"all_private_chats" []
    BotCommandScope
BotCommandScopeAllGroupChats ->
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"all_group_chats" []
    BotCommandScope
BotCommandScopeAllChatAdministrators ->
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"all_chat_administrators" []
    BotCommandScopeChat SomeChatId
sci ->
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"chat" [Key
"chat_id" Key -> SomeChatId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SomeChatId
sci]
    BotCommandScopeChatAdministrators SomeChatId
sci ->
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"chat_administrators" [Key
"chat_id" Key -> SomeChatId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SomeChatId
sci]
    BotCommandScopeChatMember SomeChatId
sci UserId
ui ->
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> [Pair]
addType Text
"chat_member" [Key
"chat_id" Key -> SomeChatId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SomeChatId
sci, Key
"user_id" Key -> UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UserId
ui]

instance FromJSON BotCommandScope where
  parseJSON :: Value -> Parser BotCommandScope
parseJSON = String
-> (Object -> Parser BotCommandScope)
-> Value
-> Parser BotCommandScope
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BotCommandScope" \Object
o ->
    (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Text) Parser Text
-> (Text -> Parser BotCommandScope) -> Parser BotCommandScope
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
"default" ->                BotCommandScope -> Parser BotCommandScope
forall (f :: * -> *) a. Applicative f => a -> f a
pure BotCommandScope
BotCommandScopeDefault
    Text
"all_private_chats" ->      BotCommandScope -> Parser BotCommandScope
forall (f :: * -> *) a. Applicative f => a -> f a
pure BotCommandScope
BotCommandScopeAllPrivateChats
    Text
"all_group_chats" ->        BotCommandScope -> Parser BotCommandScope
forall (f :: * -> *) a. Applicative f => a -> f a
pure BotCommandScope
BotCommandScopeAllGroupChats
    Text
"all_chat_administrators"-> BotCommandScope -> Parser BotCommandScope
forall (f :: * -> *) a. Applicative f => a -> f a
pure BotCommandScope
BotCommandScopeAllChatAdministrators
    Text
"chat" ->                        SomeChatId -> BotCommandScope
BotCommandScopeChat (SomeChatId -> BotCommandScope)
-> Parser SomeChatId -> Parser BotCommandScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser SomeChatId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chat_id"
    Text
"chat_administrators"->          SomeChatId -> BotCommandScope
BotCommandScopeChatAdministrators (SomeChatId -> BotCommandScope)
-> Parser SomeChatId -> Parser BotCommandScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser SomeChatId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chat_id"
    Text
"chat_member"->                  SomeChatId -> UserId -> BotCommandScope
BotCommandScopeChatMember (SomeChatId -> UserId -> BotCommandScope)
-> Parser SomeChatId -> Parser (UserId -> BotCommandScope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser SomeChatId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chat_id" Parser (UserId -> BotCommandScope)
-> Parser UserId -> Parser BotCommandScope
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser UserId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
    Text
t -> String -> Parser BotCommandScope
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser BotCommandScope)
-> String -> Parser BotCommandScope
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text
"Unknown type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)