{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Discord
  ( runDiscord
  , restCall
  , sendCommand
  , readCache
  , stopDiscord

  , DiscordHandler

  , DiscordHandle
  , Cache(..)
  , RestCallErrorCode(..)
  , RunDiscordOpts(..)
  , FromJSON
  , def
  ) where

import Prelude hiding (log)
import Control.Monad.Reader (ReaderT, runReaderT, void, ask, liftIO, forever)
import Data.Aeson (FromJSON)
import Data.Default (Default, def)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE

import UnliftIO (race, try, finally, SomeException, IOException)
import UnliftIO.Concurrent

import Discord.Handle
import Discord.Internal.Rest
import Discord.Internal.Rest.User (UserRequest(GetCurrentUser))
import Discord.Internal.Gateway

type DiscordHandler = ReaderT DiscordHandle IO

data RunDiscordOpts = RunDiscordOpts
  { RunDiscordOpts -> Text
discordToken :: T.Text
  , RunDiscordOpts -> DiscordHandler ()
discordOnStart :: DiscordHandler ()
  , RunDiscordOpts -> IO ()
discordOnEnd :: IO ()
  , RunDiscordOpts -> Event -> DiscordHandler ()
discordOnEvent :: Event -> DiscordHandler ()
  , RunDiscordOpts -> Text -> IO ()
discordOnLog :: T.Text -> IO ()
  , RunDiscordOpts -> Bool
discordForkThreadForEvents :: Bool
  }

instance Default RunDiscordOpts where
  def :: RunDiscordOpts
def = RunDiscordOpts :: Text
-> DiscordHandler ()
-> IO ()
-> (Event -> DiscordHandler ())
-> (Text -> IO ())
-> Bool
-> RunDiscordOpts
RunDiscordOpts { discordToken :: Text
discordToken = Text
""
                       , discordOnStart :: DiscordHandler ()
discordOnStart = () -> DiscordHandler ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                       , discordOnEnd :: IO ()
discordOnEnd = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                       , discordOnEvent :: Event -> DiscordHandler ()
discordOnEvent = \Event
_ -> () -> DiscordHandler ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                       , discordOnLog :: Text -> IO ()
discordOnLog = \Text
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                       , discordForkThreadForEvents :: Bool
discordForkThreadForEvents = Bool
True
                       }

runDiscord :: RunDiscordOpts -> IO T.Text
runDiscord :: RunDiscordOpts -> IO Text
runDiscord RunDiscordOpts
opts = do
  Chan Text
log <- IO (Chan Text)
forall (m :: * -> *) a. MonadIO m => m (Chan a)
newChan
  ThreadId
logId <- IO ThreadId -> IO ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> IO ThreadId) -> IO ThreadId -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ (Text -> IO ()) -> Chan Text -> IO ThreadId
startLogger (RunDiscordOpts -> Text -> IO ()
discordOnLog RunDiscordOpts
opts) Chan Text
log
  (DiscordHandleCache
cache, ThreadId
cacheId) <- IO (DiscordHandleCache, ThreadId)
-> IO (DiscordHandleCache, ThreadId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DiscordHandleCache, ThreadId)
 -> IO (DiscordHandleCache, ThreadId))
-> IO (DiscordHandleCache, ThreadId)
-> IO (DiscordHandleCache, ThreadId)
forall a b. (a -> b) -> a -> b
$ Chan Text -> IO (DiscordHandleCache, ThreadId)
startCacheThread Chan Text
log
  (DiscordHandleRestChan
rest, ThreadId
restId) <- IO (DiscordHandleRestChan, ThreadId)
-> IO (DiscordHandleRestChan, ThreadId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DiscordHandleRestChan, ThreadId)
 -> IO (DiscordHandleRestChan, ThreadId))
-> IO (DiscordHandleRestChan, ThreadId)
-> IO (DiscordHandleRestChan, ThreadId)
forall a b. (a -> b) -> a -> b
$ Auth -> Chan Text -> IO (DiscordHandleRestChan, ThreadId)
startRestThread (Text -> Auth
Auth (RunDiscordOpts -> Text
discordToken RunDiscordOpts
opts)) Chan Text
log
  (DiscordHandleGateway
gate, ThreadId
gateId) <- IO (DiscordHandleGateway, ThreadId)
-> IO (DiscordHandleGateway, ThreadId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DiscordHandleGateway, ThreadId)
 -> IO (DiscordHandleGateway, ThreadId))
-> IO (DiscordHandleGateway, ThreadId)
-> IO (DiscordHandleGateway, ThreadId)
forall a b. (a -> b) -> a -> b
$ Auth
-> DiscordHandleCache
-> Chan Text
-> IO (DiscordHandleGateway, ThreadId)
startGatewayThread (Text -> Auth
Auth (RunDiscordOpts -> Text
discordToken RunDiscordOpts
opts)) DiscordHandleCache
cache Chan Text
log

  MVar Text
libE <- IO (MVar Text)
forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar

  let handle :: DiscordHandle
handle = DiscordHandle :: DiscordHandleRestChan
-> DiscordHandleGateway
-> DiscordHandleCache
-> [DiscordHandleThreadId]
-> Chan Text
-> MVar Text
-> DiscordHandle
DiscordHandle { discordHandleRestChan :: DiscordHandleRestChan
discordHandleRestChan = DiscordHandleRestChan
rest
                             , discordHandleGateway :: DiscordHandleGateway
discordHandleGateway = DiscordHandleGateway
gate
                             , discordHandleCache :: DiscordHandleCache
discordHandleCache = DiscordHandleCache
cache
                             , discordHandleLog :: Chan Text
discordHandleLog = Chan Text
log
                             , discordHandleLibraryError :: MVar Text
discordHandleLibraryError = MVar Text
libE
                             , discordHandleThreads :: [DiscordHandleThreadId]
discordHandleThreads =
                                 [ ThreadId -> DiscordHandleThreadId
DiscordHandleThreadIdLogger ThreadId
logId
                                 , ThreadId -> DiscordHandleThreadId
DiscordHandleThreadIdRest ThreadId
restId
                                 , ThreadId -> DiscordHandleThreadId
DiscordHandleThreadIdCache ThreadId
cacheId
                                 , ThreadId -> DiscordHandleThreadId
DiscordHandleThreadIdGateway ThreadId
gateId
                                 ]
                             }

  IO Text -> IO () -> IO Text
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
finally (DiscordHandle -> RunDiscordOpts -> IO Text
runDiscordLoop DiscordHandle
handle RunDiscordOpts
opts)
          (RunDiscordOpts -> IO ()
discordOnEnd RunDiscordOpts
opts IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DiscordHandler () -> DiscordHandle -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT DiscordHandler ()
stopDiscord DiscordHandle
handle)

runDiscordLoop :: DiscordHandle -> RunDiscordOpts -> IO T.Text
runDiscordLoop :: DiscordHandle -> RunDiscordOpts -> IO Text
runDiscordLoop DiscordHandle
handle RunDiscordOpts
opts = do
  Either RestCallInternalException User
resp <- IO (Either RestCallInternalException User)
-> IO (Either RestCallInternalException User)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either RestCallInternalException User)
 -> IO (Either RestCallInternalException User))
-> IO (Either RestCallInternalException User)
-> IO (Either RestCallInternalException User)
forall a b. (a -> b) -> a -> b
$ DiscordHandleRestChan
-> UserRequest User -> IO (Either RestCallInternalException User)
forall (r :: * -> *) a.
(Request (r a), FromJSON a) =>
DiscordHandleRestChan
-> r a -> IO (Either RestCallInternalException a)
writeRestCall (DiscordHandle -> DiscordHandleRestChan
discordHandleRestChan DiscordHandle
handle) UserRequest User
GetCurrentUser
  case Either RestCallInternalException User
resp of
    Left (RestCallInternalErrorCode Int
c ByteString
e1 ByteString
e2) -> Text -> IO Text
libError (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$
             Text
"HTTP Error Code " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
TE.decodeUtf8 ByteString
e1
                                                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
TE.decodeUtf8 ByteString
e2
    Left (RestCallInternalHttpException HttpException
e) -> Text -> IO Text
libError (Text
"HTTP Exception -  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (HttpException -> String
forall a. Show a => a -> String
show HttpException
e))
    Left (RestCallInternalNoParse String
_ ByteString
_) -> Text -> IO Text
libError Text
"Couldn't parse GetCurrentUser"
    Either RestCallInternalException User
_ -> do Either SomeException ()
me <- IO (Either SomeException ()) -> IO (Either SomeException ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException ()) -> IO (Either SomeException ()))
-> (DiscordHandle -> IO (Either SomeException ()))
-> DiscordHandle
-> IO (Either SomeException ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT DiscordHandle IO (Either SomeException ())
-> DiscordHandle -> IO (Either SomeException ())
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (DiscordHandler ()
-> ReaderT DiscordHandle IO (Either SomeException ())
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (DiscordHandler ()
 -> ReaderT DiscordHandle IO (Either SomeException ()))
-> DiscordHandler ()
-> ReaderT DiscordHandle IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ RunDiscordOpts -> DiscordHandler ()
discordOnStart RunDiscordOpts
opts) (DiscordHandle -> IO (Either SomeException ()))
-> DiscordHandle -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ DiscordHandle
handle
            case Either SomeException ()
me of
              Left (SomeException
e :: SomeException) -> Text -> IO Text
libError (Text
"discordOnStart handler stopped on an exception:\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
e))
              Right ()
_ -> IO Text
loop
 where
   libError :: T.Text -> IO T.Text
   libError :: Text -> IO Text
libError Text
msg = MVar Text -> Text -> IO Bool
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m Bool
tryPutMVar (DiscordHandle -> MVar Text
discordHandleLibraryError DiscordHandle
handle) Text
msg IO Bool -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
msg

   gateChan :: DiscordHandleGateway -> Chan (Either GatewayException Event)
   gateChan :: DiscordHandleGateway -> Chan (Either GatewayException Event)
gateChan (Chan (Either GatewayException Event)
a, Chan GatewaySendable
_, IORef (Maybe UpdateStatusOpts)
_) = Chan (Either GatewayException Event)
a -- only used right below in loop

   loop :: IO T.Text
   loop :: IO Text
loop = do Either Text (Either GatewayException Event)
next <- IO Text
-> IO (Either GatewayException Event)
-> IO (Either Text (Either GatewayException Event))
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> m b -> m (Either a b)
race (MVar Text -> IO Text
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar (DiscordHandle -> MVar Text
discordHandleLibraryError DiscordHandle
handle))
                          (Chan (Either GatewayException Event)
-> IO (Either GatewayException Event)
forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan (DiscordHandleGateway -> Chan (Either GatewayException Event)
gateChan (DiscordHandle -> DiscordHandleGateway
discordHandleGateway DiscordHandle
handle)))
             case Either Text (Either GatewayException Event)
next of
               Left Text
err -> Text -> IO Text
libError Text
err
               Right (Right Event
event) -> do
                 let action :: IO () -> IO ()
action = if RunDiscordOpts -> Bool
discordForkThreadForEvents RunDiscordOpts
opts then IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> (IO () -> IO ThreadId) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO
                                                                 else IO () -> IO ()
forall a. a -> a
id
                 IO () -> IO ()
action (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do Either SomeException ()
me <- IO (Either SomeException ()) -> IO (Either SomeException ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException ()) -> IO (Either SomeException ()))
-> (DiscordHandle -> IO (Either SomeException ()))
-> DiscordHandle
-> IO (Either SomeException ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT DiscordHandle IO (Either SomeException ())
-> DiscordHandle -> IO (Either SomeException ())
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (DiscordHandler ()
-> ReaderT DiscordHandle IO (Either SomeException ())
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (DiscordHandler ()
 -> ReaderT DiscordHandle IO (Either SomeException ()))
-> DiscordHandler ()
-> ReaderT DiscordHandle IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ RunDiscordOpts -> Event -> DiscordHandler ()
discordOnEvent RunDiscordOpts
opts Event
event) (DiscordHandle -> IO (Either SomeException ()))
-> DiscordHandle -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ DiscordHandle
handle
                             case Either SomeException ()
me of
                               Left (SomeException
e :: SomeException) -> Chan Text -> Text -> IO ()
forall (m :: * -> *) a. MonadIO m => Chan a -> a -> m ()
writeChan (DiscordHandle -> Chan Text
discordHandleLog DiscordHandle
handle)
                                         (Text
"discord-haskell stopped on an exception:\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
e))
                               Right ()
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                 IO Text
loop
               Right (Left GatewayException
err) -> Text -> IO Text
libError (String -> Text
T.pack (GatewayException -> String
forall a. Show a => a -> String
show GatewayException
err))


data RestCallErrorCode = RestCallErrorCode Int T.Text T.Text
  deriving (Int -> RestCallErrorCode -> ShowS
[RestCallErrorCode] -> ShowS
RestCallErrorCode -> String
(Int -> RestCallErrorCode -> ShowS)
-> (RestCallErrorCode -> String)
-> ([RestCallErrorCode] -> ShowS)
-> Show RestCallErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestCallErrorCode] -> ShowS
$cshowList :: [RestCallErrorCode] -> ShowS
show :: RestCallErrorCode -> String
$cshow :: RestCallErrorCode -> String
showsPrec :: Int -> RestCallErrorCode -> ShowS
$cshowsPrec :: Int -> RestCallErrorCode -> ShowS
Show, RestCallErrorCode -> RestCallErrorCode -> Bool
(RestCallErrorCode -> RestCallErrorCode -> Bool)
-> (RestCallErrorCode -> RestCallErrorCode -> Bool)
-> Eq RestCallErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RestCallErrorCode -> RestCallErrorCode -> Bool
$c/= :: RestCallErrorCode -> RestCallErrorCode -> Bool
== :: RestCallErrorCode -> RestCallErrorCode -> Bool
$c== :: RestCallErrorCode -> RestCallErrorCode -> Bool
Eq, Eq RestCallErrorCode
Eq RestCallErrorCode
-> (RestCallErrorCode -> RestCallErrorCode -> Ordering)
-> (RestCallErrorCode -> RestCallErrorCode -> Bool)
-> (RestCallErrorCode -> RestCallErrorCode -> Bool)
-> (RestCallErrorCode -> RestCallErrorCode -> Bool)
-> (RestCallErrorCode -> RestCallErrorCode -> Bool)
-> (RestCallErrorCode -> RestCallErrorCode -> RestCallErrorCode)
-> (RestCallErrorCode -> RestCallErrorCode -> RestCallErrorCode)
-> Ord RestCallErrorCode
RestCallErrorCode -> RestCallErrorCode -> Bool
RestCallErrorCode -> RestCallErrorCode -> Ordering
RestCallErrorCode -> RestCallErrorCode -> RestCallErrorCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RestCallErrorCode -> RestCallErrorCode -> RestCallErrorCode
$cmin :: RestCallErrorCode -> RestCallErrorCode -> RestCallErrorCode
max :: RestCallErrorCode -> RestCallErrorCode -> RestCallErrorCode
$cmax :: RestCallErrorCode -> RestCallErrorCode -> RestCallErrorCode
>= :: RestCallErrorCode -> RestCallErrorCode -> Bool
$c>= :: RestCallErrorCode -> RestCallErrorCode -> Bool
> :: RestCallErrorCode -> RestCallErrorCode -> Bool
$c> :: RestCallErrorCode -> RestCallErrorCode -> Bool
<= :: RestCallErrorCode -> RestCallErrorCode -> Bool
$c<= :: RestCallErrorCode -> RestCallErrorCode -> Bool
< :: RestCallErrorCode -> RestCallErrorCode -> Bool
$c< :: RestCallErrorCode -> RestCallErrorCode -> Bool
compare :: RestCallErrorCode -> RestCallErrorCode -> Ordering
$ccompare :: RestCallErrorCode -> RestCallErrorCode -> Ordering
$cp1Ord :: Eq RestCallErrorCode
Ord)

-- | Execute one http request and get a response
restCall :: (FromJSON a, Request (r a)) => r a -> DiscordHandler (Either RestCallErrorCode a)
restCall :: r a -> DiscordHandler (Either RestCallErrorCode a)
restCall r a
r = do DiscordHandle
h <- ReaderT DiscordHandle IO DiscordHandle
forall r (m :: * -> *). MonadReader r m => m r
ask
                Bool
empty <- MVar Text -> ReaderT DiscordHandle IO Bool
forall (m :: * -> *) a. MonadIO m => MVar a -> m Bool
isEmptyMVar (DiscordHandle -> MVar Text
discordHandleLibraryError DiscordHandle
h)
                if Bool -> Bool
not Bool
empty
                then Either RestCallErrorCode a
-> DiscordHandler (Either RestCallErrorCode a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RestCallErrorCode -> Either RestCallErrorCode a
forall a b. a -> Either a b
Left (Int -> Text -> Text -> RestCallErrorCode
RestCallErrorCode Int
400 Text
"Library Stopped Working" Text
""))
                else do
                    Either RestCallInternalException a
resp <- IO (Either RestCallInternalException a)
-> ReaderT DiscordHandle IO (Either RestCallInternalException a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either RestCallInternalException a)
 -> ReaderT DiscordHandle IO (Either RestCallInternalException a))
-> IO (Either RestCallInternalException a)
-> ReaderT DiscordHandle IO (Either RestCallInternalException a)
forall a b. (a -> b) -> a -> b
$ DiscordHandleRestChan
-> r a -> IO (Either RestCallInternalException a)
forall (r :: * -> *) a.
(Request (r a), FromJSON a) =>
DiscordHandleRestChan
-> r a -> IO (Either RestCallInternalException a)
writeRestCall (DiscordHandle -> DiscordHandleRestChan
discordHandleRestChan DiscordHandle
h) r a
r
                    case Either RestCallInternalException a
resp of
                      Right a
x -> Either RestCallErrorCode a
-> DiscordHandler (Either RestCallErrorCode a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either RestCallErrorCode a
forall a b. b -> Either a b
Right a
x)
                      Left (RestCallInternalErrorCode Int
c ByteString
e1 ByteString
e2) ->
                        Either RestCallErrorCode a
-> DiscordHandler (Either RestCallErrorCode a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RestCallErrorCode -> Either RestCallErrorCode a
forall a b. a -> Either a b
Left (Int -> Text -> Text -> RestCallErrorCode
RestCallErrorCode Int
c (ByteString -> Text
TE.decodeUtf8 ByteString
e1) (ByteString -> Text
TE.decodeUtf8 ByteString
e2)))
                      Left (RestCallInternalHttpException HttpException
_) ->
                        Int -> DiscordHandler ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int)) DiscordHandler ()
-> DiscordHandler (Either RestCallErrorCode a)
-> DiscordHandler (Either RestCallErrorCode a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> r a -> DiscordHandler (Either RestCallErrorCode a)
forall a (r :: * -> *).
(FromJSON a, Request (r a)) =>
r a -> DiscordHandler (Either RestCallErrorCode a)
restCall r a
r
                      Left (RestCallInternalNoParse String
err ByteString
dat) -> do
                        let formaterr :: Text
formaterr = String -> Text
T.pack (String
"Parse Exception " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
dat)
                        Chan Text -> Text -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => Chan a -> a -> m ()
writeChan (DiscordHandle -> Chan Text
discordHandleLog DiscordHandle
h) Text
formaterr
                        Either RestCallErrorCode a
-> DiscordHandler (Either RestCallErrorCode a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RestCallErrorCode -> Either RestCallErrorCode a
forall a b. a -> Either a b
Left (Int -> Text -> Text -> RestCallErrorCode
RestCallErrorCode Int
400 Text
"Library Stopped Working" Text
formaterr))

-- | Send a GatewaySendable, but not Heartbeat, Identify, or Resume
sendCommand :: GatewaySendable -> DiscordHandler ()
sendCommand :: GatewaySendable -> DiscordHandler ()
sendCommand GatewaySendable
e = do
  DiscordHandle
h <- ReaderT DiscordHandle IO DiscordHandle
forall r (m :: * -> *). MonadReader r m => m r
ask
  case GatewaySendable
e of
    Heartbeat Integer
_ -> () -> DiscordHandler ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Identify {} -> () -> DiscordHandler ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Resume {} -> () -> DiscordHandler ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    GatewaySendable
_ -> let sendChan :: (a, b, c) -> b
sendChan (a
_, b
b, c
_) = b
b
         in Chan GatewaySendable -> GatewaySendable -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => Chan a -> a -> m ()
writeChan (DiscordHandleGateway -> Chan GatewaySendable
forall a b c. (a, b, c) -> b
sendChan (DiscordHandle -> DiscordHandleGateway
discordHandleGateway DiscordHandle
h)) GatewaySendable
e

-- | Access the current state of the gateway cache
readCache :: DiscordHandler Cache
readCache :: DiscordHandler Cache
readCache = do
  DiscordHandle
h <- ReaderT DiscordHandle IO DiscordHandle
forall r (m :: * -> *). MonadReader r m => m r
ask
  Either (Cache, GatewayException) Cache
merr <- MVar (Either (Cache, GatewayException) Cache)
-> ReaderT
     DiscordHandle IO (Either (Cache, GatewayException) Cache)
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar (DiscordHandleCache -> MVar (Either (Cache, GatewayException) Cache)
forall a b. (a, b) -> b
snd (DiscordHandle -> DiscordHandleCache
discordHandleCache DiscordHandle
h))
  case Either (Cache, GatewayException) Cache
merr of
    Left (Cache
c, GatewayException
_) -> Cache -> DiscordHandler Cache
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cache
c
    Right Cache
c -> Cache -> DiscordHandler Cache
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cache
c


-- | Stop all the background threads
stopDiscord :: DiscordHandler ()
stopDiscord :: DiscordHandler ()
stopDiscord = do DiscordHandle
h <- ReaderT DiscordHandle IO DiscordHandle
forall r (m :: * -> *). MonadReader r m => m r
ask
                 Bool
_ <- MVar Text -> Text -> ReaderT DiscordHandle IO Bool
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m Bool
tryPutMVar (DiscordHandle -> MVar Text
discordHandleLibraryError DiscordHandle
h) Text
"Library has closed"
                 Int -> DiscordHandler ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int
10Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10)
                 (DiscordHandleThreadId -> DiscordHandler ())
-> [DiscordHandleThreadId] -> DiscordHandler ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ThreadId -> DiscordHandler ()
forall (m :: * -> *). MonadIO m => ThreadId -> m ()
killThread (ThreadId -> DiscordHandler ())
-> (DiscordHandleThreadId -> ThreadId)
-> DiscordHandleThreadId
-> DiscordHandler ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiscordHandleThreadId -> ThreadId
toId) (DiscordHandle -> [DiscordHandleThreadId]
discordHandleThreads DiscordHandle
h)
  where toId :: DiscordHandleThreadId -> ThreadId
toId DiscordHandleThreadId
t = case DiscordHandleThreadId
t of
                   DiscordHandleThreadIdRest ThreadId
a -> ThreadId
a
                   DiscordHandleThreadIdGateway ThreadId
a -> ThreadId
a
                   DiscordHandleThreadIdCache ThreadId
a -> ThreadId
a
                   DiscordHandleThreadIdLogger ThreadId
a -> ThreadId
a

startLogger :: (T.Text -> IO ()) -> Chan T.Text -> IO ThreadId
startLogger :: (Text -> IO ()) -> Chan Text -> IO ThreadId
startLogger Text -> IO ()
handle Chan Text
logC = IO () -> IO ThreadId
forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
  do Either IOException ()
me <- IO () -> IO (Either IOException ())
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ Chan Text -> IO Text
forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan Chan Text
logC IO Text -> (Text -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> IO ()
handle
     case Either IOException ()
me of
       Right ()
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
       Left (IOException
_ :: IOException) ->
         -- writeChan logC "Log handler failed"
         () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()