{-# 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
  { UpdateParser a -> Update -> Maybe a
runUpdateParser :: Update -> Maybe a
  } deriving (a -> UpdateParser b -> UpdateParser a
(a -> b) -> UpdateParser a -> UpdateParser b
(forall a b. (a -> b) -> UpdateParser a -> UpdateParser b)
-> (forall a b. a -> UpdateParser b -> UpdateParser a)
-> Functor UpdateParser
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
<$ :: a -> UpdateParser b -> UpdateParser a
$c<$ :: forall a b. a -> UpdateParser b -> UpdateParser a
fmap :: (a -> b) -> UpdateParser a -> UpdateParser b
$cfmap :: forall a b. (a -> b) -> UpdateParser a -> UpdateParser b
Functor)

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

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

instance Monad UpdateParser where
  return :: a -> UpdateParser a
return = a -> UpdateParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  UpdateParser Update -> Maybe a
x >>= :: UpdateParser a -> (a -> UpdateParser b) -> UpdateParser b
>>= a -> UpdateParser b
f = (Update -> Maybe b) -> UpdateParser b
forall a. (Update -> Maybe a) -> UpdateParser a
UpdateParser (\Update
u -> Update -> Maybe a
x Update
u Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UpdateParser b -> Update -> Maybe b)
-> Update -> UpdateParser b -> Maybe b
forall a b c. (a -> b -> c) -> b -> a -> c
flip UpdateParser b -> Update -> Maybe b
forall a. UpdateParser a -> Update -> Maybe a
runUpdateParser Update
u (UpdateParser b -> Maybe b)
-> (a -> UpdateParser b) -> a -> Maybe b
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 :: String -> UpdateParser a
fail String
_ = UpdateParser a
forall (f :: * -> *) a. Alternative f => f a
empty
#endif

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

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

text :: UpdateParser Text
text :: UpdateParser Text
text = (Update -> Maybe Text) -> UpdateParser Text
forall a. (Update -> Maybe a) -> UpdateParser a
UpdateParser (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 (m :: * -> *) a. MonadFail m => String -> m a
fail String
"command"
    else Text -> UpdateParser Text
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 (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 (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 (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 (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 (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not that command"

callbackQueryDataRead :: Read a => UpdateParser a
callbackQueryDataRead :: UpdateParser a
callbackQueryDataRead = (Update -> Maybe a) -> UpdateParser a
forall a. (Update -> Maybe a) -> UpdateParser a
mkParser ((Update -> Maybe a) -> UpdateParser a)
-> (Update -> Maybe a) -> UpdateParser a
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
  String -> Maybe a
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 (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