{-# 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 hiding (editMessageText, editMessageReplyMarkup)
import qualified Telegram.Bot.API.UpdatingMessages as Update
import Telegram.Bot.Simple.Eff
currentChatId :: BotM (Maybe ChatId)
currentChatId :: BotM (Maybe ChatId)
currentChatId = do
Maybe Update
mupdate <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BotContext -> Maybe Update
botContextUpdate
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Update -> Maybe ChatId
updateChatId 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BotContext -> Maybe Update
botContextUpdate
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Update -> Maybe EditMessageId
updateEditMessageId 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
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CallbackQuery -> Maybe MessageId
callbackQueryInlineMessageId forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Update -> Maybe CallbackQuery
updateCallbackQuery Update
update)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeChatId -> MessageId -> EditMessageId
EditChatMessageId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ChatId -> SomeChatId
SomeChatId forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chat -> ChatId
chatId forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Chat
messageChat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Message
message)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Message -> MessageId
messageMessageId 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 ParseMode
replyMessageParseMode :: Maybe ParseMode
, ReplyMessage -> Maybe [MessageEntity]
replyMessageEntities :: Maybe [MessageEntity]
, ReplyMessage -> Maybe Bool
replyMessageDisableWebPagePreview :: Maybe Bool
, ReplyMessage -> Maybe Bool
replyMessageDisableNotification :: Maybe Bool
, ReplyMessage -> Maybe Bool
replyMessageProtectContent :: Maybe Bool
, ReplyMessage -> Maybe MessageId
replyMessageReplyToMessageId :: Maybe MessageId
, ReplyMessage -> Maybe Bool
replyMessageAllowSendingWithoutReply :: Maybe Bool
, ReplyMessage -> Maybe SomeReplyMarkup
replyMessageReplyMarkup :: Maybe SomeReplyMarkup
} deriving (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
$cto :: forall x. Rep ReplyMessage x -> ReplyMessage
$cfrom :: forall x. ReplyMessage -> Rep ReplyMessage x
Generic)
instance IsString ReplyMessage where
fromString :: String -> ReplyMessage
fromString = Text -> ReplyMessage
toReplyMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
toReplyMessage :: Text -> ReplyMessage
toReplyMessage :: Text -> ReplyMessage
toReplyMessage Text
text
= Text
-> Maybe ParseMode
-> Maybe [MessageEntity]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe MessageId
-> Maybe Bool
-> Maybe SomeReplyMarkup
-> ReplyMessage
ReplyMessage Text
text forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
replyMessageToSendMessageRequest :: SomeChatId -> ReplyMessage -> SendMessageRequest
replyMessageToSendMessageRequest :: SomeChatId -> ReplyMessage -> SendMessageRequest
replyMessageToSendMessageRequest SomeChatId
someChatId ReplyMessage{Maybe Bool
Maybe [MessageEntity]
Maybe MessageId
Maybe ParseMode
Maybe SomeReplyMarkup
Text
replyMessageReplyMarkup :: Maybe SomeReplyMarkup
replyMessageAllowSendingWithoutReply :: Maybe Bool
replyMessageReplyToMessageId :: Maybe MessageId
replyMessageProtectContent :: Maybe Bool
replyMessageDisableNotification :: Maybe Bool
replyMessageDisableWebPagePreview :: Maybe Bool
replyMessageEntities :: Maybe [MessageEntity]
replyMessageParseMode :: Maybe ParseMode
replyMessageText :: Text
replyMessageReplyMarkup :: ReplyMessage -> Maybe SomeReplyMarkup
replyMessageAllowSendingWithoutReply :: ReplyMessage -> Maybe Bool
replyMessageReplyToMessageId :: ReplyMessage -> Maybe MessageId
replyMessageProtectContent :: ReplyMessage -> Maybe Bool
replyMessageDisableNotification :: ReplyMessage -> Maybe Bool
replyMessageDisableWebPagePreview :: ReplyMessage -> Maybe Bool
replyMessageEntities :: ReplyMessage -> Maybe [MessageEntity]
replyMessageParseMode :: ReplyMessage -> Maybe ParseMode
replyMessageText :: ReplyMessage -> Text
..} = SendMessageRequest
{ sendMessageChatId :: SomeChatId
sendMessageChatId = SomeChatId
someChatId
, sendMessageText :: Text
sendMessageText = Text
replyMessageText
, sendMessageParseMode :: Maybe ParseMode
sendMessageParseMode = Maybe ParseMode
replyMessageParseMode
, sendMessageEntities :: Maybe [MessageEntity]
sendMessageEntities = Maybe [MessageEntity]
replyMessageEntities
, sendMessageDisableWebPagePreview :: Maybe Bool
sendMessageDisableWebPagePreview = Maybe Bool
replyMessageDisableWebPagePreview
, 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
, sendMessageAllowSendingWithoutReply :: Maybe Bool
sendMessageAllowSendingWithoutReply = Maybe Bool
replyMessageAllowSendingWithoutReply
}
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
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. ClientM a -> BotM a
liftClientM forall a b. (a -> b) -> a -> b
$ SendMessageRequest -> ClientM (Response Message)
sendMessage 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 -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 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 Bool
editMessageDisableWebPagePreview :: Maybe Bool
, EditMessage -> Maybe SomeReplyMarkup
editMessageReplyMarkup :: Maybe SomeReplyMarkup
}
instance IsString EditMessage where
fromString :: String -> EditMessage
fromString = Text -> EditMessage
toEditMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 Bool
-> Maybe SomeReplyMarkup
-> EditMessage
EditMessage Text
msg forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
editMessageToEditMessageTextRequest
:: EditMessageId -> EditMessage -> EditMessageTextRequest
editMessageToEditMessageTextRequest :: EditMessageId -> EditMessage -> EditMessageTextRequest
editMessageToEditMessageTextRequest EditMessageId
editMessageId EditMessage{Maybe Bool
Maybe ParseMode
Maybe SomeReplyMarkup
Text
editMessageReplyMarkup :: Maybe SomeReplyMarkup
editMessageDisableWebPagePreview :: Maybe Bool
editMessageParseMode :: Maybe ParseMode
editMessageText :: Text
editMessageReplyMarkup :: EditMessage -> Maybe SomeReplyMarkup
editMessageDisableWebPagePreview :: EditMessage -> Maybe Bool
editMessageParseMode :: EditMessage -> Maybe ParseMode
editMessageText :: EditMessage -> Text
..}
= EditMessageTextRequest
{ editMessageTextText :: Text
editMessageTextText = Text
editMessageText
, editMessageTextParseMode :: Maybe ParseMode
editMessageTextParseMode = Maybe ParseMode
editMessageParseMode
, editMessageTextDisableWebPagePreview :: Maybe Bool
editMessageTextDisableWebPagePreview = Maybe Bool
editMessageDisableWebPagePreview
, editMessageTextReplyMarkup :: Maybe SomeReplyMarkup
editMessageTextReplyMarkup = Maybe SomeReplyMarkup
editMessageReplyMarkup
, editMessageEntities :: Maybe [MessageEntity]
editMessageEntities = forall a. Maybe a
Nothing
, Maybe SomeChatId
Maybe MessageId
editMessageTextInlineMessageId :: Maybe MessageId
editMessageTextMessageId :: Maybe MessageId
editMessageTextChatId :: Maybe SomeChatId
editMessageTextInlineMessageId :: Maybe MessageId
editMessageTextMessageId :: Maybe MessageId
editMessageTextChatId :: Maybe SomeChatId
..
}
where
( Maybe SomeChatId
editMessageTextChatId,
Maybe MessageId
editMessageTextMessageId,
Maybe MessageId
editMessageTextInlineMessageId )
= case EditMessageId
editMessageId of
EditChatMessageId SomeChatId
chatId MessageId
messageId
-> (forall a. a -> Maybe a
Just SomeChatId
chatId, forall a. a -> Maybe a
Just MessageId
messageId, forall a. Maybe a
Nothing)
EditInlineMessageId MessageId
messageId
-> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just MessageId
messageId)
editMessageToReplyMessage :: EditMessage -> ReplyMessage
editMessageToReplyMessage :: EditMessage -> ReplyMessage
editMessageToReplyMessage EditMessage{Maybe Bool
Maybe ParseMode
Maybe SomeReplyMarkup
Text
editMessageReplyMarkup :: Maybe SomeReplyMarkup
editMessageDisableWebPagePreview :: Maybe Bool
editMessageParseMode :: Maybe ParseMode
editMessageText :: Text
editMessageReplyMarkup :: EditMessage -> Maybe SomeReplyMarkup
editMessageDisableWebPagePreview :: EditMessage -> Maybe Bool
editMessageParseMode :: EditMessage -> Maybe ParseMode
editMessageText :: EditMessage -> Text
..} = (Text -> ReplyMessage
toReplyMessage Text
editMessageText)
{ replyMessageParseMode :: Maybe ParseMode
replyMessageParseMode = Maybe ParseMode
editMessageParseMode
, replyMessageDisableWebPagePreview :: Maybe Bool
replyMessageDisableWebPagePreview = Maybe Bool
editMessageDisableWebPagePreview
, replyMessageReplyMarkup :: Maybe SomeReplyMarkup
replyMessageReplyMarkup = Maybe SomeReplyMarkup
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
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. ClientM a -> BotM a
liftClientM forall a b. (a -> b) -> a -> b
$ EditMessageTextRequest -> ClientM (Response (Either Bool Message))
Update.editMessageText 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 -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap User -> UserId
userId forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message -> Maybe User
messageFrom forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Update -> Maybe Message
extractUpdateMessage forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotContext -> Maybe Update
botContextUpdate)
UserId
botUserId <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (User -> UserId
userId forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotContext -> User
botContextUser)
if Maybe UserId
uid forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just UserId
botUserId
then EditMessage -> BotM ()
editUpdateMessage EditMessage
emsg
else ReplyMessage -> BotM ()
reply (EditMessage -> ReplyMessage
editMessageToReplyMessage EditMessage
emsg)