Conversation.hs

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections   #-}
module Telegram.Bot.Simple.Conversation where

import           Data.Bifunctor
import           Data.Hashable              (Hashable)
import           Data.HashMap.Strict        (HashMap)
import qualified Data.HashMap.Strict        as HashMap
import           Data.Maybe                 (fromMaybe)

import qualified Telegram.Bot.API           as Telegram
import           Telegram.Bot.Simple.BotApp
import           Telegram.Bot.Simple.Eff

-- | Make bot to have a separate state for each conversation.
--
-- Common use (to have a separate state for each chat):
--
-- @
-- 'conversationBot' 'Telegram.updateChatId' bot
-- @
conversationBot
  :: (Eq conversation, Hashable conversation)
  => (Telegram.Update -> Maybe conversation)   -- ^ How to disambiguate conversations.
  -> BotApp model action
  -> BotApp (HashMap (Maybe conversation) model) (Maybe conversation, action)
conversationBot toConversation BotApp{..} = BotApp
  { botInitialModel = conversationInitialModel
  , botAction       = conversationAction
  , botHandler      = conversationHandler
  , botJobs         = conversationJobs
  }
  where
    conversationInitialModel = HashMap.empty

    conversationAction update conversations = do
      conversation <- toConversation update
      let model = fromMaybe botInitialModel (HashMap.lookup (Just conversation) conversations)
      (Just conversation,) <$> botAction update model

    conversationHandler (conversation, action) conversations =
      bimap (conversation,) (\m -> HashMap.insert conversation m conversations) $
        botHandler action model
      where
        model = fromMaybe botInitialModel (HashMap.lookup conversation conversations)

    conversationJobs = map toConversationJob botJobs

    toConversationJob BotJob{..} = BotJob
      { botJobSchedule = botJobSchedule
      , botJobTask = HashMap.traverseWithKey $
          \conversation -> first (conversation,) . botJobTask
      }

-- | Pass latest 'Telegram.Update' to all bot jobs.
--
-- This enables jobs to easily send notifications.
useLatestUpdateInJobs
  :: BotApp model action
  -> BotApp (Maybe Telegram.Update, model) (Maybe Telegram.Update, action)
useLatestUpdateInJobs BotApp{..} = BotApp
  { botInitialModel = (Nothing, botInitialModel)
  , botAction       = newAction
  , botHandler      = newHandler
  , botJobs         = newJobs
  }
    where
      newAction update (_, model) = (Just update,) <$> botAction update model

      newHandler (update, action) (_update, model) =
        bimap (update,) (update,) $
          -- re-enforcing update here is needed for actions issued in jobs
          setEffUpdate update (botHandler action model)

      newJobs = map addUpdateToJob botJobs

      addUpdateToJob BotJob{..} = BotJob
        { botJobSchedule = botJobSchedule
        , botJobTask = \(update, model) ->
            bimap (update,) (update,) (setEffUpdate update (botJobTask model))
        }