{-# LANGUAGE RankNTypes #-}
module Discord
( module Discord.Types
, module Discord.Rest.Channel
, module Discord.Rest.Guild
, module Discord.Rest.User
, module Discord.Rest.Invite
, module Discord.Rest.Emoji
, Cache(..)
, Gateway(..)
, RestChan(..)
, RestCallException(..)
, GatewayException(..)
, Request(..)
, ThreadIdType(..)
, restCall
, nextEvent
, sendCommand
, readCache
, stopDiscord
, loginRest
, loginRestGateway
) where
import Prelude hiding (log)
import Control.Monad (forever)
import Control.Concurrent (forkIO, threadDelay, ThreadId, killThread)
import Control.Concurrent.Chan
import Control.Concurrent.MVar
import Data.Monoid ((<>))
import Data.Aeson
import Discord.Rest
import Discord.Rest.Channel
import Discord.Rest.Guild
import Discord.Rest.User
import Discord.Rest.Invite
import Discord.Rest.Emoji
import Discord.Types
import Discord.Gateway
import Discord.Gateway.Cache
data ThreadIdType = ThreadRest ThreadId
| ThreadGateway ThreadId
| ThreadLogger ThreadId
data NotLoggedIntoGateway = NotLoggedIntoGateway
loginRest :: Auth -> IO (RestChan, NotLoggedIntoGateway, [ThreadIdType])
loginRest auth = do
log <- newChan
logId <- forkIO (logger log False)
(restHandler, restId) <- createHandler auth log
pure (restHandler, NotLoggedIntoGateway, [ ThreadLogger logId
, ThreadRest restId
])
loginRestGateway :: Auth -> IO (RestChan, Gateway, [ThreadIdType])
loginRestGateway auth = do
log <- newChan
logId <- forkIO (logger log False)
(restHandler, restId) <- createHandler auth log
(gate, gateId) <- startGatewayThread auth log
pure (restHandler, gate, [ ThreadLogger logId
, ThreadRest restId
, ThreadGateway gateId
])
restCall :: (FromJSON a, Request (r a)) =>
(RestChan, y, z) -> r a -> IO (Either RestCallException a)
restCall (r,_,_) = writeRestCall r
nextEvent :: (x, Gateway, z) -> IO (Either GatewayException Event)
nextEvent (_,g,_) = readChan (_events g)
sendCommand :: (x, Gateway, z) -> GatewaySendable -> IO ()
sendCommand (_,g,_) e = case e of
Heartbeat _ -> pure ()
Identify _ _ _ _ -> pure ()
Resume _ _ _ -> pure ()
_ -> writeChan (_gatewayCommands g) e
readCache :: (RestChan, Gateway, z) -> IO (Either GatewayException Cache)
readCache (_,g,_) = readMVar (_cache g)
stopDiscord :: (x, y, [ThreadIdType]) -> IO ()
stopDiscord (_,_,is) = threadDelay (10^6 `div` 10) >> mapM_ (killThread . toId) is
where toId t = case t of
ThreadRest a -> a
ThreadGateway a -> a
ThreadLogger a -> a
logger :: Chan String -> Bool -> IO ()
logger log False = forever $ readChan log >>= \_ -> pure ()
logger log True = forever $ do
x <- readChan log
let line = x <> "\n\n"
appendFile "the-log-of-discord-haskell.txt" line