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

import           Control.Applicative
import           Control.Monad.Reader
import           Data.Monoid          ((<>))
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 x :: 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 f :: Update -> Maybe (a -> b)
f <*> :: UpdateParser (a -> b) -> UpdateParser a -> UpdateParser b
<*> UpdateParser x :: Update -> Maybe a
x = (Update -> Maybe b) -> UpdateParser b
forall a. (Update -> Maybe a) -> UpdateParser a
UpdateParser (\u :: 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 f :: Update -> Maybe a
f <|> :: UpdateParser a -> UpdateParser a -> UpdateParser a
<|> UpdateParser g :: Update -> Maybe a
g = (Update -> Maybe a) -> UpdateParser a
forall a. (Update -> Maybe a) -> UpdateParser a
UpdateParser (\u :: 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 x :: Update -> Maybe a
x >>= :: UpdateParser a -> (a -> UpdateParser b) -> UpdateParser b
>>= f :: a -> UpdateParser b
f = (Update -> Maybe b) -> UpdateParser b
forall a. (Update -> Maybe a) -> UpdateParser a
UpdateParser (\u :: 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)
instance MonadFail UpdateParser where
  fail :: String -> UpdateParser a
fail _ = 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
updateMessage (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 -> Bool
`Text.isPrefixOf` Text
t
    then String -> UpdateParser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "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 name :: Text
name = do
  Text
t <- UpdateParser Text
text
  case Text -> [Text]
Text.words Text
t of
    (w :: Text
w:ws :: [Text]
ws) | Text
w Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
      -> Text -> UpdateParser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Text
Text.unwords [Text]
ws)
    _ -> String -> UpdateParser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "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
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
updateMessage (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