{-# 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
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
  { botInitialModel :: HashMap (Maybe conversation) model
botInitialModel = 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      = 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         = forall {t}. [BotJob (HashMap t model) (t, action)]
conversationJobs
  }
  where
    conversationInitialModel :: HashMap k v
conversationInitialModel = 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 = forall a. a -> Maybe a -> a
fromMaybe model
botInitialModel (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (forall a. a -> Maybe a
Just conversation
conversation) HashMap (Maybe conversation) model
conversations)
      (forall a. a -> Maybe a
Just conversation
conversation,) 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 =
      forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (k
conversation,) (\model
m -> 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) forall a b. (a -> b) -> a -> b
$
        action -> model -> Eff action model
botHandler action
action model
model
      where
        model :: model
model = forall a. a -> Maybe a -> a
fromMaybe model
botInitialModel (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 = forall a b. (a -> b) -> [a] -> [b]
map 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
botJobTask :: forall model action.
BotJob model action -> model -> Eff action model
botJobSchedule :: forall model action. BotJob model action -> Text
botJobTask :: v1 -> Eff a v1
botJobSchedule :: Text
..} = BotJob
      { botJobSchedule :: Text
botJobSchedule = Text
botJobSchedule
      , botJobTask :: HashMap t v1 -> Eff (t, a) (HashMap t v1)
botJobTask = forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HashMap.traverseWithKey forall a b. (a -> b) -> a -> b
$
          \t
conversation -> forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (t
conversation,) 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
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
  { botInitialModel :: (Maybe Update, model)
botInitialModel = (forall a. Maybe a
Nothing, model
botInitialModel)
  , botAction :: Update -> (Maybe Update, model) -> Maybe (Maybe Update, action)
botAction       = 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      = 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) = (forall a. a -> Maybe a
Just Update
update,) 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) =
        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,) forall a b. (a -> b) -> a -> b
$
          -- re-enforcing update here is needed for actions issued in jobs
          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 = forall a b. (a -> b) -> [a] -> [b]
map 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
botJobTask :: b -> Eff a b
botJobSchedule :: Text
botJobTask :: forall model action.
BotJob model action -> model -> Eff action model
botJobSchedule :: forall model action. BotJob model action -> Text
..} = BotJob
        { botJobSchedule :: Text
botJobSchedule = Text
botJobSchedule
        , botJobTask :: (Maybe Update, b) -> Eff (Maybe Update, a) (Maybe Update, b)
botJobTask = \(Maybe Update
update, b
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,) (forall action model.
Maybe Update -> Eff action model -> Eff action model
setEffUpdate Maybe Update
update (b -> Eff a b
botJobTask b
model))
        }