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

import           Control.Applicative
import           Control.Monad.Reader
#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           Telegram.Bot.API


newtype UpdateParser a = UpdateParser
  { forall a. UpdateParser a -> Update -> Maybe a
runUpdateParser :: Update -> Maybe a
  } deriving (forall a b. a -> UpdateParser b -> UpdateParser a
forall a b. (a -> b) -> UpdateParser a -> UpdateParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> UpdateParser b -> UpdateParser a
$c<$ :: forall a b. a -> UpdateParser b -> UpdateParser a
fmap :: forall a b. (a -> b) -> UpdateParser a -> UpdateParser b
$cfmap :: forall a b. (a -> b) -> UpdateParser a -> UpdateParser b
Functor)

instance Applicative UpdateParser where
  pure :: forall a. a -> UpdateParser a
pure a
x = forall a. (Update -> Maybe a) -> UpdateParser a
UpdateParser (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x))
  UpdateParser Update -> Maybe (a -> b)
f <*> :: forall a b.
UpdateParser (a -> b) -> UpdateParser a -> UpdateParser b
<*> UpdateParser Update -> Maybe a
x = forall a. (Update -> Maybe a) -> UpdateParser a
UpdateParser (\Update
u -> Update -> Maybe (a -> b)
f Update
u forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Update -> Maybe a
x Update
u)

instance Alternative UpdateParser where
  empty :: forall a. UpdateParser a
empty = forall a. (Update -> Maybe a) -> UpdateParser a
UpdateParser (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
  UpdateParser Update -> Maybe a
f <|> :: forall a. UpdateParser a -> UpdateParser a -> UpdateParser a
<|> UpdateParser Update -> Maybe a
g = forall a. (Update -> Maybe a) -> UpdateParser a
UpdateParser (\Update
u -> Update -> Maybe a
f Update
u forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Update -> Maybe a
g Update
u)

instance Monad UpdateParser where
  return :: forall a. a -> UpdateParser a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  UpdateParser Update -> Maybe a
x >>= :: forall a b.
UpdateParser a -> (a -> UpdateParser b) -> UpdateParser b
>>= a -> UpdateParser b
f = forall a. (Update -> Maybe a) -> UpdateParser a
UpdateParser (\Update
u -> Update -> Maybe a
x Update
u forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. UpdateParser a -> Update -> Maybe a
runUpdateParser Update
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> UpdateParser b
f)
#if !MIN_VERSION_base(4,13,0)
  fail _ = empty
#endif

#if MIN_VERSION_base(4,13,0)
instance MonadFail UpdateParser where
  fail :: forall a. String -> UpdateParser a
fail String
_ = forall (f :: * -> *) a. Alternative f => f a
empty
#endif

mkParser :: (Update -> Maybe a) -> UpdateParser a
mkParser :: forall a. (Update -> Maybe a) -> UpdateParser a
mkParser = forall a. (Update -> Maybe a) -> UpdateParser a
UpdateParser

parseUpdate :: UpdateParser a -> Update -> Maybe a
parseUpdate :: forall a. UpdateParser a -> Update -> Maybe a
parseUpdate = forall a. UpdateParser a -> Update -> Maybe a
runUpdateParser

text :: UpdateParser Text
text :: UpdateParser Text
text = forall a. (Update -> Maybe a) -> UpdateParser a
UpdateParser (Update -> Maybe Message
extractUpdateMessage 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 forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"command"
    else 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 forall a. Eq a => a -> a -> Bool
== Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
name
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.stripStart Text
rest
    else 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
commandname forall a. Semigroup a => a -> a -> a
<> Text
"@" forall a. Semigroup a => a -> a -> a
<> Text
botname, Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
commandname]
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.stripStart Text
rest
    else 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 = forall a. (Update -> Maybe a) -> UpdateParser a
mkParser forall a b. (a -> b) -> a -> b
$ \Update
update -> do
  CallbackQuery
query <- Update -> Maybe CallbackQuery
updateCallbackQuery Update
update
  Text
data_ <- CallbackQuery -> Maybe Text
callbackQueryData CallbackQuery
query
  forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
data_)

updateMessageText :: Update -> Maybe Text
updateMessageText :: Update -> Maybe Text
updateMessageText = Update -> Maybe Message
extractUpdateMessage 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 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Message -> Maybe Sticker
messageSticker