Add support for message editing

src/Telegram/Bot/API.hs

@@ -7,8 +7,8 @@ module Telegram.Bot.API (
   module Telegram.Bot.API.Types,
   -- * Available methods
   module Telegram.Bot.API.Methods,
---   -- * Updating messages
---   module Telegram.Bot.API.UpdatingMessages,
+  -- * Updating messages
+  module Telegram.Bot.API.UpdatingMessages,
 --   -- * Stickers
 --   module Telegram.Bot.API.Stickers,
 --   -- * Inline mode
@@ -19,11 +19,11 @@ module Telegram.Bot.API (
 --   module Telegram.Bot.API.Games,
 ) where
 
-import Telegram.Bot.API.MakingRequests
-import Telegram.Bot.API.GettingUpdates
-import Telegram.Bot.API.Types
-import Telegram.Bot.API.Methods
--- import Telegram.Bot.API.UpdatingMessages
+import           Telegram.Bot.API.GettingUpdates
+import           Telegram.Bot.API.MakingRequests
+import           Telegram.Bot.API.Methods
+import           Telegram.Bot.API.Types
+import           Telegram.Bot.API.UpdatingMessages
 -- import Telegram.Bot.API.Stickers
 -- import Telegram.Bot.API.InlineMode
 -- import Telegram.Bot.API.Payments

src/Telegram/Bot/API/GettingUpdates.hs

@@ -1,23 +1,23 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE TypeOperators              #-}
 module Telegram.Bot.API.GettingUpdates where
 
-import Data.Foldable (asum)
-import Data.Aeson (ToJSON(..), FromJSON(..))
-import Data.Int (Int32)
-import Data.Proxy
-import GHC.Generics (Generic)
+import           Data.Aeson                      (FromJSON (..), ToJSON (..))
+import           Data.Foldable                   (asum)
+import           Data.Int                        (Int32)
+import           Data.Proxy
+import           GHC.Generics                    (Generic)
 
-import Servant.API
-import Servant.Client hiding (Response)
+import           Servant.API
+import           Servant.Client                  hiding (Response)
 
-import Telegram.Bot.API.Internal.Utils
-import Telegram.Bot.API.MakingRequests
-import Telegram.Bot.API.Types
+import           Telegram.Bot.API.Internal.Utils
+import           Telegram.Bot.API.MakingRequests
+import           Telegram.Bot.API.Types
 
 -- ** 'Update'
 
@@ -27,16 +27,16 @@ newtype UpdateId = UpdateId Int32
 -- | This object represents an incoming update.
 -- At most __one__ of the optional parameters can be present in any given update.
 data Update = Update
-  { updateUpdateId :: UpdateId -- ^ The update‘s unique identifier. Update identifiers start from a certain positive number and increase sequentially. This ID becomes especially handy if you’re using Webhooks, since it allows you to ignore repeated updates or to restore the correct update sequence, should they get out of order. If there are no new updates for at least a week, then identifier of the next update will be chosen randomly instead of sequentially.
-  , updateMessage :: Maybe Message -- ^ New incoming message of any kind — text, photo, sticker, etc.
-  , updateEditedMessage :: Maybe Message -- ^ New version of a message that is known to the bot and was edited
-  , updateChannelPost :: Maybe Message -- ^ New incoming channel post of any kind — text, photo, sticker, etc.
+  { updateUpdateId          :: UpdateId -- ^ The update‘s unique identifier. Update identifiers start from a certain positive number and increase sequentially. This ID becomes especially handy if you’re using Webhooks, since it allows you to ignore repeated updates or to restore the correct update sequence, should they get out of order. If there are no new updates for at least a week, then identifier of the next update will be chosen randomly instead of sequentially.
+  , updateMessage           :: Maybe Message -- ^ New incoming message of any kind — text, photo, sticker, etc.
+  , updateEditedMessage     :: Maybe Message -- ^ New version of a message that is known to the bot and was edited
+  , updateChannelPost       :: Maybe Message -- ^ New incoming channel post of any kind — text, photo, sticker, etc.
   , updateEditedChannelPost :: Maybe Message -- ^ New version of a channel post that is known to the bot and was edited
 
 --  , updateInlineQuery :: Maybe InlineQuery -- ^ New incoming inline query
 --   , updateChosenInlineResult :: Maybe ChosenInlineResult -- ^ The result of an inline query that was chosen by a user and sent to their chat partner. Please see our documentation on the feedback collecting for details on how to enable these updates for your bot.
 
-  , updateCallbackQuery :: Maybe CallbackQuery -- ^ New incoming callback query
+  , updateCallbackQuery     :: Maybe CallbackQuery -- ^ New incoming callback query
 
 --   , updateShippingQuery :: Maybe ShippingQuery -- ^ New incoming shipping query. Only for invoices with flexible price
 --   , updatePreCheckoutQuery :: Maybe PreCheckoutQuery -- ^ New incoming pre-checkout query. Contains full information about checkout
@@ -46,15 +46,16 @@ instance ToJSON   Update where toJSON = gtoJSON
 instance FromJSON Update where parseJSON = gparseJSON
 
 updateChatId :: Update -> Maybe ChatId
-updateChatId Update{..} = do
-  Message{..} <- asum
-    [ updateMessage
-    , updateEditedMessage
-    , updateChannelPost
-    , updateEditedChannelPost
-    , updateCallbackQuery >>= callbackQueryMessage
-    ]
-  return (chatId messageChat)
+updateChatId = fmap (chatId . messageChat) . extractUpdateMessage
+
+extractUpdateMessage :: Update -> Maybe Message
+extractUpdateMessage Update{..} = asum
+  [ updateMessage
+  , updateEditedMessage
+  , updateChannelPost
+  , updateEditedChannelPost
+  , updateCallbackQuery >>= callbackQueryMessage
+  ]
 
 -- ** 'getUpdates'
 
@@ -72,9 +73,9 @@ getUpdates = client (Proxy @GetUpdates)
 
 -- | Request parameters for 'getUpdates'.
 data GetUpdatesRequest = GetUpdatesRequest
-  { getUpdatesOffset :: Maybe UpdateId -- ^ Identifier of the first update to be returned. Must be greater by one than the highest among the identifiers of previously received updates. By default, updates starting with the earliest unconfirmed update are returned. An update is considered confirmed as soon as getUpdates is called with an offset higher than its update_id. The negative offset can be specified to retrieve updates starting from -offset update from the end of the updates queue. All previous updates will forgotten.
-  , getUpdatesLimit :: Maybe Int32 -- ^ Limits the number of updates to be retrieved. Values between 1—100 are accepted. Defaults to 100.
-  , getUpdatesTimeout :: Maybe Seconds -- ^ Timeout in seconds for long polling. Defaults to 0, i.e. usual short polling. Should be positive, short polling should be used for testing purposes only.
+  { getUpdatesOffset         :: Maybe UpdateId -- ^ Identifier of the first update to be returned. Must be greater by one than the highest among the identifiers of previously received updates. By default, updates starting with the earliest unconfirmed update are returned. An update is considered confirmed as soon as getUpdates is called with an offset higher than its update_id. The negative offset can be specified to retrieve updates starting from -offset update from the end of the updates queue. All previous updates will forgotten.
+  , getUpdatesLimit          :: Maybe Int32 -- ^ Limits the number of updates to be retrieved. Values between 1—100 are accepted. Defaults to 100.
+  , getUpdatesTimeout        :: Maybe Seconds -- ^ Timeout in seconds for long polling. Defaults to 0, i.e. usual short polling. Should be positive, short polling should be used for testing purposes only.
   , getUpdatesAllowedUpdates :: Maybe [UpdateType] -- ^ List the types of updates you want your bot to receive. For example, specify [“message”, “edited_channel_post”, “callback_query”] to only receive updates of these types. See GetUpdates for a complete list of available update types. Specify an empty list to receive all updates regardless of type (default). If not specified, the previous setting will be used. Please note that this parameter doesn't affect updates created before the call to the getUpdates, so unwanted updates may be received for a short period of time.
   } deriving (Generic)
 

src/Telegram/Bot/API/UpdatingMessages.hs

@@ -1 +1,43 @@
+{-# LANGUAGE DataKinds        #-}
+{-# LANGUAGE DeriveGeneric    #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators    #-}
 module Telegram.Bot.API.UpdatingMessages where
+
+import           Data.Aeson
+import           Data.Proxy
+import           Data.Text                       (Text)
+import           GHC.Generics                    (Generic)
+import           Servant.API
+import           Servant.Client                  (ClientM, client)
+
+import           Telegram.Bot.API.Internal.Utils (gparseJSON, gtoJSON)
+import           Telegram.Bot.API.MakingRequests
+import           Telegram.Bot.API.Methods
+import           Telegram.Bot.API.Types
+
+-- ** 'editMessageText'
+
+type EditMessageText
+  = "editMessageText"
+  :> ReqBody '[JSON] EditMessageTextRequest
+  :> Post '[JSON] (Response Message)
+
+-- | Use this method to send text messages.
+-- On success, the sent 'Message' is returned.
+editMessageText :: EditMessageTextRequest -> ClientM (Response Message)
+editMessageText = client (Proxy @EditMessageText)
+
+-- | Request parameters for 'sendMessage'.
+data EditMessageTextRequest = EditMessageTextRequest
+  { editMessageTextChatId                :: Maybe SomeChatId -- ^ Required if 'editMessageTextInlineMessageId' is not specified. Unique identifier for the target chat or username of the target channel (in the format @\@channelusername@).
+  , editMessageTextMessageId             :: Maybe MessageId -- ^ Required if 'editMessageTextInlineMessageId' is not specified. Identifier of the sent message.
+  , editMessageTextInlineMessageId       :: Maybe MessageId -- ^ Required if 'editMessageTextChatId' and 'editMessageTextMessageId' are not specified. Identifier of the sent message.
+  , editMessageTextText                  :: Text -- ^ Text of the message to be sent.
+  , editMessageTextParseMode             :: Maybe ParseMode -- ^ Send 'Markdown' or 'HTML', if you want Telegram apps to show bold, italic, fixed-width text or inline URLs in your bot's message.
+  , editMessageTextDisableWebPagePreview :: Maybe Bool -- ^ Disables link previews for links in this message.
+  , editMessageTextReplyMarkup           :: 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 (Generic)
+
+instance ToJSON   EditMessageTextRequest where toJSON = gtoJSON
+instance FromJSON EditMessageTextRequest where parseJSON = gparseJSON

src/Telegram/Bot/Simple/Reply.hs

@@ -2,12 +2,13 @@
 {-# 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
+import           Telegram.Bot.API        as Telegram
 import           Telegram.Bot.Simple.Eff
 
 -- | Get current 'ChatId' if possible.
@@ -16,6 +17,21 @@ currentChatId = do
   mupdate <- ask
   pure $ updateChatId =<< mupdate
 
+getEditMessageId :: BotM (Maybe EditMessageId)
+getEditMessageId = do
+  mupdate <- ask
+  pure $ updateEditMessageId =<< mupdate
+
+updateEditMessageId :: Update -> Maybe EditMessageId
+updateEditMessageId update
+    = EditInlineMessageId
+      <$> (callbackQueryInlineMessageId =<< updateCallbackQuery update)
+  <|> EditChatMessageId
+      <$> (SomeChatId . chatId . messageChat <$> message)
+      <*> (messageMessageId <$> message)
+  where
+    message = extractUpdateMessage update
+
 -- | Reply message parameters.
 -- This is just like 'SendMessageRequest' but without 'SomeChatId' specified.
 data ReplyMessage = ReplyMessage
@@ -63,3 +79,61 @@ reply rmsg = do
 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 "No chat to reply to"
+
+editUpdateMessageText :: Text -> BotM ()
+editUpdateMessageText = editUpdateMessage . toEditMessage