{-# 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
ClientEnv
TQueue (Maybe Update, action)
User
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 action]
effects <- IO [BotM action] -> IO [BotM action]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [BotM action] -> IO [BotM action])
-> IO [BotM action] -> IO [BotM action]
forall a b. (a -> b) -> a -> b
$ STM [BotM action] -> IO [BotM action]
forall a. STM a -> IO a
atomically (STM [BotM action] -> IO [BotM action])
-> STM [BotM action] -> IO [BotM 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 action])
forall action model. Eff action model -> (model, [BotM action])
runEff (model -> Eff action model
task model
model) of
      (model
newModel, [BotM action]
effects) -> do
        TVar model -> model -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar model
botModelVar model
newModel
        [BotM action] -> STM [BotM action]
forall (m :: * -> *) a. Monad m => a -> m a
return [BotM 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 action -> ClientM ()) -> [BotM action] -> ClientM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ClientM action -> (action -> ClientM ()) -> ClientM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> ClientM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ()) -> (action -> IO ()) -> action -> ClientM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotEnv model action -> Maybe Update -> action -> IO ()
forall model action.
BotEnv model action -> Maybe Update -> action -> IO ()
issueAction BotEnv model action
botEnv Maybe Update
forall a. Maybe a
Nothing) (ClientM action -> ClientM ())
-> (BotM action -> ClientM action) -> BotM action -> ClientM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotContext -> BotM action -> ClientM action
forall a. BotContext -> BotM a -> ClientM a
runBotM (User -> Maybe Update -> BotContext
BotContext User
botUser Maybe Update
forall a. Maybe a
Nothing)) [BotM 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 -> action -> IO ()
issueAction :: BotEnv model action -> Maybe Update -> action -> IO ()
issueAction BotEnv{TVar model
ClientEnv
TQueue (Maybe Update, action)
User
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 = 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)

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

-- | Start 'Telegram.Update' polling with a given update handler.
startPolling :: (Telegram.Update -> ClientM ()) -> ClientM ()
startPolling :: (Update -> ClientM ()) -> ClientM ()
startPolling Update -> ClientM ()
handleUpdate = Maybe UpdateId -> ClientM ()
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 Int32
n) = Int32 -> UpdateId
Telegram.UpdateId (Int32
n Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
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 Int32
-> Maybe Seconds
-> Maybe [UpdateType]
-> GetUpdatesRequest
Telegram.GetUpdatesRequest Maybe UpdateId
offset Maybe Int32
forall a. Maybe a
Nothing Maybe Seconds
forall a. Maybe a
Nothing 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 ()) -> [Update] -> ClientM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Update -> ClientM ()
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