{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Telegram.Bot.Simple.BotApp.Internal where

import           Control.Concurrent      (ThreadId, forkIO, threadDelay)
import           Control.Concurrent.STM
import           Control.Monad           (forever, void, (<=<))
import           Control.Monad.Except    (catchError)
import           Control.Monad.Trans     (liftIO)
import           Data.Bifunctor          (first)
import           Data.Text               (Text)
import           Servant.Client          (ClientEnv, ClientM, runClientM)
import qualified System.Cron             as Cron

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

-- | A bot application.
data BotApp model action = BotApp
  { BotApp model action -> model
botInitialModel :: model
    -- ^ Initial bot state.
  , BotApp model action -> Update -> model -> Maybe action
botAction       :: Telegram.Update -> model -> Maybe action
    -- ^ How to convert incoming 'Telegram.Update's into @action@s.
    -- See "Telegram.Bot.Simple.UpdateParser" for some helpers.
  , BotApp model action -> action -> model -> Eff action model
botHandler      :: action -> model -> Eff action model
    -- ^ How to handle @action@s.
  , BotApp model action -> [BotJob model action]
botJobs         :: [BotJob model action]
    -- ^ Background bot jobs.
  }

-- | A background bot job.
data BotJob model action = BotJob
  { BotJob model action -> Text
botJobSchedule :: Text
    -- ^ Cron schedule for the job.
  , BotJob model action -> model -> Eff action model
botJobTask     :: model -> Eff action model
    -- ^ Job function.
  }

-- | An environment actual bot runs in.
data BotEnv model action = BotEnv
  { BotEnv model action -> TVar model
botModelVar     :: TVar model
    -- ^ A transactional variable with bot's current state.
  , BotEnv model action -> TQueue (Maybe Update, action)
botActionsQueue :: TQueue (Maybe Telegram.Update, action)
    -- ^ A queue of @action@s to process (with associated 'Telegram.Update's).
  , BotEnv model action -> ClientEnv
botClientEnv    :: ClientEnv
    -- ^ HTTP client environment (where and how exactly to make requests to Telegram Bot API).
    -- This includes 'Telegram.Token'.
  , BotEnv model action -> User
botUser         :: Telegram.User
    -- ^ Information about the bot in the form of 'Telegram.User'.
  }

instance Functor (BotJob model) where
  fmap :: (a -> b) -> BotJob model a -> BotJob model b
fmap a -> b
f BotJob{Text
model -> Eff a model
botJobTask :: model -> Eff a model
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{ botJobTask :: model -> Eff b model
botJobTask = (a -> b) -> Eff a model -> Eff b model
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f (Eff a model -> Eff b model)
-> (model -> Eff a model) -> model -> Eff b model
forall b c a. (b -> c) -> (a -> b) -> a -> c
. model -> Eff a model
botJobTask, Text
botJobSchedule :: Text
botJobSchedule :: Text
.. }

-- | Run bot job task once.
runJobTask :: BotEnv model action -> (model -> Eff action model) -> IO ()
runJobTask :: BotEnv model action -> (model -> Eff action model) -> IO ()
runJobTask botEnv :: BotEnv model action
botEnv@BotEnv{TVar model
TQueue (Maybe Update, action)
User
ClientEnv
botUser :: User
botClientEnv :: ClientEnv
botActionsQueue :: TQueue (Maybe Update, action)
botModelVar :: TVar model
botUser :: forall model action. BotEnv model action -> User
botClientEnv :: forall model action. BotEnv model action -> ClientEnv
botActionsQueue :: forall model action.
BotEnv model action -> TQueue (Maybe Update, action)
botModelVar :: forall model action. BotEnv model action -> TVar model
..} model -> Eff action model
task = do
  [BotM (Maybe action)]
effects <- IO [BotM (Maybe action)] -> IO [BotM (Maybe action)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [BotM (Maybe action)] -> IO [BotM (Maybe action)])
-> IO [BotM (Maybe action)] -> IO [BotM (Maybe action)]
forall a b. (a -> b) -> a -> b
$ STM [BotM (Maybe action)] -> IO [BotM (Maybe action)]
forall a. STM a -> IO a
atomically (STM [BotM (Maybe action)] -> IO [BotM (Maybe action)])
-> STM [BotM (Maybe action)] -> IO [BotM (Maybe action)]
forall a b. (a -> b) -> a -> b
$ do
    model
model <- TVar model -> STM model
forall a. TVar a -> STM a
readTVar TVar model
botModelVar
    case Eff action model -> (model, [BotM (Maybe action)])
forall action model.
Eff action model -> (model, [BotM (Maybe action)])
runEff (model -> Eff action model
task model
model) of
      (model
newModel, [BotM (Maybe action)]
effects) -> do
        TVar model -> model -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar model
botModelVar model
newModel
        [BotM (Maybe action)] -> STM [BotM (Maybe action)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BotM (Maybe action)]
effects
  Either ClientError ()
res <- (ClientM () -> ClientEnv -> IO (Either ClientError ()))
-> ClientEnv -> ClientM () -> IO (Either ClientError ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip ClientM () -> ClientEnv -> IO (Either ClientError ())
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientEnv
botClientEnv (ClientM () -> IO (Either ClientError ()))
-> ClientM () -> IO (Either ClientError ())
forall a b. (a -> b) -> a -> b
$
    (BotM (Maybe action) -> ClientM ())
-> [BotM (Maybe action)] -> ClientM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((IO () -> ClientM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ())
-> (Maybe action -> IO ()) -> Maybe action -> ClientM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotEnv model action -> Maybe Update -> Maybe action -> IO ()
forall model action.
BotEnv model action -> Maybe Update -> Maybe action -> IO ()
issueAction BotEnv model action
botEnv Maybe Update
forall a. Maybe a
Nothing) (Maybe action -> ClientM ())
-> (BotM (Maybe action) -> ClientM (Maybe action))
-> BotM (Maybe action)
-> ClientM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< BotContext -> BotM (Maybe action) -> ClientM (Maybe action)
forall a. BotContext -> BotM a -> ClientM a
runBotM (User -> Maybe Update -> BotContext
BotContext User
botUser Maybe Update
forall a. Maybe a
Nothing)) [BotM (Maybe action)]
effects
  case Either ClientError ()
res of
    Left ClientError
err -> ClientError -> IO ()
forall a. Show a => a -> IO ()
print ClientError
err
    Right ()
_  -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Schedule a cron-like bot job.
scheduleBotJob :: BotEnv model action -> BotJob model action -> IO [ThreadId]
scheduleBotJob :: BotEnv model action -> BotJob model action -> IO [ThreadId]
scheduleBotJob BotEnv model action
botEnv BotJob{Text
model -> Eff action model
botJobTask :: model -> Eff action model
botJobSchedule :: Text
botJobTask :: forall model action.
BotJob model action -> model -> Eff action model
botJobSchedule :: forall model action. BotJob model action -> Text
..} = Schedule () -> IO [ThreadId]
Cron.execSchedule (Schedule () -> IO [ThreadId]) -> Schedule () -> IO [ThreadId]
forall a b. (a -> b) -> a -> b
$ do
  IO () -> Text -> Schedule ()
forall (m :: * -> *). MonadSchedule m => IO () -> Text -> m ()
Cron.addJob (BotEnv model action -> (model -> Eff action model) -> IO ()
forall model action.
BotEnv model action -> (model -> Eff action model) -> IO ()
runJobTask BotEnv model action
botEnv model -> Eff action model
botJobTask) Text
botJobSchedule

-- | Schedule all bot jobs.
scheduleBotJobs :: BotEnv model action -> [BotJob model action] -> IO [ThreadId]
scheduleBotJobs :: BotEnv model action -> [BotJob model action] -> IO [ThreadId]
scheduleBotJobs BotEnv model action
botEnv [BotJob model action]
jobs = [[ThreadId]] -> [ThreadId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  ([[ThreadId]] -> [ThreadId]) -> IO [[ThreadId]] -> IO [ThreadId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BotJob model action -> IO [ThreadId])
-> [BotJob model action] -> IO [[ThreadId]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (BotEnv model action -> BotJob model action -> IO [ThreadId]
forall model action.
BotEnv model action -> BotJob model action -> IO [ThreadId]
scheduleBotJob BotEnv model action
botEnv) [BotJob model action]
jobs

-- | Construct a default @'BotEnv' model action@ for a bot.
defaultBotEnv :: BotApp model action -> ClientEnv -> IO (BotEnv model action)
defaultBotEnv :: BotApp model action -> ClientEnv -> IO (BotEnv model action)
defaultBotEnv 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
..} ClientEnv
env = TVar model
-> TQueue (Maybe Update, action)
-> ClientEnv
-> User
-> BotEnv model action
forall model action.
TVar model
-> TQueue (Maybe Update, action)
-> ClientEnv
-> User
-> BotEnv model action
BotEnv
  (TVar model
 -> TQueue (Maybe Update, action)
 -> ClientEnv
 -> User
 -> BotEnv model action)
-> IO (TVar model)
-> IO
     (TQueue (Maybe Update, action)
      -> ClientEnv -> User -> BotEnv model action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> model -> IO (TVar model)
forall a. a -> IO (TVar a)
newTVarIO model
botInitialModel
  IO
  (TQueue (Maybe Update, action)
   -> ClientEnv -> User -> BotEnv model action)
-> IO (TQueue (Maybe Update, action))
-> IO (ClientEnv -> User -> BotEnv model action)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (TQueue (Maybe Update, action))
forall a. IO (TQueue a)
newTQueueIO
  IO (ClientEnv -> User -> BotEnv model action)
-> IO ClientEnv -> IO (User -> BotEnv model action)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ClientEnv -> IO ClientEnv
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientEnv
env
  IO (User -> BotEnv model action)
-> IO User -> IO (BotEnv model action)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((ClientError -> User)
-> (Response User -> User)
-> Either ClientError (Response User)
-> User
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> User
forall a. HasCallStack => [Char] -> a
error ([Char] -> User) -> (ClientError -> [Char]) -> ClientError -> User
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientError -> [Char]
forall a. Show a => a -> [Char]
show) Response User -> User
forall a. Response a -> a
Telegram.responseResult (Either ClientError (Response User) -> User)
-> IO (Either ClientError (Response User)) -> IO User
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientM (Response User)
-> ClientEnv -> IO (Either ClientError (Response User))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM (Response User)
Telegram.getMe ClientEnv
env)

-- | Issue a new action for the bot to process.
issueAction :: BotEnv model action -> Maybe Telegram.Update -> Maybe action -> IO ()
issueAction :: BotEnv model action -> Maybe Update -> Maybe action -> IO ()
issueAction BotEnv{TVar model
TQueue (Maybe Update, action)
User
ClientEnv
botUser :: User
botClientEnv :: ClientEnv
botActionsQueue :: TQueue (Maybe Update, action)
botModelVar :: TVar model
botUser :: forall model action. BotEnv model action -> User
botClientEnv :: forall model action. BotEnv model action -> ClientEnv
botActionsQueue :: forall model action.
BotEnv model action -> TQueue (Maybe Update, action)
botModelVar :: forall model action. BotEnv model action -> TVar model
..} Maybe Update
update (Just action
action) = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$
  TQueue (Maybe Update, action) -> (Maybe Update, action) -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (Maybe Update, action)
botActionsQueue (Maybe Update
update, action
action)
issueAction BotEnv model action
_ Maybe Update
_ Maybe action
_ = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Process one action.
processAction
  :: BotApp model action
  -> BotEnv model action
  -> Maybe Telegram.Update
  -> action
  -> ClientM ()
processAction :: BotApp model action
-> BotEnv model action -> Maybe Update -> action -> ClientM ()
processAction 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
..} botEnv :: BotEnv model action
botEnv@BotEnv{TVar model
TQueue (Maybe Update, action)
User
ClientEnv
botUser :: User
botClientEnv :: ClientEnv
botActionsQueue :: TQueue (Maybe Update, action)
botModelVar :: TVar model
botUser :: forall model action. BotEnv model action -> User
botClientEnv :: forall model action. BotEnv model action -> ClientEnv
botActionsQueue :: forall model action.
BotEnv model action -> TQueue (Maybe Update, action)
botModelVar :: forall model action. BotEnv model action -> TVar model
..} Maybe Update
update action
action = do
  [BotM (Maybe action)]
effects <- IO [BotM (Maybe action)] -> ClientM [BotM (Maybe action)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [BotM (Maybe action)] -> ClientM [BotM (Maybe action)])
-> IO [BotM (Maybe action)] -> ClientM [BotM (Maybe action)]
forall a b. (a -> b) -> a -> b
$ STM [BotM (Maybe action)] -> IO [BotM (Maybe action)]
forall a. STM a -> IO a
atomically (STM [BotM (Maybe action)] -> IO [BotM (Maybe action)])
-> STM [BotM (Maybe action)] -> IO [BotM (Maybe action)]
forall a b. (a -> b) -> a -> b
$ do
    model
model <- TVar model -> STM model
forall a. TVar a -> STM a
readTVar TVar model
botModelVar
    case Eff action model -> (model, [BotM (Maybe action)])
forall action model.
Eff action model -> (model, [BotM (Maybe action)])
runEff (action -> model -> Eff action model
botHandler action
action model
model) of
      (model
newModel, [BotM (Maybe action)]
effects) -> do
        TVar model -> model -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar model
botModelVar model
newModel
        [BotM (Maybe action)] -> STM [BotM (Maybe action)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BotM (Maybe action)]
effects
  (BotM (Maybe action) -> ClientM ())
-> [BotM (Maybe action)] -> ClientM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((IO () -> ClientM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ())
-> (Maybe action -> IO ()) -> Maybe action -> ClientM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotEnv model action -> Maybe Update -> Maybe action -> IO ()
forall model action.
BotEnv model action -> Maybe Update -> Maybe action -> IO ()
issueAction BotEnv model action
botEnv Maybe Update
update) (Maybe action -> ClientM ())
-> (BotM (Maybe action) -> ClientM (Maybe action))
-> BotM (Maybe action)
-> ClientM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< BotContext -> BotM (Maybe action) -> ClientM (Maybe action)
forall a. BotContext -> BotM a -> ClientM a
runBotM (User -> Maybe Update -> BotContext
BotContext User
botUser Maybe Update
update)) [BotM (Maybe action)]
effects

-- | A job to wait for the next action and process it.
processActionJob :: BotApp model action -> BotEnv model action -> ClientM ()
processActionJob :: BotApp model action -> BotEnv model action -> ClientM ()
processActionJob BotApp model action
botApp botEnv :: BotEnv model action
botEnv@BotEnv{TVar model
TQueue (Maybe Update, action)
User
ClientEnv
botUser :: User
botClientEnv :: ClientEnv
botActionsQueue :: TQueue (Maybe Update, action)
botModelVar :: TVar model
botUser :: forall model action. BotEnv model action -> User
botClientEnv :: forall model action. BotEnv model action -> ClientEnv
botActionsQueue :: forall model action.
BotEnv model action -> TQueue (Maybe Update, action)
botModelVar :: forall model action. BotEnv model action -> TVar model
..} = do
  (Maybe Update
update, action
action) <- IO (Maybe Update, action) -> ClientM (Maybe Update, action)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Update, action) -> ClientM (Maybe Update, action))
-> (STM (Maybe Update, action) -> IO (Maybe Update, action))
-> STM (Maybe Update, action)
-> ClientM (Maybe Update, action)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM (Maybe Update, action) -> IO (Maybe Update, action)
forall a. STM a -> IO a
atomically (STM (Maybe Update, action) -> ClientM (Maybe Update, action))
-> STM (Maybe Update, action) -> ClientM (Maybe Update, action)
forall a b. (a -> b) -> a -> b
$ TQueue (Maybe Update, action) -> STM (Maybe Update, action)
forall a. TQueue a -> STM a
readTQueue TQueue (Maybe Update, action)
botActionsQueue
  BotApp model action
-> BotEnv model action -> Maybe Update -> action -> ClientM ()
forall model action.
BotApp model action
-> BotEnv model action -> Maybe Update -> action -> ClientM ()
processAction BotApp model action
botApp BotEnv model action
botEnv Maybe Update
update action
action

-- | Process incoming actions indefinitely.
processActionsIndefinitely
  :: BotApp model action -> BotEnv model action -> IO ThreadId
processActionsIndefinitely :: BotApp model action -> BotEnv model action -> IO ThreadId
processActionsIndefinitely BotApp model action
botApp BotEnv model action
botEnv = IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId)
-> (IO (Either ClientError ()) -> IO ())
-> IO (Either ClientError ())
-> IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either ClientError ()) -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO (Either ClientError ()) -> IO ThreadId)
-> IO (Either ClientError ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
  ClientM () -> ClientEnv -> IO (Either ClientError ())
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (BotApp model action -> BotEnv model action -> ClientM ()
forall model action.
BotApp model action -> BotEnv model action -> ClientM ()
processActionJob BotApp model action
botApp BotEnv model action
botEnv) (BotEnv model action -> ClientEnv
forall model action. BotEnv model action -> ClientEnv
botClientEnv BotEnv model action
botEnv)

-- | Start 'Telegram.Update' polling for a bot.
startBotPolling :: BotApp model action -> BotEnv model action -> ClientM ()
startBotPolling :: BotApp model action -> BotEnv model action -> ClientM ()
startBotPolling 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
..} botEnv :: BotEnv model action
botEnv@BotEnv{TVar model
TQueue (Maybe Update, action)
User
ClientEnv
botUser :: User
botClientEnv :: ClientEnv
botActionsQueue :: TQueue (Maybe Update, action)
botModelVar :: TVar model
botUser :: forall model action. BotEnv model action -> User
botClientEnv :: forall model action. BotEnv model action -> ClientEnv
botActionsQueue :: forall model action.
BotEnv model action -> TQueue (Maybe Update, action)
botModelVar :: forall model action. BotEnv model action -> TVar model
..} = (Update -> ClientM ()) -> ClientM ()
forall a. (Update -> ClientM a) -> ClientM a
startPolling Update -> ClientM ()
forall (m :: * -> *). MonadIO m => Update -> m ()
handleUpdate
  where
    handleUpdate :: Update -> m ()
handleUpdate Update
update = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (IO () -> IO ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> (IO () -> IO ThreadId) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe action
maction <- Update -> model -> Maybe action
botAction Update
update (model -> Maybe action) -> IO model -> IO (Maybe action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar model -> IO model
forall a. TVar a -> IO a
readTVarIO TVar model
botModelVar
      case Maybe action
maction of
        Maybe action
Nothing     -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just action
action -> BotEnv model action -> Maybe Update -> Maybe action -> IO ()
forall model action.
BotEnv model action -> Maybe Update -> Maybe action -> IO ()
issueAction BotEnv model action
botEnv (Update -> Maybe Update
forall a. a -> Maybe a
Just Update
update) (action -> Maybe action
forall a. a -> Maybe a
Just action
action)

-- | Start 'Telegram.Update' polling with a given update handler.
startPolling :: (Telegram.Update -> ClientM a) -> ClientM a
startPolling :: (Update -> ClientM a) -> ClientM a
startPolling Update -> ClientM a
handleUpdate = Maybe UpdateId -> ClientM a
forall b. Maybe UpdateId -> ClientM b
go Maybe UpdateId
forall a. Maybe a
Nothing
  where
    go :: Maybe UpdateId -> ClientM b
go Maybe UpdateId
lastUpdateId = do
      let inc :: UpdateId -> UpdateId
inc (Telegram.UpdateId Int
n) = Int -> UpdateId
Telegram.UpdateId (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          offset :: Maybe UpdateId
offset = (UpdateId -> UpdateId) -> Maybe UpdateId -> Maybe UpdateId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UpdateId -> UpdateId
inc Maybe UpdateId
lastUpdateId
      Either ClientError (Response [Update])
res <-
        (Response [Update] -> Either ClientError (Response [Update])
forall a b. b -> Either a b
Right (Response [Update] -> Either ClientError (Response [Update]))
-> ClientM (Response [Update])
-> ClientM (Either ClientError (Response [Update]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetUpdatesRequest -> ClientM (Response [Update])
Telegram.getUpdates
          (Maybe UpdateId
-> Maybe Int
-> Maybe Seconds
-> Maybe [UpdateType]
-> GetUpdatesRequest
Telegram.GetUpdatesRequest Maybe UpdateId
offset Maybe Int
forall a. Maybe a
Nothing (Seconds -> Maybe Seconds
forall a. a -> Maybe a
Just Seconds
25) Maybe [UpdateType]
forall a. Maybe a
Nothing))
        ClientM (Either ClientError (Response [Update]))
-> (ClientError
    -> ClientM (Either ClientError (Response [Update])))
-> ClientM (Either ClientError (Response [Update]))
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (Either ClientError (Response [Update])
-> ClientM (Either ClientError (Response [Update]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ClientError (Response [Update])
 -> ClientM (Either ClientError (Response [Update])))
-> (ClientError -> Either ClientError (Response [Update]))
-> ClientError
-> ClientM (Either ClientError (Response [Update]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientError -> Either ClientError (Response [Update])
forall a b. a -> Either a b
Left)

      Maybe UpdateId
nextUpdateId <- case Either ClientError (Response [Update])
res of
        Left ClientError
servantErr -> do
          IO () -> ClientM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO ()
forall a. Show a => a -> IO ()
print ClientError
servantErr)
          Maybe UpdateId -> ClientM (Maybe UpdateId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UpdateId
lastUpdateId
        Right Response [Update]
result -> do
          let updates :: [Update]
updates = Response [Update] -> [Update]
forall a. Response a -> a
Telegram.responseResult Response [Update]
result
              updateIds :: [UpdateId]
updateIds = (Update -> UpdateId) -> [Update] -> [UpdateId]
forall a b. (a -> b) -> [a] -> [b]
map Update -> UpdateId
Telegram.updateUpdateId [Update]
updates
              maxUpdateId :: Maybe UpdateId
maxUpdateId = [Maybe UpdateId] -> Maybe UpdateId
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe UpdateId
forall a. Maybe a
Nothing Maybe UpdateId -> [Maybe UpdateId] -> [Maybe UpdateId]
forall a. a -> [a] -> [a]
: (UpdateId -> Maybe UpdateId) -> [UpdateId] -> [Maybe UpdateId]
forall a b. (a -> b) -> [a] -> [b]
map UpdateId -> Maybe UpdateId
forall a. a -> Maybe a
Just [UpdateId]
updateIds)
          (Update -> ClientM a) -> [Update] -> ClientM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Update -> ClientM a
handleUpdate [Update]
updates
          Maybe UpdateId -> ClientM (Maybe UpdateId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UpdateId
maxUpdateId
      IO () -> ClientM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ()) -> IO () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
1000000
      Maybe UpdateId -> ClientM b
go Maybe UpdateId
nextUpdateId