{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK prune, not-home #-}
module Discord.Rest
( module Discord.Types
, RestChan(..)
, Request(..)
, writeRestCall
, createHandler
, RestCallException(..)
) where
import Prelude hiding (log)
import Data.Either (fromRight)
import Data.Aeson (FromJSON, eitherDecode)
import Control.Concurrent.Chan
import Control.Concurrent.MVar
import Control.Concurrent (forkIO, ThreadId)
import qualified Data.ByteString.Lazy.Char8 as QL
import Discord.Types
import Discord.Rest.HTTP
newtype RestChan = RestChan (Chan (String, JsonRequest,
MVar (Either RestCallException QL.ByteString)))
createHandler :: Auth -> Chan String -> IO (RestChan, ThreadId)
createHandler auth log = do
c <- newChan
tid <- forkIO $ restLoop auth c log
pure (RestChan c, tid)
writeRestCall :: (Request (r a), FromJSON a) => RestChan -> r a -> IO (Either RestCallException a)
writeRestCall (RestChan c) req = do
m <- newEmptyMVar
writeChan c (majorRoute req, jsonRequest req, m)
r <- readMVar m
pure $ case eitherDecode <$> r of
Right (Right o) -> Right o
Right (Left er) -> Left (RestCallNoParse er (fromRight "" r))
Left e -> Left e