{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
module Telegram.Bot.Simple.Reply where
import Control.Applicative ((<|>))
import Control.Monad.Reader
import Data.String
import Data.Text (Text)
import GHC.Generics (Generic)
import Telegram.Bot.API as Telegram
import Telegram.Bot.Simple.Eff
currentChatId :: BotM (Maybe ChatId)
currentChatId = do
mupdate <- asks botContextUpdate
pure $ updateChatId =<< mupdate
getEditMessageId :: BotM (Maybe EditMessageId)
getEditMessageId = do
mupdate <- asks botContextUpdate
pure $ updateEditMessageId =<< mupdate
updateEditMessageId :: Update -> Maybe EditMessageId
updateEditMessageId update
= EditInlineMessageId
<$> (callbackQueryInlineMessageId =<< updateCallbackQuery update)
<|> EditChatMessageId
<$> (SomeChatId . chatId . messageChat <$> message)
<*> (messageMessageId <$> message)
where
message = extractUpdateMessage update
data ReplyMessage = ReplyMessage
{ replyMessageText :: Text
, replyMessageParseMode :: Maybe ParseMode
, replyMessageDisableWebPagePreview :: Maybe Bool
, replyMessageDisableNotification :: Maybe Bool
, replyMessageReplyToMessageId :: Maybe MessageId
, replyMessageReplyMarkup :: Maybe SomeReplyMarkup
} deriving (Generic)
instance IsString ReplyMessage where
fromString = toReplyMessage . fromString
toReplyMessage :: Text -> ReplyMessage
toReplyMessage text = ReplyMessage text Nothing Nothing Nothing Nothing Nothing
replyMessageToSendMessageRequest :: SomeChatId -> ReplyMessage -> SendMessageRequest
replyMessageToSendMessageRequest someChatId ReplyMessage{..} = SendMessageRequest
{ sendMessageChatId = someChatId
, sendMessageText = replyMessageText
, sendMessageParseMode = replyMessageParseMode
, sendMessageDisableWebPagePreview = replyMessageDisableWebPagePreview
, sendMessageDisableNotification = replyMessageDisableNotification
, sendMessageReplyToMessageId = replyMessageReplyToMessageId
, sendMessageReplyMarkup = replyMessageReplyMarkup
}
replyTo :: SomeChatId -> ReplyMessage -> BotM ()
replyTo someChatId rmsg = do
let msg = replyMessageToSendMessageRequest someChatId rmsg
void $ liftClientM $ sendMessage msg
reply :: ReplyMessage -> BotM ()
reply rmsg = do
mchatId <- currentChatId
case mchatId of
Just chatId -> replyTo (SomeChatId chatId) rmsg
Nothing -> liftIO $ putStrLn "No chat to reply to"
replyText :: Text -> BotM ()
replyText = reply . toReplyMessage
data EditMessage = EditMessage
{ editMessageText :: Text
, editMessageParseMode :: Maybe ParseMode
, editMessageDisableWebPagePreview :: Maybe Bool
, editMessageReplyMarkup :: Maybe SomeReplyMarkup
}
instance IsString EditMessage where
fromString = toEditMessage . fromString
data EditMessageId
= EditChatMessageId SomeChatId MessageId
| EditInlineMessageId MessageId
toEditMessage :: Text -> EditMessage
toEditMessage msg = EditMessage msg Nothing Nothing Nothing
editMessageToEditMessageTextRequest
:: EditMessageId -> EditMessage -> EditMessageTextRequest
editMessageToEditMessageTextRequest editMessageId EditMessage{..}
= EditMessageTextRequest
{ editMessageTextText = editMessageText
, editMessageTextParseMode = editMessageParseMode
, editMessageTextDisableWebPagePreview = editMessageDisableWebPagePreview
, editMessageTextReplyMarkup = editMessageReplyMarkup
, ..
}
where
( editMessageTextChatId,
editMessageTextMessageId,
editMessageTextInlineMessageId )
= case editMessageId of
EditChatMessageId chatId messageId
-> (Just chatId, Just messageId, Nothing)
EditInlineMessageId messageId
-> (Nothing, Nothing, Just messageId)
editMessageToReplyMessage :: EditMessage -> ReplyMessage
editMessageToReplyMessage EditMessage{..} = (toReplyMessage editMessageText)
{ replyMessageParseMode = editMessageParseMode
, replyMessageDisableWebPagePreview = editMessageDisableWebPagePreview
, replyMessageReplyMarkup = editMessageReplyMarkup
}
editMessage :: EditMessageId -> EditMessage -> BotM ()
editMessage editMessageId emsg = do
let msg = editMessageToEditMessageTextRequest editMessageId emsg
void $ liftClientM $ Telegram.editMessageText msg
editUpdateMessage :: EditMessage -> BotM ()
editUpdateMessage emsg = do
mEditMessageId <- getEditMessageId
case mEditMessageId of
Just editMessageId -> editMessage editMessageId emsg
Nothing -> liftIO $ putStrLn "Can't find message to edit!"
editUpdateMessageText :: Text -> BotM ()
editUpdateMessageText = editUpdateMessage . toEditMessage
replyOrEdit :: EditMessage -> BotM ()
replyOrEdit emsg = do
uid <- asks (fmap userId . (messageFrom =<<) . (extractUpdateMessage =<<) . botContextUpdate)
botUserId <- asks (userId . botContextUser)
if uid == Just botUserId
then editUpdateMessage emsg
else reply (editMessageToReplyMessage emsg)