module Web.Telegram.Bot.Story where
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
import Web.Telegram.API.Bot (Message, Chat, User, text)
import Data.Text.Read (signed, decimal, double)
import Control.Monad.IO.Class (MonadIO)
import Web.Telegram.Bot.Types (Bot)
import Pipes (Pipe, await, yield)
import qualified Data.Text as T
import Data.Text (Text, pack)
type Story a = (User, Chat) -> StoryT (Bot a) BotMessage
type StoryT = Pipe Message BotMessage
data BotMessage
= BotTyping
| BotText Text
| BotKeyboard Text [[Text]]
deriving Show
class ToBotMessage a where
toMessage :: a -> BotMessage
instance ToBotMessage BotMessage where
toMessage = id
instance ToBotMessage Text where
toMessage = BotText
class Answer a where
parse :: MonadIO m => Message -> ExceptT Text m a
instance Answer Text where
parse x =
case text x of
Just t -> return t
Nothing -> throwE "Please send text message."
instance Answer Double where
parse x = do
t <- parse x
case signed double t of
Left e -> throwE (pack e)
Right (v, "") -> return v
Right _ -> throwE "Please use only 0-9 and '.' chars."
instance Answer Integer where
parse x = do
t <- parse x
case signed decimal t of
Left e -> throwE (pack e)
Right (v, x) -> if T.null x
then return v
else throwE "Please use only 0-9 chars."
instance Answer Int where
parse x = do
v <- parse x
return (fromIntegral (v :: Integer))
instance Answer Word where
parse x = do
v <- parse x
return (fromIntegral (v :: Integer))
select :: (MonadIO m, Answer a) => Text -> [[Text]] -> StoryT m a
select q = replica . BotKeyboard q
question :: (MonadIO m, Answer a) => Text -> StoryT m a
question = replica
replica :: (ToBotMessage a, MonadIO m, Answer b) => a -> StoryT m b
replica msg = do
yield (toMessage msg)
res <- runExceptT . parse =<< await
yield BotTyping
case res of
Left e -> replica e
Right a -> return a