{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Discord.Internal.Rest
( module Discord.Internal.Types
, RestChanHandle(..)
, Request(..)
, writeRestCall
, startRestThread
, RestCallInternalException(..)
) where
import Prelude hiding (log)
import Data.Aeson (FromJSON, eitherDecode)
import Control.Concurrent.Chan
import Control.Concurrent.MVar
import Control.Concurrent (forkIO, ThreadId)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import Discord.Internal.Types
import Discord.Internal.Rest.HTTP
data RestChanHandle = RestChanHandle
{ RestChanHandle
-> Chan
(String, JsonRequest,
MVar (Either RestCallInternalException ByteString))
restHandleChan :: Chan (String, JsonRequest, MVar (Either RestCallInternalException BL.ByteString))
}
startRestThread :: Auth -> Chan T.Text -> IO (RestChanHandle, ThreadId)
startRestThread :: Auth -> Chan Text -> IO (RestChanHandle, ThreadId)
startRestThread Auth
auth Chan Text
log = do
Chan
(String, JsonRequest,
MVar (Either RestCallInternalException ByteString))
c <- IO
(Chan
(String, JsonRequest,
MVar (Either RestCallInternalException ByteString)))
forall a. IO (Chan a)
newChan
ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Auth
-> Chan
(String, JsonRequest,
MVar (Either RestCallInternalException ByteString))
-> Chan Text
-> IO ()
restLoop Auth
auth Chan
(String, JsonRequest,
MVar (Either RestCallInternalException ByteString))
c Chan Text
log
(RestChanHandle, ThreadId) -> IO (RestChanHandle, ThreadId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chan
(String, JsonRequest,
MVar (Either RestCallInternalException ByteString))
-> RestChanHandle
RestChanHandle Chan
(String, JsonRequest,
MVar (Either RestCallInternalException ByteString))
c, ThreadId
tid)
writeRestCall :: (Request (r a), FromJSON a) => RestChanHandle -> r a -> IO (Either RestCallInternalException a)
writeRestCall :: RestChanHandle -> r a -> IO (Either RestCallInternalException a)
writeRestCall RestChanHandle
c r a
req = do
MVar (Either RestCallInternalException ByteString)
m <- IO (MVar (Either RestCallInternalException ByteString))
forall a. IO (MVar a)
newEmptyMVar
Chan
(String, JsonRequest,
MVar (Either RestCallInternalException ByteString))
-> (String, JsonRequest,
MVar (Either RestCallInternalException ByteString))
-> IO ()
forall a. Chan a -> a -> IO ()
writeChan (RestChanHandle
-> Chan
(String, JsonRequest,
MVar (Either RestCallInternalException ByteString))
restHandleChan RestChanHandle
c) (r a -> String
forall a. Request a => a -> String
majorRoute r a
req, r a -> JsonRequest
forall a. Request a => a -> JsonRequest
jsonRequest r a
req, MVar (Either RestCallInternalException ByteString)
m)
Either RestCallInternalException ByteString
r <- MVar (Either RestCallInternalException ByteString)
-> IO (Either RestCallInternalException ByteString)
forall a. MVar a -> IO a
readMVar MVar (Either RestCallInternalException ByteString)
m
Either RestCallInternalException a
-> IO (Either RestCallInternalException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RestCallInternalException a
-> IO (Either RestCallInternalException a))
-> Either RestCallInternalException a
-> IO (Either RestCallInternalException a)
forall a b. (a -> b) -> a -> b
$ case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String a)
-> Either RestCallInternalException ByteString
-> Either RestCallInternalException (Either String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either RestCallInternalException ByteString
r of
Right (Right a
o) -> a -> Either RestCallInternalException a
forall a b. b -> Either a b
Right a
o
(Right (Left String
er)) -> RestCallInternalException -> Either RestCallInternalException a
forall a b. a -> Either a b
Left (String -> ByteString -> RestCallInternalException
RestCallInternalNoParse String
er (case Either RestCallInternalException ByteString
r of
Right ByteString
x -> ByteString
x
Left RestCallInternalException
_ -> ByteString
""))
Left RestCallInternalException
e -> RestCallInternalException -> Either RestCallInternalException a
forall a b. a -> Either a b
Left RestCallInternalException
e