Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Change UpdateParser to use Monad Transformers #171

Merged
merged 3 commits into from
Mar 28, 2024
Merged

Change UpdateParser to use Monad Transformers #171

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
7a6be91
Refactor UpdateParser to use monad transformers
lispandfound Mar 11, 2024
9c26855
Reintroduce mkParser function
lispandfound Mar 11, 2024
3ee4dbd
add runUpdateParser for compatibility
lispandfound Mar 11, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
42 changes: 9 additions & 33 deletions telegram-bot-simple/src/Telegram/Bot/Simple/UpdateParser.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand All @@ -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
Expand Down
Loading