{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Telegram.Bot.Simple.UpdateParser where

import           Control.Monad
#if defined(MIN_VERSION_GLASGOW_HASKELL)
#if MIN_VERSION_GLASGOW_HASKELL(8,6,2,0)
#else
import           Data.Monoid                     ((<>))
#endif
#endif
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

type UpdateParser a = ReaderT Update Maybe a

mkParser :: (Update -> Maybe a) -> UpdateParser a
mkParser :: forall a. (Update -> Maybe a) -> UpdateParser a
mkParser Update -> Maybe a
f = ReaderT Update Maybe Update
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT Update Maybe Update
-> (Update -> ReaderT Update Maybe a) -> ReaderT Update Maybe a
forall a b.
ReaderT Update Maybe a
-> (a -> ReaderT Update Maybe b) -> ReaderT Update Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe a -> ReaderT Update Maybe a
forall (m :: * -> *) a. Monad m => m a -> ReaderT Update m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Maybe a -> ReaderT Update Maybe a)
-> (Update -> Maybe a) -> Update -> ReaderT Update Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Update -> Maybe a
f

parseUpdate :: UpdateParser a -> Update -> Maybe a
parseUpdate :: forall a. UpdateParser a -> Update -> Maybe a
parseUpdate = ReaderT Update Maybe a -> Update -> Maybe a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT

runUpdateParser :: UpdateParser a -> Update -> Maybe a
runUpdateParser :: forall a. UpdateParser a -> Update -> Maybe a
runUpdateParser = ReaderT Update Maybe a -> Update -> Maybe a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT

text :: UpdateParser Text
text :: UpdateParser Text
text = (Update -> Maybe Text) -> UpdateParser Text
forall a. (Update -> Maybe a) -> UpdateParser a
mkParser (Update -> Maybe Message
extractUpdateMessage (Update -> Maybe Message)
-> (Message -> Maybe Text) -> Update -> Maybe Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Message -> Maybe Text
messageText)

plainText :: UpdateParser Text
plainText :: UpdateParser Text
plainText = do
  Text
t <- UpdateParser Text
text
  if Text
"/" Text -> Text -> Bool
`Text.isPrefixOf` Text
t
    then String -> UpdateParser Text
forall a. String -> ReaderT Update Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"command"
    else Text -> UpdateParser Text
forall a. a -> ReaderT Update Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t

command :: Text -> UpdateParser Text
command :: Text -> UpdateParser Text
command Text
name = do
  Text
t <- UpdateParser Text
text
  let (Text
cmd, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
Text.break Char -> Bool
Char.isSpace Text
t
  if Text
cmd Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
    then Text -> UpdateParser Text
forall a. a -> ReaderT Update Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> UpdateParser Text) -> Text -> UpdateParser Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.stripStart Text
rest
    else String -> UpdateParser Text
forall a. String -> ReaderT Update Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not that command"

commandWithBotName :: Text -> Text -> UpdateParser Text
commandWithBotName :: Text -> Text -> UpdateParser Text
commandWithBotName Text
botname Text
commandname = do
  Text
t <- UpdateParser Text
text
  let (Text
cmd, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
Text.break Char -> Bool
Char.isSpace Text
t
  if Text
cmd Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commandname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
botname, Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commandname]
    then Text -> UpdateParser Text
forall a. a -> ReaderT Update Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> UpdateParser Text) -> Text -> UpdateParser Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.stripStart Text
rest
    else String -> UpdateParser Text
forall a. String -> ReaderT Update Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not that command"

-- | Obtain 'CallbackQuery' @data@ associated with the callback button in an inline keyboard if present in 'Update' message. 
callbackQueryDataRead :: Read a => UpdateParser a
callbackQueryDataRead :: forall a. Read a => UpdateParser a
callbackQueryDataRead = (Update -> Maybe a) -> UpdateParser a
forall a. (Update -> Maybe a) -> UpdateParser a
mkParser (Update -> Maybe CallbackQuery
updateCallbackQuery (Update -> Maybe CallbackQuery)
-> (CallbackQuery -> Maybe a) -> Update -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CallbackQuery -> Maybe Text
callbackQueryData (CallbackQuery -> Maybe Text)
-> (Text -> Maybe a) -> CallbackQuery -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> (Text -> String) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack))

updateMessageText :: Update -> Maybe Text
updateMessageText :: Update -> Maybe Text
updateMessageText = Update -> Maybe Message
extractUpdateMessage (Update -> Maybe Message)
-> (Message -> Maybe Text) -> Update -> Maybe Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Message -> Maybe Text
messageText


updateMessageSticker :: Update -> Maybe Sticker
updateMessageSticker :: Update -> Maybe Sticker
updateMessageSticker = Update -> Maybe Message
extractUpdateMessage (Update -> Maybe Message)
-> (Message -> Maybe Sticker) -> Update -> Maybe Sticker
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Message -> Maybe Sticker
messageSticker