summaryrefslogtreecommitdiff
path: root/deps/discord-haskell/src/Discord.hs
diff options
context:
space:
mode:
authorLLLL Colonq <llll@colonq>2024-01-11 20:42:57 -0500
committerLLLL Colonq <llll@colonq>2024-01-11 20:42:57 -0500
commitae18b594c97782cc201ffa365f12064831b1ec93 (patch)
tree5570a7f8ab15a113f332839b900c2c47444e7314 /deps/discord-haskell/src/Discord.hs
parent0be357bb60a2bc4523056aba34add78b715211f5 (diff)
Handle stickers, properly handle exceptions in threads
Diffstat (limited to 'deps/discord-haskell/src/Discord.hs')
-rw-r--r--deps/discord-haskell/src/Discord.hs28
1 files changed, 16 insertions, 12 deletions
diff --git a/deps/discord-haskell/src/Discord.hs b/deps/discord-haskell/src/Discord.hs
index 5ed8bcf..7470c50 100644
--- a/deps/discord-haskell/src/Discord.hs
+++ b/deps/discord-haskell/src/Discord.hs
@@ -26,7 +26,8 @@ module Discord
import Prelude hiding (log)
import Control.Exception (Exception)
-import Control.Monad.Reader (ReaderT, runReaderT, void, ask, liftIO, forever, asks)
+import Control.Monad (void, forever)
+import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO, asks)
import Data.Aeson (FromJSON)
import Data.Default (Default, def)
import Data.IORef (writeIORef)
@@ -41,6 +42,7 @@ import Discord.Handle
import Discord.Internal.Rest
import Discord.Internal.Rest.User (UserRequest(GetCurrentUser))
import Discord.Internal.Gateway
+import qualified Discord.Requests as R
-- | A `ReaderT` wrapper around `DiscordHandle` and `IO`. Most functions act in
-- this monad
@@ -115,18 +117,24 @@ runDiscord opts = do
-- | Runs the main loop
runDiscordLoop :: DiscordHandle -> RunDiscordOpts -> IO T.Text
runDiscordLoop handle opts = do
- resp <- liftIO $ writeRestCall (discordHandleRestChan handle) GetCurrentUser
+ resp <- startupRestCalls
case resp of
Left (RestCallInternalErrorCode c e1 e2) -> libError $
"HTTP Error Code " <> T.pack (show c) <> " " <> TE.decodeUtf8 e1
<> " " <> TE.decodeUtf8 e2
Left (RestCallInternalHttpException e) -> libError ("HTTP Exception - " <> T.pack (show e))
- Left (RestCallInternalNoParse _ _) -> libError "Couldn't parse GetCurrentUser"
- _ -> do me <- liftIO . runReaderT (try $ discordOnStart opts) $ handle
- case me of
- Left (e :: SomeException) -> libError ("discordOnStart handler stopped on an exception:\n\n" <> T.pack (show e))
- Right _ -> loop
+ Left (RestCallInternalNoParse e _) -> libError ("Couldn't parse initial bot info - " <> T.pack e)
+ Right (user, app) -> do initializeCache user app (discordHandleCache handle)
+ me <- liftIO . runReaderT (try $ discordOnStart opts) $ handle
+ case me of
+ Left (e :: SomeException) -> libError ("discordOnStart handler stopped on an exception:\n\n" <> T.pack (show e))
+ Right _ -> loop
where
+ startupRestCalls :: IO (Either RestCallInternalException (User, FullApplication))
+ startupRestCalls = do eUser <- writeRestCall (discordHandleRestChan handle) R.GetCurrentUser
+ eApp <- writeRestCall (discordHandleRestChan handle) R.GetCurrentApplication
+ pure $ (,) <$> eUser <*> eApp
+
libError :: T.Text -> IO T.Text
libError msg = tryPutMVar (discordHandleLibraryError handle) msg >> pure msg
@@ -187,11 +195,7 @@ sendCommand e = do
readCache :: DiscordHandler Cache
readCache = do
h <- ask
- merr <- readMVar (cacheHandleCache (discordHandleCache h))
- case merr of
- Left (c, _) -> pure c
- Right c -> pure c
-
+ readMVar (cacheHandleCache (discordHandleCache h))
-- | Stop all the background threads
stopDiscord :: DiscordHandler ()