module Web.Bot.Platform (
Bot
, Platform(..)
, APIToken(..)
, getManager
, forkFinallyBot
, forkBot
, runBot
) where
import Control.Monad.Logger (MonadLogger(..), LoggingT, runStderrLoggingT)
import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask)
import Control.Monad.Trans.Control (MonadBaseControl(..))
import Control.Concurrent (forkIO, forkFinally, ThreadId)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Control.Exception (throwIO, SomeException)
import Network.HTTP.Client (newManager, Manager)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Base (MonadBase(..))
import qualified Data.Text as T
import Data.Monoid ((<>))
import Data.Text (Text)
import Web.Bot.Message (Message, ToMessage)
import Web.Bot.User (User)
import Web.Bot.Log
newtype Bot a b = Bot { unBot :: ReaderT Manager (LoggingT IO) b }
deriving (Functor, Applicative, Monad, MonadIO)
instance MonadLogger (Bot a) where
monadLoggerLog a b c d = Bot (monadLoggerLog a b c d)
instance MonadBase IO (Bot a) where
liftBase = liftIO
instance MonadBaseControl IO (Bot a) where
type StM (Bot a) b = b
liftBaseWith f = Bot $ liftBaseWith $ \r -> f (r . unBot)
restoreM = return
class Platform a where
trySelf :: APIToken a => Bot a ()
sendMessage :: (ToMessage msg, APIToken a) => User -> msg -> Bot a ()
messageHandler :: APIToken a
=> (User -> Message -> Bot a b)
-> Bot a c
platformName :: a -> Text
class Platform a => APIToken a where
apiToken :: Bot a Text
getManager :: Bot a Manager
getManager = Bot ask
runBot :: (APIToken a, MonadIO m)
=> Bot a b -> m b
runBot bot = liftIO $ do
manager <- newManager tlsManagerSettings
runStderrLoggingT (runReaderT mBot manager)
where Bot mBot = trySelf >> bot
forkBot :: APIToken a
=> Bot a () -> Bot a ThreadId
forkBot (Bot bot) = do
t <- Bot (ask >>= forkReader)
$logDebugS "Bot" ("Forked " <> T.pack (show t))
return t
where forkReader = liftIO . forkIO
. runStderrLoggingT . runReaderT bot
forkFinallyBot :: APIToken a
=> Bot a b
-> (Either SomeException b -> IO ())
-> Bot a ThreadId
forkFinallyBot (Bot bot) f = do
t <- Bot (ask >>= forkFinallyReader)
$logDebugS "Bot" ("Forked finally " <> T.pack (show t))
return t
where forkFinallyReader = liftIO . flip forkFinally f
. runStderrLoggingT . runReaderT bot