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

-- | 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. 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

-- | 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 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
  }

-- | 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
  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 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     -> 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"

-- | Reply with a text.
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)