{-# 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 :: forall conversation model action.
(Eq conversation, Hashable conversation) =>
(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
botInitialModel :: model
botAction :: Update -> model -> Maybe action
botHandler :: action -> model -> Eff action model
botJobs :: [BotJob model action]
botInitialModel :: forall model action. BotApp model action -> model
botAction :: forall model action.
BotApp model action -> Update -> model -> Maybe action
botHandler :: forall model action.
BotApp model action -> action -> model -> Eff action model
botJobs :: forall model action. BotApp model action -> [BotJob 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 a b c d. (a -> b) -> (c -> d) -> Eff a c -> Eff b d
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 {v1} {a} {t}. BotJob v1 a -> BotJob (HashMap t v1) (t, a)
toConversationJob [BotJob model action]
botJobs

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

      addUpdateToJob :: BotJob b a -> BotJob (Maybe Update, b) (Maybe Update, a)
addUpdateToJob BotJob{Text
b -> Eff a b
botJobSchedule :: forall model action. BotJob model action -> Text
botJobTask :: forall model action.
BotJob model action -> model -> Eff action model
botJobSchedule :: Text
botJobTask :: b -> Eff a b
..} = BotJob
        { botJobSchedule :: Text
botJobSchedule = Text
botJobSchedule
        , botJobTask :: (Maybe Update, b) -> Eff (Maybe Update, a) (Maybe Update, b)
botJobTask = \(Maybe Update
update, b
model) ->
            (a -> (Maybe Update, a))
-> (b -> (Maybe Update, b))
-> Eff a b
-> Eff (Maybe Update, a) (Maybe Update, b)
forall a b c d. (a -> b) -> (c -> d) -> Eff a c -> Eff b d
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 a b -> Eff a b
forall action model.
Maybe Update -> Eff action model -> Eff action model
setEffUpdate Maybe Update
update (b -> Eff a b
botJobTask b
model))
        }