module Web.Bot.Story where
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
import Data.Text.Read (signed, decimal, double)
import Control.Monad.IO.Class (MonadIO)
import Pipes (Pipe, await, yield)
import qualified Data.Text as T
import Data.Text (Text)
import Web.Bot.Message (Message(..), ToMessage(..))
import Web.Bot.Platform (Bot)
import Web.Bot.User (User)
type Story a = User -> StoryT (Bot a) Message
type StoryT = Pipe Message Message
class Answer a where
parse :: MonadIO m => Message -> ExceptT Text m a
instance Answer Text where
parse (MsgText x) = return x
parse _ = throwE "Please send text message."
instance Answer Double where
parse x = do
t <- parse x
case signed double t of
Left e -> throwE (T.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 (T.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 . MsgKeyboard q
question :: (MonadIO m, Answer a) => Text -> StoryT m a
question = replica
replica :: (ToMessage a, MonadIO m, Answer b) => a -> StoryT m b
replica msg = do
yield (toMessage msg)
res <- runExceptT . parse =<< await
yield MsgTyping
case res of
Left e -> replica e
Right a -> return a