{-# 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

-- | Get current 'ChatId' if possible.
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 (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 (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 (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 (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

-- | Reply message parameters.
-- This is just like 'SendMessageRequest' but without 'SomeChatId' specified.
data ReplyMessage = ReplyMessage
  { ReplyMessage -> Text
replyMessageText                  :: Text -- ^ Text of the message to be sent.
  , ReplyMessage -> Maybe ParseMode
replyMessageParseMode             :: Maybe ParseMode -- ^ Send 'MarkdownV2', 'HTML' or 'Markdown' (legacy), if you want Telegram apps to show bold, italic, fixed-width text or inline URLs in your bot's message.
  , ReplyMessage -> Maybe [MessageEntity]
replyMessageEntities              :: Maybe [MessageEntity] -- ^ A JSON-serialized list of special entities that appear in message text, which can be specified instead of /parse_mode/.
  , ReplyMessage -> Maybe Bool
replyMessageDisableWebPagePreview :: Maybe Bool -- ^ Disables link previews for links in this message.
  , ReplyMessage -> Maybe Bool
replyMessageDisableNotification   :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound.
  , ReplyMessage -> Maybe Bool
replyMessageProtectContent        :: Maybe Bool -- ^ Protects the contents of the sent message from forwarding and saving.
  , ReplyMessage -> Maybe MessageId
replyMessageReplyToMessageId      :: Maybe MessageId -- ^ If the message is a reply, ID of the original message.
 , ReplyMessage -> Maybe Bool
replyMessageAllowSendingWithoutReply :: Maybe Bool -- ^ Pass 'True', if the message should be sent even if the specified replied-to message is not found.
  , ReplyMessage -> Maybe SomeReplyMarkup
replyMessageReplyMarkup           :: Maybe SomeReplyMarkup -- ^ Additional interface options. A JSON-serialized object for an inline keyboard, custom reply keyboard, instructions to remove reply keyboard or to force a reply from the user.
  } 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
$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 (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

-- | Create a 'ReplyMessage' with just some 'Text' message.
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 Maybe ParseMode
forall a. Maybe a
Nothing Maybe [MessageEntity]
forall a. Maybe a
Nothing Maybe Bool
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 Bool
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 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 :: SomeChatId
-> Text
-> Maybe ParseMode
-> Maybe [MessageEntity]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe MessageId
-> Maybe Bool
-> Maybe SomeReplyMarkup
-> SendMessageRequest
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
  }

-- | Reply in a chat with a given 'SomeChatId'.
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
$ ClientM (Response Message) -> BotM (Response Message)
forall a. ClientM a -> BotM a
liftClientM (ClientM (Response Message) -> BotM (Response Message))
-> ClientM (Response Message) -> BotM (Response Message)
forall a b. (a -> b) -> a -> b
$ SendMessageRequest -> ClientM (Response Message)
sendMessage SendMessageRequest
msg

-- | Reply in the current chat (if possible).
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 (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"

-- | Reply with a text.
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 Bool
editMessageDisableWebPagePreview :: Maybe Bool
  , 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 Bool
-> Maybe SomeReplyMarkup
-> EditMessage
EditMessage Text
msg Maybe ParseMode
forall a. Maybe a
Nothing Maybe Bool
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 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 :: Maybe SomeChatId
-> Maybe MessageId
-> Maybe MessageId
-> Text
-> Maybe ParseMode
-> Maybe [MessageEntity]
-> Maybe Bool
-> Maybe SomeReplyMarkup
-> EditMessageTextRequest
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 = Maybe [MessageEntity]
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
            -> (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 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
  BotM (Response (Either Bool Message)) -> BotM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BotM (Response (Either Bool Message)) -> BotM ())
-> BotM (Response (Either Bool Message)) -> BotM ()
forall a b. (a -> b) -> a -> b
$ ClientM (Response (Either Bool Message))
-> BotM (Response (Either Bool Message))
forall a. ClientM a -> BotM a
liftClientM (ClientM (Response (Either Bool Message))
 -> BotM (Response (Either Bool Message)))
-> ClientM (Response (Either Bool Message))
-> BotM (Response (Either Bool Message))
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            -> IO () -> BotM ()
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 (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)