{-# LANGUAGE OverloadedStrings #-}

-- | Provides a rather raw interface to the websocket events
--   through a real-time Chan
module Discord.Internal.Gateway
  ( GatewayHandle(..)
  , CacheHandle(..)
  , GatewayException(..)
  , Cache(..)
  , startCacheThread
  , startGatewayThread
  , module Discord.Internal.Types
  ) where

import Prelude hiding (log)
import Control.Concurrent.Chan (newChan, dupChan, Chan)
import Control.Concurrent (forkIO, ThreadId, newEmptyMVar, MVar)
import Data.IORef (newIORef)
import qualified Data.Text as T

import Discord.Internal.Types (Auth, Event, GatewayIntent)
import Discord.Internal.Gateway.EventLoop (connectionLoop, GatewayHandle(..), GatewayException(..))
import Discord.Internal.Gateway.Cache (cacheLoop, Cache(..), CacheHandle(..))

startCacheThread :: Chan T.Text -> IO (CacheHandle, ThreadId)
startCacheThread :: Chan Text -> IO (CacheHandle, ThreadId)
startCacheThread Chan Text
log = do
  Chan (Either GatewayException Event)
events <- IO (Chan (Either GatewayException Event))
forall a. IO (Chan a)
newChan :: IO (Chan (Either GatewayException Event))
  MVar (Either (Cache, GatewayException) Cache)
cache <- IO (MVar (Either (Cache, GatewayException) Cache))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either (Cache, GatewayException) Cache))
  let cacheHandle :: CacheHandle
cacheHandle = Chan (Either GatewayException Event)
-> MVar (Either (Cache, GatewayException) Cache) -> CacheHandle
CacheHandle Chan (Either GatewayException Event)
events MVar (Either (Cache, GatewayException) Cache)
cache
  ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ CacheHandle -> Chan Text -> IO ()
cacheLoop CacheHandle
cacheHandle Chan Text
log
  (CacheHandle, ThreadId) -> IO (CacheHandle, ThreadId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CacheHandle
cacheHandle, ThreadId
tid)

-- | Create a Chan for websockets. This creates a thread that
--   writes all the received Events to the Chan
startGatewayThread :: Auth -> GatewayIntent -> CacheHandle -> Chan T.Text -> IO (GatewayHandle, ThreadId)
startGatewayThread :: Auth
-> GatewayIntent
-> CacheHandle
-> Chan Text
-> IO (GatewayHandle, ThreadId)
startGatewayThread Auth
auth GatewayIntent
intent CacheHandle
cacheHandle Chan Text
log = do
  Chan (Either GatewayException Event)
events <- Chan (Either GatewayException Event)
-> IO (Chan (Either GatewayException Event))
forall a. Chan a -> IO (Chan a)
dupChan (CacheHandle -> Chan (Either GatewayException Event)
cacheHandleEvents CacheHandle
cacheHandle)
  Chan GatewaySendable
sends <- IO (Chan GatewaySendable)
forall a. IO (Chan a)
newChan
  IORef (Maybe UpdateStatusOpts)
status <- Maybe UpdateStatusOpts -> IO (IORef (Maybe UpdateStatusOpts))
forall a. a -> IO (IORef a)
newIORef Maybe UpdateStatusOpts
forall a. Maybe a
Nothing
  IORef Integer
seqid <- Integer -> IO (IORef Integer)
forall a. a -> IO (IORef a)
newIORef Integer
0
  IORef Text
seshid <- Text -> IO (IORef Text)
forall a. a -> IO (IORef a)
newIORef Text
""
  let gatewayHandle :: GatewayHandle
gatewayHandle = Chan (Either GatewayException Event)
-> Chan GatewaySendable
-> IORef (Maybe UpdateStatusOpts)
-> IORef Integer
-> IORef Text
-> GatewayHandle
GatewayHandle Chan (Either GatewayException Event)
events Chan GatewaySendable
sends IORef (Maybe UpdateStatusOpts)
status IORef Integer
seqid IORef Text
seshid
  ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Auth -> GatewayIntent -> GatewayHandle -> Chan Text -> IO ()
connectionLoop Auth
auth GatewayIntent
intent GatewayHandle
gatewayHandle Chan Text
log
  (GatewayHandle, ThreadId) -> IO (GatewayHandle, ThreadId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GatewayHandle
gatewayHandle, ThreadId
tid)