Story.hs

-- |
-- Module      :  Web.Bot.Story
-- Copyright   :  Alexander Krupenkin 2016
-- License     :  BSD3
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- Story is a dialog like abstraction for processing sparsed
-- by messages data from user.
--
-- @
--      hello :: Monad m => Text -> Text -> Int -> m BotMessage
--      hello name surname age = toMessage $
--          "Hello, " <> name <> " " <> surname <> "!\n"
--       <> "You lost " <> (T.pack $ show age) <> " years =)"
--
--      helloStory :: BotConfig a => Story a
--      helloStory _ = hello <$> question "How your name?"
--                           <*> question "How your surname?"
--                           <*> question "How old are you?"
-- @
--
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)

-- | Story is a pipe from user message to bot message
-- and result is a final bot message.
type Story a = User -> StoryT (Bot a) Message

-- | Story transformer is based on 'Pipe'
-- with fixed 'Message' in/out.
type StoryT = Pipe Message Message

-- | User message reply parser.
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))

-- | Reply keyboard selection
select :: (MonadIO m, Answer a) => Text -> [[Text]] -> StoryT m a
{-# INLINE select #-}
select q = replica . MsgKeyboard q

-- | Bot text question.
question :: (MonadIO m, Answer a) => Text -> StoryT m a
{-# INLINE question #-}
question = replica

-- | Generalized story maker.
-- The replica send message to user, when answer isn't parsed
-- the error be sended and wait for correct answer.
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