{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
module Telegram.Bot.Simple.Reply where
import Control.Applicative ((<|>))
import Control.Monad
import Control.Monad.Reader
import Data.String
import Data.Text (Text)
import GHC.Generics (Generic)
import Telegram.Bot.API as Telegram hiding (editMessageText, editMessageReplyMarkup)
import Telegram.Bot.Simple.Eff
import Telegram.Bot.Simple.RunTG (RunTG(..))
currentChatId :: BotM (Maybe ChatId)
currentChatId :: BotM (Maybe ChatId)
currentChatId = do
Maybe Update
mupdate <- (BotContext -> Maybe Update) -> BotM (Maybe Update)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BotContext -> Maybe Update
botContextUpdate
Maybe ChatId -> BotM (Maybe ChatId)
forall a. a -> BotM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ChatId -> BotM (Maybe ChatId))
-> Maybe ChatId -> BotM (Maybe ChatId)
forall a b. (a -> b) -> a -> b
$ Update -> Maybe ChatId
updateChatId (Update -> Maybe ChatId) -> Maybe Update -> Maybe ChatId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Update
mupdate
getEditMessageId :: BotM (Maybe EditMessageId)
getEditMessageId :: BotM (Maybe EditMessageId)
getEditMessageId = do
Maybe Update
mupdate <- (BotContext -> Maybe Update) -> BotM (Maybe Update)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BotContext -> Maybe Update
botContextUpdate
Maybe EditMessageId -> BotM (Maybe EditMessageId)
forall a. a -> BotM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe EditMessageId -> BotM (Maybe EditMessageId))
-> Maybe EditMessageId -> BotM (Maybe EditMessageId)
forall a b. (a -> b) -> a -> b
$ Update -> Maybe EditMessageId
updateEditMessageId (Update -> Maybe EditMessageId)
-> Maybe Update -> Maybe EditMessageId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Update
mupdate
updateEditMessageId :: Update -> Maybe EditMessageId
updateEditMessageId :: Update -> Maybe EditMessageId
updateEditMessageId Update
update
= MessageId -> EditMessageId
EditInlineMessageId
(MessageId -> EditMessageId)
-> Maybe MessageId -> Maybe EditMessageId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CallbackQuery -> Maybe MessageId
callbackQueryInlineMessageId (CallbackQuery -> Maybe MessageId)
-> Maybe CallbackQuery -> Maybe MessageId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Update -> Maybe CallbackQuery
updateCallbackQuery Update
update)
Maybe EditMessageId -> Maybe EditMessageId -> Maybe EditMessageId
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeChatId -> MessageId -> EditMessageId
EditChatMessageId
(SomeChatId -> MessageId -> EditMessageId)
-> Maybe SomeChatId -> Maybe (MessageId -> EditMessageId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ChatId -> SomeChatId
SomeChatId (ChatId -> SomeChatId)
-> (Message -> ChatId) -> Message -> SomeChatId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chat -> ChatId
chatId (Chat -> ChatId) -> (Message -> Chat) -> Message -> ChatId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Chat
messageChat (Message -> SomeChatId) -> Maybe Message -> Maybe SomeChatId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Message
message)
Maybe (MessageId -> EditMessageId)
-> Maybe MessageId -> Maybe EditMessageId
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Message -> MessageId
messageMessageId (Message -> MessageId) -> Maybe Message -> Maybe MessageId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Message
message)
where
message :: Maybe Message
message = Update -> Maybe Message
extractUpdateMessage Update
update
data ReplyMessage = ReplyMessage
{ ReplyMessage -> Text
replyMessageText :: Text
, ReplyMessage -> Maybe MessageThreadId
replyMessageMessageThreadId :: Maybe MessageThreadId
, ReplyMessage -> Maybe ParseMode
replyMessageParseMode :: Maybe ParseMode
, ReplyMessage -> Maybe [MessageEntity]
replyMessageEntities :: Maybe [MessageEntity]
, ReplyMessage -> Maybe LinkPreviewOptions
replyMessageLinkPreviewOptions :: Maybe LinkPreviewOptions
, ReplyMessage -> Maybe Bool
replyMessageDisableNotification :: Maybe Bool
, ReplyMessage -> Maybe Bool
replyMessageProtectContent :: Maybe Bool
, ReplyMessage -> Maybe MessageId
replyMessageReplyToMessageId :: Maybe MessageId
, ReplyMessage -> Maybe ReplyParameters
replyMessageReplyParameters :: Maybe ReplyParameters
, ReplyMessage -> Maybe SomeReplyMarkup
replyMessageReplyMarkup :: Maybe SomeReplyMarkup
} deriving ((forall x. ReplyMessage -> Rep ReplyMessage x)
-> (forall x. Rep ReplyMessage x -> ReplyMessage)
-> Generic ReplyMessage
forall x. Rep ReplyMessage x -> ReplyMessage
forall x. ReplyMessage -> Rep ReplyMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReplyMessage -> Rep ReplyMessage x
from :: forall x. ReplyMessage -> Rep ReplyMessage x
$cto :: forall x. Rep ReplyMessage x -> ReplyMessage
to :: forall x. Rep ReplyMessage x -> ReplyMessage
Generic)
instance IsString ReplyMessage where
fromString :: String -> ReplyMessage
fromString = Text -> ReplyMessage
toReplyMessage (Text -> ReplyMessage)
-> (String -> Text) -> String -> ReplyMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString
toReplyMessage :: Text -> ReplyMessage
toReplyMessage :: Text -> ReplyMessage
toReplyMessage Text
text
= Text
-> Maybe MessageThreadId
-> Maybe ParseMode
-> Maybe [MessageEntity]
-> Maybe LinkPreviewOptions
-> Maybe Bool
-> Maybe Bool
-> Maybe MessageId
-> Maybe ReplyParameters
-> Maybe SomeReplyMarkup
-> ReplyMessage
ReplyMessage Text
text Maybe MessageThreadId
forall a. Maybe a
Nothing Maybe ParseMode
forall a. Maybe a
Nothing Maybe [MessageEntity]
forall a. Maybe a
Nothing Maybe LinkPreviewOptions
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe MessageId
forall a. Maybe a
Nothing Maybe ReplyParameters
forall a. Maybe a
Nothing Maybe SomeReplyMarkup
forall a. Maybe a
Nothing
replyMessageToSendMessageRequest :: SomeChatId -> ReplyMessage -> SendMessageRequest
replyMessageToSendMessageRequest :: SomeChatId -> ReplyMessage -> SendMessageRequest
replyMessageToSendMessageRequest SomeChatId
someChatId ReplyMessage{Maybe Bool
Maybe [MessageEntity]
Maybe MessageThreadId
Maybe MessageId
Maybe LinkPreviewOptions
Maybe ParseMode
Maybe SomeReplyMarkup
Maybe ReplyParameters
Text
replyMessageText :: ReplyMessage -> Text
replyMessageMessageThreadId :: ReplyMessage -> Maybe MessageThreadId
replyMessageParseMode :: ReplyMessage -> Maybe ParseMode
replyMessageEntities :: ReplyMessage -> Maybe [MessageEntity]
replyMessageLinkPreviewOptions :: ReplyMessage -> Maybe LinkPreviewOptions
replyMessageDisableNotification :: ReplyMessage -> Maybe Bool
replyMessageProtectContent :: ReplyMessage -> Maybe Bool
replyMessageReplyToMessageId :: ReplyMessage -> Maybe MessageId
replyMessageReplyParameters :: ReplyMessage -> Maybe ReplyParameters
replyMessageReplyMarkup :: ReplyMessage -> Maybe SomeReplyMarkup
replyMessageText :: Text
replyMessageMessageThreadId :: Maybe MessageThreadId
replyMessageParseMode :: Maybe ParseMode
replyMessageEntities :: Maybe [MessageEntity]
replyMessageLinkPreviewOptions :: Maybe LinkPreviewOptions
replyMessageDisableNotification :: Maybe Bool
replyMessageProtectContent :: Maybe Bool
replyMessageReplyToMessageId :: Maybe MessageId
replyMessageReplyParameters :: Maybe ReplyParameters
replyMessageReplyMarkup :: Maybe SomeReplyMarkup
..} = SendMessageRequest
{ sendMessageChatId :: SomeChatId
sendMessageChatId = SomeChatId
someChatId
, sendMessageMessageThreadId :: Maybe MessageThreadId
sendMessageMessageThreadId = Maybe MessageThreadId
replyMessageMessageThreadId
, sendMessageText :: Text
sendMessageText = Text
replyMessageText
, sendMessageParseMode :: Maybe ParseMode
sendMessageParseMode = Maybe ParseMode
replyMessageParseMode
, sendMessageEntities :: Maybe [MessageEntity]
sendMessageEntities = Maybe [MessageEntity]
replyMessageEntities
, sendMessageLinkPreviewOptions :: Maybe LinkPreviewOptions
sendMessageLinkPreviewOptions = Maybe LinkPreviewOptions
replyMessageLinkPreviewOptions
, sendMessageDisableNotification :: Maybe Bool
sendMessageDisableNotification = Maybe Bool
replyMessageDisableNotification
, sendMessageProtectContent :: Maybe Bool
sendMessageProtectContent = Maybe Bool
replyMessageProtectContent
, sendMessageReplyToMessageId :: Maybe MessageId
sendMessageReplyToMessageId = Maybe MessageId
replyMessageReplyToMessageId
, sendMessageReplyMarkup :: Maybe SomeReplyMarkup
sendMessageReplyMarkup = Maybe SomeReplyMarkup
replyMessageReplyMarkup
, sendMessageReplyParameters :: Maybe ReplyParameters
sendMessageReplyParameters = Maybe ReplyParameters
replyMessageReplyParameters
}
replyTo :: SomeChatId -> ReplyMessage -> BotM ()
replyTo :: SomeChatId -> ReplyMessage -> BotM ()
replyTo SomeChatId
someChatId ReplyMessage
rmsg = do
let msg :: SendMessageRequest
msg = SomeChatId -> ReplyMessage -> SendMessageRequest
replyMessageToSendMessageRequest SomeChatId
someChatId ReplyMessage
rmsg
BotM (Response Message) -> BotM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BotM (Response Message) -> BotM ())
-> BotM (Response Message) -> BotM ()
forall a b. (a -> b) -> a -> b
$ SendMessageRequest -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG SendMessageRequest
msg
reply :: ReplyMessage -> BotM ()
reply :: ReplyMessage -> BotM ()
reply ReplyMessage
rmsg = do
Maybe ChatId
mchatId <- BotM (Maybe ChatId)
currentChatId
case Maybe ChatId
mchatId of
Just ChatId
chatId -> SomeChatId -> ReplyMessage -> BotM ()
replyTo (ChatId -> SomeChatId
SomeChatId ChatId
chatId) ReplyMessage
rmsg
Maybe ChatId
Nothing -> IO () -> BotM ()
forall a. IO a -> BotM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BotM ()) -> IO () -> BotM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"No chat to reply to"
replyText :: Text -> BotM ()
replyText :: Text -> BotM ()
replyText = ReplyMessage -> BotM ()
reply (ReplyMessage -> BotM ())
-> (Text -> ReplyMessage) -> Text -> BotM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ReplyMessage
toReplyMessage
data EditMessage = EditMessage
{ EditMessage -> Text
editMessageText :: Text
, EditMessage -> Maybe ParseMode
editMessageParseMode :: Maybe ParseMode
, EditMessage -> Maybe LinkPreviewOptions
editMessageLinkPreviewOptions :: Maybe LinkPreviewOptions
, EditMessage -> Maybe SomeReplyMarkup
editMessageReplyMarkup :: Maybe SomeReplyMarkup
}
instance IsString EditMessage where
fromString :: String -> EditMessage
fromString = Text -> EditMessage
toEditMessage (Text -> EditMessage) -> (String -> Text) -> String -> EditMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString
data EditMessageId
= EditChatMessageId SomeChatId MessageId
| EditInlineMessageId MessageId
toEditMessage :: Text -> EditMessage
toEditMessage :: Text -> EditMessage
toEditMessage Text
msg = Text
-> Maybe ParseMode
-> Maybe LinkPreviewOptions
-> Maybe SomeReplyMarkup
-> EditMessage
EditMessage Text
msg Maybe ParseMode
forall a. Maybe a
Nothing Maybe LinkPreviewOptions
forall a. Maybe a
Nothing Maybe SomeReplyMarkup
forall a. Maybe a
Nothing
editMessageToEditMessageTextRequest
:: EditMessageId -> EditMessage -> EditMessageTextRequest
editMessageToEditMessageTextRequest :: EditMessageId -> EditMessage -> EditMessageTextRequest
editMessageToEditMessageTextRequest EditMessageId
editMessageId EditMessage{Maybe LinkPreviewOptions
Maybe ParseMode
Maybe SomeReplyMarkup
Text
editMessageText :: EditMessage -> Text
editMessageParseMode :: EditMessage -> Maybe ParseMode
editMessageLinkPreviewOptions :: EditMessage -> Maybe LinkPreviewOptions
editMessageReplyMarkup :: EditMessage -> Maybe SomeReplyMarkup
editMessageText :: Text
editMessageParseMode :: Maybe ParseMode
editMessageLinkPreviewOptions :: Maybe LinkPreviewOptions
editMessageReplyMarkup :: Maybe SomeReplyMarkup
..}
= EditMessageTextRequest
{ editMessageTextText :: Text
editMessageTextText = Text
editMessageText
, editMessageTextParseMode :: Maybe ParseMode
editMessageTextParseMode = Maybe ParseMode
editMessageParseMode
, editMessageTextLinkPreviewOptions :: Maybe LinkPreviewOptions
editMessageTextLinkPreviewOptions = Maybe LinkPreviewOptions
editMessageLinkPreviewOptions
, editMessageTextReplyMarkup :: Maybe SomeReplyMarkup
editMessageTextReplyMarkup = Maybe SomeReplyMarkup
editMessageReplyMarkup
, editMessageEntities :: Maybe [MessageEntity]
editMessageEntities = Maybe [MessageEntity]
forall a. Maybe a
Nothing
, Maybe SomeChatId
Maybe MessageId
editMessageTextChatId :: Maybe SomeChatId
editMessageTextMessageId :: Maybe MessageId
editMessageTextInlineMessageId :: Maybe MessageId
editMessageTextChatId :: Maybe SomeChatId
editMessageTextMessageId :: Maybe MessageId
editMessageTextInlineMessageId :: Maybe MessageId
..
}
where
( Maybe SomeChatId
editMessageTextChatId,
Maybe MessageId
editMessageTextMessageId,
Maybe MessageId
editMessageTextInlineMessageId )
= case EditMessageId
editMessageId of
EditChatMessageId SomeChatId
chatId MessageId
messageId
-> (SomeChatId -> Maybe SomeChatId
forall a. a -> Maybe a
Just SomeChatId
chatId, MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just MessageId
messageId, Maybe MessageId
forall a. Maybe a
Nothing)
EditInlineMessageId MessageId
messageId
-> (Maybe SomeChatId
forall a. Maybe a
Nothing, Maybe MessageId
forall a. Maybe a
Nothing, MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just MessageId
messageId)
editMessageToReplyMessage :: EditMessage -> ReplyMessage
editMessageToReplyMessage :: EditMessage -> ReplyMessage
editMessageToReplyMessage EditMessage{Maybe LinkPreviewOptions
Maybe ParseMode
Maybe SomeReplyMarkup
Text
editMessageText :: EditMessage -> Text
editMessageParseMode :: EditMessage -> Maybe ParseMode
editMessageLinkPreviewOptions :: EditMessage -> Maybe LinkPreviewOptions
editMessageReplyMarkup :: EditMessage -> Maybe SomeReplyMarkup
editMessageText :: Text
editMessageParseMode :: Maybe ParseMode
editMessageLinkPreviewOptions :: Maybe LinkPreviewOptions
editMessageReplyMarkup :: Maybe SomeReplyMarkup
..} = (Text -> ReplyMessage
toReplyMessage Text
editMessageText)
{ replyMessageParseMode = editMessageParseMode
, replyMessageLinkPreviewOptions = editMessageLinkPreviewOptions
, replyMessageReplyMarkup = editMessageReplyMarkup
}
editMessage :: EditMessageId -> EditMessage -> BotM ()
editMessage :: EditMessageId -> EditMessage -> BotM ()
editMessage EditMessageId
editMessageId EditMessage
emsg = do
let msg :: EditMessageTextRequest
msg = EditMessageId -> EditMessage -> EditMessageTextRequest
editMessageToEditMessageTextRequest EditMessageId
editMessageId EditMessage
emsg
BotM (Response EditMessageResponse) -> BotM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BotM (Response EditMessageResponse) -> BotM ())
-> BotM (Response EditMessageResponse) -> BotM ()
forall a b. (a -> b) -> a -> b
$ EditMessageTextRequest -> BotM (Response EditMessageResponse)
forall a b. RunTG a b => a -> BotM b
runTG EditMessageTextRequest
msg
editUpdateMessage :: EditMessage -> BotM ()
editUpdateMessage :: EditMessage -> BotM ()
editUpdateMessage EditMessage
emsg = do
Maybe EditMessageId
mEditMessageId <- BotM (Maybe EditMessageId)
getEditMessageId
case Maybe EditMessageId
mEditMessageId of
Just EditMessageId
editMessageId -> EditMessageId -> EditMessage -> BotM ()
editMessage EditMessageId
editMessageId EditMessage
emsg
Maybe EditMessageId
Nothing -> IO () -> BotM ()
forall a. IO a -> BotM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BotM ()) -> IO () -> BotM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Can't find message to edit!"
editUpdateMessageText :: Text -> BotM ()
editUpdateMessageText :: Text -> BotM ()
editUpdateMessageText = EditMessage -> BotM ()
editUpdateMessage (EditMessage -> BotM ())
-> (Text -> EditMessage) -> Text -> BotM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> EditMessage
toEditMessage
replyOrEdit :: EditMessage -> BotM ()
replyOrEdit :: EditMessage -> BotM ()
replyOrEdit EditMessage
emsg = do
Maybe UserId
uid <- (BotContext -> Maybe UserId) -> BotM (Maybe UserId)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((User -> UserId) -> Maybe User -> Maybe UserId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap User -> UserId
userId (Maybe User -> Maybe UserId)
-> (BotContext -> Maybe User) -> BotContext -> Maybe UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message -> Maybe User
messageFrom (Message -> Maybe User) -> Maybe Message -> Maybe User
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe Message -> Maybe User)
-> (BotContext -> Maybe Message) -> BotContext -> Maybe User
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Update -> Maybe Message
extractUpdateMessage (Update -> Maybe Message) -> Maybe Update -> Maybe Message
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe Update -> Maybe Message)
-> (BotContext -> Maybe Update) -> BotContext -> Maybe Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotContext -> Maybe Update
botContextUpdate)
UserId
botUserId <- (BotContext -> UserId) -> BotM UserId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (User -> UserId
userId (User -> UserId) -> (BotContext -> User) -> BotContext -> UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotContext -> User
botContextUser)
if Maybe UserId
uid Maybe UserId -> Maybe UserId -> Bool
forall a. Eq a => a -> a -> Bool
== UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
botUserId
then EditMessage -> BotM ()
editUpdateMessage EditMessage
emsg
else ReplyMessage -> BotM ()
reply (EditMessage -> ReplyMessage
editMessageToReplyMessage EditMessage
emsg)