{-# 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 :: (Update -> Maybe conversation)
-> BotApp model action
-> BotApp
     (HashMap (Maybe conversation) model) (Maybe conversation, action)
conversationBot Update -> Maybe conversation
toConversation BotApp{model
[BotJob model action]
action -> model -> Eff action model
Update -> model -> Maybe action
botJobs :: forall model action. BotApp model action -> [BotJob model action]
botHandler :: forall model action.
BotApp model action -> action -> model -> Eff action model
botAction :: forall model action.
BotApp model action -> Update -> model -> Maybe action
botInitialModel :: forall model action. BotApp model action -> model
botJobs :: [BotJob model action]
botHandler :: action -> model -> Eff action model
botAction :: Update -> model -> Maybe action
botInitialModel :: model
..} = BotApp :: forall model action.
model
-> (Update -> model -> Maybe action)
-> (action -> model -> Eff action model)
-> [BotJob model action]
-> BotApp model action
BotApp
  { botInitialModel :: HashMap (Maybe conversation) model
botInitialModel = HashMap (Maybe conversation) model
forall k v. HashMap k v
conversationInitialModel
  , botAction :: Update
-> HashMap (Maybe conversation) model
-> Maybe (Maybe conversation, action)
botAction       = Update
-> HashMap (Maybe conversation) model
-> Maybe (Maybe conversation, action)
conversationAction
  , botHandler :: (Maybe conversation, action)
-> HashMap (Maybe conversation) model
-> Eff
     (Maybe conversation, action) (HashMap (Maybe conversation) model)
botHandler      = (Maybe conversation, action)
-> HashMap (Maybe conversation) model
-> Eff
     (Maybe conversation, action) (HashMap (Maybe conversation) model)
forall k.
Hashable k =>
(k, action) -> HashMap k model -> Eff (k, action) (HashMap k model)
conversationHandler
  , botJobs :: [BotJob
   (HashMap (Maybe conversation) model) (Maybe conversation, action)]
botJobs         = [BotJob
   (HashMap (Maybe conversation) model) (Maybe conversation, action)]
forall t. [BotJob (HashMap t model) (t, action)]
conversationJobs
  }
  where
    conversationInitialModel :: HashMap k v
conversationInitialModel = HashMap k v
forall k v. HashMap k v
HashMap.empty

    conversationAction :: Update
-> HashMap (Maybe conversation) model
-> Maybe (Maybe conversation, action)
conversationAction Update
update HashMap (Maybe conversation) model
conversations = do
      conversation
conversation <- Update -> Maybe conversation
toConversation Update
update
      let model :: model
model = model -> Maybe model -> model
forall a. a -> Maybe a -> a
fromMaybe model
botInitialModel (Maybe conversation
-> HashMap (Maybe conversation) model -> Maybe model
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (conversation -> Maybe conversation
forall a. a -> Maybe a
Just conversation
conversation) HashMap (Maybe conversation) model
conversations)
      (conversation -> Maybe conversation
forall a. a -> Maybe a
Just conversation
conversation,) (action -> (Maybe conversation, action))
-> Maybe action -> Maybe (Maybe conversation, action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Update -> model -> Maybe action
botAction Update
update model
model

    conversationHandler :: (k, action) -> HashMap k model -> Eff (k, action) (HashMap k model)
conversationHandler (k
conversation, action
action) HashMap k model
conversations =
      (action -> (k, action))
-> (model -> HashMap k model)
-> Eff action model
-> Eff (k, action) (HashMap k model)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (k
conversation,) (\model
m -> k -> model -> HashMap k model -> HashMap k model
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
conversation model
m HashMap k model
conversations) (Eff action model -> Eff (k, action) (HashMap k model))
-> Eff action model -> Eff (k, action) (HashMap k model)
forall a b. (a -> b) -> a -> b
$
        action -> model -> Eff action model
botHandler action
action model
model
      where
        model :: model
model = model -> Maybe model -> model
forall a. a -> Maybe a -> a
fromMaybe model
botInitialModel (k -> HashMap k model -> Maybe model
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
conversation HashMap k model
conversations)

    conversationJobs :: [BotJob (HashMap t model) (t, action)]
conversationJobs = (BotJob model action -> BotJob (HashMap t model) (t, action))
-> [BotJob model action] -> [BotJob (HashMap t model) (t, action)]
forall a b. (a -> b) -> [a] -> [b]
map BotJob model action -> BotJob (HashMap t model) (t, action)
forall v2 t t. BotJob v2 t -> BotJob (HashMap t v2) (t, t)
toConversationJob [BotJob model action]
botJobs

    toConversationJob :: BotJob v2 t -> BotJob (HashMap t v2) (t, t)
toConversationJob BotJob{Text
v2 -> Eff t v2
botJobTask :: forall model action.
BotJob model action -> model -> Eff action model
botJobSchedule :: forall model action. BotJob model action -> Text
botJobTask :: v2 -> Eff t v2
botJobSchedule :: Text
..} = BotJob :: forall model action.
Text -> (model -> Eff action model) -> BotJob model action
BotJob
      { botJobSchedule :: Text
botJobSchedule = Text
botJobSchedule
      , botJobTask :: HashMap t v2 -> Eff (t, t) (HashMap t v2)
botJobTask = (t -> v2 -> Eff (t, t) v2)
-> HashMap t v2 -> Eff (t, t) (HashMap t v2)
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HashMap.traverseWithKey ((t -> v2 -> Eff (t, t) v2)
 -> HashMap t v2 -> Eff (t, t) (HashMap t v2))
-> (t -> v2 -> Eff (t, t) v2)
-> HashMap t v2
-> Eff (t, t) (HashMap t v2)
forall a b. (a -> b) -> a -> b
$
          \t
conversation -> (t -> (t, t)) -> Eff t v2 -> Eff (t, t) v2
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (t
conversation,) (Eff t v2 -> Eff (t, t) v2)
-> (v2 -> Eff t v2) -> v2 -> Eff (t, t) v2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v2 -> Eff t v2
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 model action
-> BotApp (Maybe Update, model) (Maybe Update, action)
useLatestUpdateInJobs BotApp{model
[BotJob model action]
action -> model -> Eff action model
Update -> model -> Maybe action
botJobs :: [BotJob model action]
botHandler :: action -> model -> Eff action model
botAction :: Update -> model -> Maybe action
botInitialModel :: model
botJobs :: forall model action. BotApp model action -> [BotJob model action]
botHandler :: forall model action.
BotApp model action -> action -> model -> Eff action model
botAction :: forall model action.
BotApp model action -> Update -> model -> Maybe action
botInitialModel :: forall model action. BotApp model action -> model
..} = BotApp :: forall model action.
model
-> (Update -> model -> Maybe action)
-> (action -> model -> Eff action model)
-> [BotJob model action]
-> BotApp model action
BotApp
  { botInitialModel :: (Maybe Update, model)
botInitialModel = (Maybe Update
forall a. Maybe a
Nothing, model
botInitialModel)
  , botAction :: Update -> (Maybe Update, model) -> Maybe (Maybe Update, action)
botAction       = Update -> (Maybe Update, model) -> Maybe (Maybe Update, action)
forall a. Update -> (a, model) -> Maybe (Maybe Update, action)
newAction
  , botHandler :: (Maybe Update, action)
-> (Maybe Update, model)
-> Eff (Maybe Update, action) (Maybe Update, model)
botHandler      = (Maybe Update, action)
-> (Maybe Update, model)
-> Eff (Maybe Update, action) (Maybe Update, model)
forall a.
(Maybe Update, action)
-> (a, model) -> Eff (Maybe Update, action) (Maybe Update, model)
newHandler
  , botJobs :: [BotJob (Maybe Update, model) (Maybe Update, action)]
botJobs         = [BotJob (Maybe Update, model) (Maybe Update, action)]
newJobs
  }
    where
      newAction :: Update -> (a, model) -> Maybe (Maybe Update, action)
newAction Update
update (a
_, model
model) = (Update -> Maybe Update
forall a. a -> Maybe a
Just Update
update,) (action -> (Maybe Update, action))
-> Maybe action -> Maybe (Maybe Update, action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Update -> model -> Maybe action
botAction Update
update model
model

      newHandler :: (Maybe Update, action)
-> (a, model) -> Eff (Maybe Update, action) (Maybe Update, model)
newHandler (Maybe Update
update, action
action) (a
_update, model
model) =
        (action -> (Maybe Update, action))
-> (model -> (Maybe Update, model))
-> Eff action model
-> Eff (Maybe Update, action) (Maybe Update, model)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Maybe Update
update,) (Maybe Update
update,) (Eff action model
 -> Eff (Maybe Update, action) (Maybe Update, model))
-> Eff action model
-> Eff (Maybe Update, action) (Maybe Update, model)
forall a b. (a -> b) -> a -> b
$
          -- re-enforcing update here is needed for actions issued in jobs
          Maybe Update -> Eff action model -> Eff action model
forall action model.
Maybe Update -> Eff action model -> Eff action model
setEffUpdate Maybe Update
update (action -> model -> Eff action model
botHandler action
action model
model)

      newJobs :: [BotJob (Maybe Update, model) (Maybe Update, action)]
newJobs = (BotJob model action
 -> BotJob (Maybe Update, model) (Maybe Update, action))
-> [BotJob model action]
-> [BotJob (Maybe Update, model) (Maybe Update, action)]
forall a b. (a -> b) -> [a] -> [b]
map BotJob model action
-> BotJob (Maybe Update, model) (Maybe Update, action)
forall t t.
BotJob t t -> BotJob (Maybe Update, t) (Maybe Update, t)
addUpdateToJob [BotJob model action]
botJobs

      addUpdateToJob :: BotJob t t -> BotJob (Maybe Update, t) (Maybe Update, t)
addUpdateToJob BotJob{Text
t -> Eff t t
botJobTask :: t -> Eff t t
botJobSchedule :: Text
botJobTask :: forall model action.
BotJob model action -> model -> Eff action model
botJobSchedule :: forall model action. BotJob model action -> Text
..} = BotJob :: forall model action.
Text -> (model -> Eff action model) -> BotJob model action
BotJob
        { botJobSchedule :: Text
botJobSchedule = Text
botJobSchedule
        , botJobTask :: (Maybe Update, t) -> Eff (Maybe Update, t) (Maybe Update, t)
botJobTask = \(Maybe Update
update, t
model) ->
            (t -> (Maybe Update, t))
-> (t -> (Maybe Update, t))
-> Eff t t
-> Eff (Maybe Update, t) (Maybe Update, t)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Maybe Update
update,) (Maybe Update
update,) (Maybe Update -> Eff t t -> Eff t t
forall action model.
Maybe Update -> Eff action model -> Eff action model
setEffUpdate Maybe Update
update (t -> Eff t t
botJobTask t
model))
        }