diff --git a/telegram-bot-simple/src/Telegram/Bot/Simple/UpdateParser.hs b/telegram-bot-simple/src/Telegram/Bot/Simple/UpdateParser.hs index f155eaf..c6f2390 100644 --- a/telegram-bot-simple/src/Telegram/Bot/Simple/UpdateParser.hs +++ b/telegram-bot-simple/src/Telegram/Bot/Simple/UpdateParser.hs @@ -3,7 +3,6 @@ {-# LANGUAGE CPP #-} module Telegram.Bot.Simple.UpdateParser where -import Control.Applicative import Control.Monad #if defined(MIN_VERSION_GLASGOW_HASKELL) #if MIN_VERSION_GLASGOW_HASKELL(8,6,2,0) @@ -15,42 +14,22 @@ import qualified Data.Char as Char import Data.Text (Text) import qualified Data.Text as Text import Text.Read (readMaybe) - +import Control.Monad.Reader import Telegram.Bot.API - -newtype UpdateParser a = UpdateParser - { runUpdateParser :: Update -> Maybe a - } deriving (Functor) - -instance Applicative UpdateParser where - pure x = UpdateParser (pure (pure x)) - UpdateParser f <*> UpdateParser x = UpdateParser (\u -> f u <*> x u) - -instance Alternative UpdateParser where - empty = UpdateParser (const Nothing) - UpdateParser f <|> UpdateParser g = UpdateParser (\u -> f u <|> g u) - -instance Monad UpdateParser where - return = pure - UpdateParser x >>= f = UpdateParser (\u -> x u >>= flip runUpdateParser u . f) -#if !MIN_VERSION_base(4,13,0) - fail _ = empty -#endif - -#if MIN_VERSION_base(4,13,0) -instance MonadFail UpdateParser where - fail _ = empty -#endif +type UpdateParser a = ReaderT Update Maybe a mkParser :: (Update -> Maybe a) -> UpdateParser a -mkParser = UpdateParser +mkParser f = ask >>= lift . f parseUpdate :: UpdateParser a -> Update -> Maybe a -parseUpdate = runUpdateParser +parseUpdate = runReaderT + +runUpdateParser :: UpdateParser a -> Update -> Maybe a +runUpdateParser = runReaderT text :: UpdateParser Text -text = UpdateParser (extractUpdateMessage >=> messageText) +text = mkParser (extractUpdateMessage >=> messageText) plainText :: UpdateParser Text plainText = do @@ -77,10 +56,7 @@ commandWithBotName botname commandname = do -- | Obtain 'CallbackQuery' @data@ associated with the callback button in an inline keyboard if present in 'Update' message. callbackQueryDataRead :: Read a => UpdateParser a -callbackQueryDataRead = mkParser $ \update -> do - query <- updateCallbackQuery update - data_ <- callbackQueryData query - readMaybe (Text.unpack data_) +callbackQueryDataRead = mkParser (updateCallbackQuery >=> callbackQueryData >=> (readMaybe . Text.unpack)) updateMessageText :: Update -> Maybe Text updateMessageText = extractUpdateMessage >=> messageText