Merge pull request #171 from lispandfound/update-parser-transformers

Change UpdateParser to use Monad Transformers

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