module Network.Telegram.API.Bot.Property.Persistable
        (Persistable (..), Payload, PL (..), Capacity (..), Message' (..)) where

import "aeson" Data.Aeson (FromJSON, Value, decode, object, (.=))
import "base" Control.Exception (try)
import "base" Control.Monad (Monad ((>>=)), join)
import "base" Data.Function (flip, (.), ($))
import "base" Data.Functor (Functor (fmap), (<$>))
import "base" Data.Int (Int, Int64)
import "base" Data.Maybe (Maybe, fromJust)
import "base" Data.Semigroup (Semigroup ((<>)))
import "base" Data.String (String)
import "base" Data.Tuple (snd)
import "http-client" Network.HTTP.Client (Response (responseBody))
import "text" Data.Text (Text, unpack)
import "transformers" Control.Monad.Trans.Class (lift)
import "transformers" Control.Monad.Trans.Except (ExceptT (ExceptT))
import "transformers" Control.Monad.Trans.Reader (ask)
import "wreq" Network.Wreq.Session (post)

import Network.Telegram.API.Bot.Core (Telegram, Token (Token), Ok, result)
import Network.Telegram.API.Bot.Object (Object, Keyboard, Notification, Member, Sender)
import Network.Telegram.API.Bot.Object.Update.Message (Message)
import Network.Telegram.API.Bot.Object.Update.Message.Content.Info (Info)
import Network.Telegram.API.Bot.Object.Update.Message.Content.Location (Location)

data Capacity = Post' | Fetch' | Edit' | Purge'

newtype PL c o a = PL a

type family Payload (c :: k) o = r | r -> o c

type instance Payload 'Post' Keyboard = PL 'Post' Keyboard (Int64, Text, Keyboard)
type instance Payload 'Edit' Keyboard = PL 'Edit' Keyboard (Int64, Int, Keyboard)
type instance Payload 'Fetch' Member = PL 'Fetch' Member (Int64, Int)
type instance Payload 'Edit' Message = PL 'Edit' Message (Int64, Int, Text)
type instance Payload 'Purge' Message = PL 'Purge' Message (Int64, Int)
type instance Payload 'Post' Notification = PL 'Post' Notification (Text, Text)
type instance Payload 'Fetch' Sender = PL 'Fetch' Sender ()

data Message' = Direct' Capacity | Forward' Capacity | Reply' Capacity

type instance Payload ('Direct' 'Post') Message = PL ('Direct' 'Post') Message (Int64, Text)
type instance Payload ('Forward' 'Post') Message = PL ('Forward' 'Post') Message (Int64, Int64, Int)
type instance Payload ('Reply' 'Post') Message = PL ('Reply' 'Post') Message (Int64, Int, Text)

data Info' = Point' Message' | Contact' Message' | Venue' Message'

type instance Payload ('Point' ('Direct' 'Post')) Info = PL ('Point' ('Direct' 'Post')) Info (Int64, Location, Int)
type instance Payload ('Contact' ('Direct' 'Post')) Info = PL ('Contact' ('Direct' 'Post')) Info (Int64, Text, Text, Maybe Text, Maybe Text)
type instance Payload ('Venue' ('Direct' 'Post')) Info = PL ('Venue' ('Direct' 'Post')) Info (Int64, Location, Text, Text, Maybe Text, Maybe Text)
type instance Payload ('Point' ('Reply' 'Post')) Info = PL ('Point' ('Reply' 'Post')) Info (Int64, Int, Location, Int)
type instance Payload ('Contact' ('Reply' 'Post')) Info = PL ('Contact' ('Reply' 'Post')) Info (Int64, Int, Text, Text, Maybe Text, Maybe Text)
type instance Payload ('Venue' ('Reply' 'Post')) Info = PL ('Venue' ('Reply' 'Post')) Info (Int64, Int, Location, Text, Text, Maybe Text, Maybe Text)

data Member' = Kick' | Unban'

type instance Payload 'Kick' Member = PL 'Kick' Member (Int64, Int, Int)
type instance Payload 'Unban' Member = PL 'Unban' Member (Int64, Int)

class Object o => Persistable c o where
        {-# MINIMAL payload, endpoint #-}
        payload :: Payload c o -> Value
        endpoint :: Payload c o -> String
        request :: FromJSON r => Payload c o -> Telegram e r
        request x = request' (endpoint x) (payload x) where

                request' :: forall a e . FromJSON a => String -> Value -> Telegram e a
                request' e p = snd <$> ask >>= \(session, Token token) -> lift . ExceptT . try
                        . fmap (fromJust . join . fmap result . decode @(Ok a) . responseBody)
                                . flip (post session) p $ "https://api.telegram.org/" <> unpack token <> "/" <> e

instance Persistable 'Edit' Keyboard where
        payload (PL (chat_id, message_id, reply_markup)) = object
                ["chat_id" .= chat_id, "message_id" .= message_id, "reply_markup" .= reply_markup]
        endpoint _ = "editMessageReplyMarkup"

instance Persistable 'Post' Keyboard where
        payload (PL (chat_id, text, kb)) = object
                ["chat_id" .= chat_id, "text" .= text, "reply_markup" .= kb]
        endpoint _ = "sendMessage"

instance Persistable 'Fetch' Member where
        payload (PL (chat_id, user_id)) = object ["chat_id" .= chat_id, "user_id" .= user_id]
        endpoint _ = "getChatMember"

instance Persistable ('Direct' 'Post') Message where
        payload (PL (chat_id, text)) = object ["chat_id" .= chat_id, "text" .= text]
        endpoint _ = "sendMessage"

instance Persistable ('Forward' 'Post') Message where
        payload (PL (chat_id, from_chat_id, message_id)) = object
                ["chat_id" .= chat_id, "from_chat_id" .= from_chat_id, "message_id" .= message_id]
        endpoint _ = "forwardMessage"

instance Persistable ('Reply' 'Post') Message where
        payload (PL (chat_id, reply_to_message_id, text)) = object
                ["chat_id" .= chat_id, "reply_to_message_id" .= reply_to_message_id, "text" .= text]
        endpoint _ = "sendMessage"

instance Persistable 'Purge' Message where
        payload (PL (chat_id, message_id)) = object ["chat_id" .= chat_id, "message_id" .= message_id]
        endpoint _ = "deleteMessage"

instance Persistable 'Post' Notification where
        payload (PL (cbq_id, text)) = object ["callback_query_id" .= cbq_id, "text" .= text]
        endpoint _ = "answerCallbackQuery"

instance Persistable 'Fetch' Sender where
        payload (PL ()) = object []
        endpoint _ = "getMe"

instance Persistable 'Edit' Message where
        payload (PL (chat_id, message_id, text)) = object
                ["chat_id" .= chat_id, "message_id" .= message_id, "text" .= text]
        endpoint _ = "editMessageText"

instance Persistable ('Point' ('Direct' 'Post')) Info where
        payload (PL (chat_id, location, live_period)) = object
                ["chat_id" .= chat_id, "location" .= location, "live_period" .= live_period]
        endpoint _ = "sendLocation"

instance Persistable ('Contact' ('Direct' 'Post')) Info where
        payload (PL (chat_id, phone_number, first_name, last_name, vcard)) =
                object ["chat_id" .= chat_id, "phone_number" .= phone_number,
                        "first_name" .= first_name, "last_name" .= last_name, "vcard" .= vcard]
        endpoint _ = "sendContact"

instance Persistable ('Venue' ('Direct' 'Post')) Info where
        payload (PL (chat_id, location, title, address, foursquare_id, foursquare_type)) = object
                ["chat_id" .= chat_id, "location" .= location, "title" .= title, "address" .= address,
                        "foursquare_id" .= foursquare_id, "foursquare_type" .= foursquare_type]
        endpoint _ = "sendVenue"

instance Persistable ('Point' ('Reply' 'Post')) Info where
        payload (PL (chat_id, reply_to_message_id, location, live_period)) = object
                ["chat_id" .= chat_id, "reply_to_message_id" .= reply_to_message_id,
                        "location" .= location, "live_period" .= live_period]
        endpoint _ = "sendLocation"

instance Persistable ('Contact' ('Reply' 'Post')) Info where
        payload (PL (chat_id, reply_to_message_id, phone_number, first_name, last_name, vcard)) = object
                ["chat_id" .= chat_id, "reply_to_message_id" .= reply_to_message_id, "phone_number" .= phone_number,
                        "first_name" .= first_name, "last_name" .= last_name, "vcard" .= vcard]
        endpoint _ = "sendContact"

instance Persistable ('Venue' ('Reply' 'Post')) Info where
        payload (PL (chat_id, reply_to_message_id, location, title, address, foursquare_id, foursquare_type)) = object
                ["chat_id" .= chat_id, "reply_to_message_id" .= reply_to_message_id, "location" .= location, "title" .= title,
                        "address" .= address, "foursquare_id" .= foursquare_id, "foursquare_type" .= foursquare_type]
        endpoint _ = "sendVenue"

instance Persistable 'Kick' Member where
        payload (PL (chat_id, user_id, until_date)) = object
                ["chat_id" .= chat_id, "user_id" .= user_id, "until_date" .= until_date]
        endpoint _ = "kickChatMember"

instance Persistable 'Unban' Member where
        payload (PL (chat_id, user_id)) = object ["chat_id" .= chat_id, "user_id" .= user_id]
        endpoint _ = "unbanChatMember"