{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}
module Telegram.Bot.Simple.Eff where
import Control.Monad.Reader
import Control.Monad.Writer
import Data.Bifunctor
import Servant.Client
import qualified Telegram.Bot.API as Telegram
-- | Bot handler context.
--
-- The context may include an 'Update' the bot is handling at the moment.
newtype BotM a = BotM { _runBotM :: ReaderT BotContext ClientM a }
deriving (Functor, Applicative, Monad, MonadReader BotContext, MonadIO)
data BotContext = BotContext
{ botContextUser :: Telegram.User
, botContextUpdate :: Maybe Telegram.Update
}
liftClientM :: ClientM a -> BotM a
liftClientM = BotM . lift
runBotM :: BotContext -> BotM a -> ClientM a
runBotM update = flip runReaderT update . _runBotM
newtype Eff action model = Eff { _runEff :: Writer [BotM (Maybe action)] model }
deriving (Functor, Applicative, Monad)
-- | The idea behind following type class is
-- to allow you defining the type 'ret' you want to return from 'BotM' action.
-- You can create your own return-types via new instances.
-- Here 'action' is a 'botAction'
-- type, that will be used further in 'botHandler' function.
-- If you don't want to return action use 'Nothing' instead.
--
-- See "Telegram.Bot.Simple.Instances" for more commonly useful instances.
-- - @GetAction a a@ - for simple making finite automata of
-- BotM actions. (For example you can log every update
-- and then return new 'action' to answer at message/send sticker/etc)
-- - @GetAction () a@ - to use @pure ()@ instead of dealing with @Nothing@.
-- - @GetAction Text a@ - to add some sugar over the 'replyText' function.
-- 'OverloadedStrings' breaks type inference,
-- so we advise to use @replyText \"message\"@
-- instead of @pure \@_ \@Text \"message\"@.
class GetAction return action where
getNextAction :: BotM return -> BotM (Maybe action)
instance Bifunctor Eff where
bimap f g = Eff . mapWriter (bimap g (map . fmap . fmap $ f)) . _runEff
runEff :: Eff action model -> (model, [BotM (Maybe action)])
runEff = runWriter . _runEff
eff :: GetAction a b => BotM a -> Eff b ()
eff e = Eff (tell [getNextAction e])
withEffect :: GetAction a action => BotM a -> model -> Eff action model
withEffect effect model = eff effect >> pure model
(<#) :: GetAction a action => model -> BotM a -> Eff action model
(<#) = flip withEffect
-- | Set a specific 'Telegram.Update' in a 'BotM' context.
setBotMUpdate :: Maybe Telegram.Update -> BotM a -> BotM a
setBotMUpdate update (BotM m) = BotM (local f m)
where
f botContext = botContext { botContextUpdate = update }
-- | Set a specific 'Telegram.Update' in every effect of 'Eff' context.
setEffUpdate :: Maybe Telegram.Update -> Eff action model -> Eff action model
setEffUpdate update (Eff m) = Eff (censor (map (setBotMUpdate update)) m)