calamity 0.7.1.0 → 0.8.0.0

raw patch · 91 files changed

+1180/−1108 lines, 91 filesdep −PyFPVP ok

version bump matches the API change (PVP)

Dependencies removed: PyF

API changes (from Hackage documentation)

Files

• Calamity.hs +12/−11
• Calamity/Cache/Eff.hs +42/−45
• Calamity/Cache/InMemory.hs +10/−9
• Calamity/Client.hs +43/−41
• Calamity/Client/Client.hs +21/−16
• Calamity/Client/ShardManager.hs +4/−5
• Calamity/Client/Types.hs +18/−18
• Calamity/Commands.hs +9/−9
• Calamity/Commands/CalamityParsers.hs +6/−6
• Calamity/Commands/Context.hs +42/−42
• Calamity/Commands/Dsl.hs +7/−9
• Calamity/Commands/Help.hs +2/−2
• Calamity/Commands/Types.hs +13/−13
• Calamity/Commands/Utils.hs +53/−49
• Calamity/Gateway.hs +22/−21
• Calamity/Gateway/DispatchEvents.hs +2/−1
• Calamity/Gateway/Intents.hs +18/−18
• Calamity/Gateway/Shard.hs +21/−25
• Calamity/Gateway/Types.hs +33/−6
• Calamity/HTTP.hs +27/−25
• Calamity/HTTP/Channel.hs +4/−5
• Calamity/HTTP/Emoji.hs +2/−1
• Calamity/HTTP/Guild.hs +3/−2
• Calamity/HTTP/Interaction.hs +6/−6
• Calamity/HTTP/Internal/Ratelimit.hs +36/−41
• Calamity/HTTP/Internal/Request.hs +5/−5
• Calamity/HTTP/Internal/Route.hs +7/−7
• Calamity/HTTP/Internal/Types.hs +52/−48
• Calamity/HTTP/Invite.hs +2/−0
• Calamity/HTTP/Reason.hs +1/−2
• Calamity/HTTP/User.hs +7/−5
• Calamity/HTTP/Webhook.hs +7/−7
• Calamity/Interactions.hs +1/−1
• Calamity/Interactions/Eff.hs +2/−3
• Calamity/Interactions/Utils.hs +18/−12
• Calamity/Interactions/View.hs +21/−20
• Calamity/Internal/BoundedStore.hs +7/−6
• Calamity/Internal/ConstructorName.hs +5/−4
• Calamity/Internal/IntColour.hs +4/−0
• Calamity/Internal/LocalWriter.hs +19/−15
• Calamity/Internal/RunIntoIO.hs +7/−8
• Calamity/Internal/SnowflakeMap.hs +2/−2
• Calamity/Internal/UnixTimestamp.hs +36/−36
• Calamity/Internal/Utils.hs +5/−5
• Calamity/Metrics/Eff.hs +1/−1
• Calamity/Metrics/Internal.hs +5/−4
• Calamity/Metrics/Noop.hs +11/−13
• Calamity/Types/CDNAsset.hs +8/−8
• Calamity/Types/LogEff.hs +2/−2
• Calamity/Types/Model/Avatar.hs +1/−1
• Calamity/Types/Model/Channel.hs +1/−1
• Calamity/Types/Model/Channel/Attachment.hs +1/−1
• Calamity/Types/Model/Channel/ChannelType.hs +1/−1
• Calamity/Types/Model/Channel/Component.hs +34/−35
• Calamity/Types/Model/Channel/DM.hs +2/−2
• Calamity/Types/Model/Channel/Embed.hs +2/−2
• Calamity/Types/Model/Channel/Group.hs +2/−2
• Calamity/Types/Model/Channel/Guild.hs +1/−1
• Calamity/Types/Model/Channel/Guild/Category.hs +1/−1
• Calamity/Types/Model/Channel/Guild/Text.hs +2/−2
• Calamity/Types/Model/Channel/Guild/Voice.hs +1/−1
• Calamity/Types/Model/Channel/Message.hs +6/−4
• Calamity/Types/Model/Channel/Reaction.hs +1/−1
• Calamity/Types/Model/Channel/UpdatedMessage.hs +3/−3
• Calamity/Types/Model/Channel/Webhook.hs +1/−1
• Calamity/Types/Model/Guild/AuditLog.hs +2/−2
• Calamity/Types/Model/Guild/Ban.hs +1/−1
• Calamity/Types/Model/Guild/Emoji.hs +4/−4
• Calamity/Types/Model/Guild/Emoji.hs-boot +0/−13
• Calamity/Types/Model/Guild/Guild.hs +8/−7
• Calamity/Types/Model/Guild/Invite.hs +2/−2
• Calamity/Types/Model/Guild/Member.hs +3/−3
• Calamity/Types/Model/Guild/Overwrite.hs +1/−1
• Calamity/Types/Model/Guild/Role.hs +6/−5
• Calamity/Types/Model/Guild/Role.hs-boot +16/−0
• Calamity/Types/Model/Guild/UnavailableGuild.hs +1/−1
• Calamity/Types/Model/Interaction.hs +5/−5
• Calamity/Types/Model/Presence/Activity.hs +2/−2
• Calamity/Types/Model/Presence/Presence.hs +1/−1
• Calamity/Types/Model/User.hs +4/−4
• Calamity/Types/Model/Voice/VoiceRegion.hs +9/−9
• Calamity/Types/Model/Voice/VoiceState.hs +1/−1
• Calamity/Types/Snowflake.hs +2/−2
• Calamity/Types/Tellable.hs +4/−4
• Calamity/Types/Upgradeable.hs +38/−34
• Calamity/Utils.hs +8/−7
• Calamity/Utils/CDNUrl.hs +5/−4
• Calamity/Utils/Colour.hs +11/−9
• Calamity/Utils/Message.hs +5/−4
• Calamity/Utils/Permissions.hs +60/−55
• calamity.cabal +230/−229

@@ -1,12 +1,13 @@-module Calamity-    ( module Calamity.Client-    , module Calamity.HTTP-    , module Calamity.Types-    , module Calamity.Utils-    , module Calamity.Gateway.Intents ) where+module Calamity (+  module Calamity.Client,+  module Calamity.HTTP,+  module Calamity.Types,+  module Calamity.Utils,+  module Calamity.Gateway.Intents,+) where -import           Calamity.Client-import           Calamity.Gateway.Intents-import           Calamity.HTTP-import           Calamity.Types-import           Calamity.Utils+import Calamity.Client+import Calamity.Gateway.Intents+import Calamity.HTTP+import Calamity.Types+import Calamity.Utils

@@ -1,55 +1,55 @@ {-# LANGUAGE TemplateHaskell #-}  -- | Effect for handling the cache-module Calamity.Cache.Eff-    ( CacheEff(..)-    , setBotUser-    , updateBotUser-    , getBotUser-    , setGuild-    , updateGuild-    , getGuild-    , getGuildChannel-    , getGuilds-    , delGuild-    , setDM-    , updateDM-    , getDM-    , getDMs-    , delDM-      -- , setGuildChannel-      -- , getGuildChannel-      -- , delGuildChannel-    , setUser-    , updateUser-    , getUser-    , getUsers-    , delUser-    , setUnavailableGuild-    , isUnavailableGuild-    , getUnavailableGuilds-    , delUnavailableGuild-    , setMessage-    , updateMessage-    , getMessage-    , getMessages-    , delMessage ) where+module Calamity.Cache.Eff (+  CacheEff (..),+  setBotUser,+  updateBotUser,+  getBotUser,+  setGuild,+  updateGuild,+  getGuild,+  getGuildChannel,+  getGuilds,+  delGuild,+  setDM,+  updateDM,+  getDM,+  getDMs,+  delDM,+  -- , setGuildChannel+  -- , getGuildChannel+  -- , delGuildChannel+  setUser,+  updateUser,+  getUser,+  getUsers,+  delUser,+  setUnavailableGuild,+  isUnavailableGuild,+  getUnavailableGuilds,+  delUnavailableGuild,+  setMessage,+  updateMessage,+  getMessage,+  getMessages,+  delMessage,+) where -import           Calamity.Internal.Utils-import           Calamity.Types.Model.Channel-import           Calamity.Types.Model.Guild-import           Calamity.Types.Model.User-import           Calamity.Types.Snowflake+import Calamity.Internal.Utils+import Calamity.Types.Model.Channel+import Calamity.Types.Model.Guild+import Calamity.Types.Model.User+import Calamity.Types.Snowflake -import           Polysemy-import qualified Polysemy                     as P+import Polysemy+import Polysemy qualified as P  data CacheEff m a where   -- | Set the 'User' representing the bot itself   SetBotUser :: User -> CacheEff m ()   -- | Get the 'User' representing the bot itself   GetBotUser :: CacheEff m (Maybe User)-   -- | Set or Update a 'Guild' in the cache   SetGuild :: Guild -> CacheEff m ()   -- | Get a 'Guild' from the cache@@ -60,7 +60,6 @@   GetGuilds :: CacheEff m [Guild]   -- | Delete a 'Guild' from the cache   DelGuild :: Snowflake Guild -> CacheEff m ()-   -- | Set or Update a 'DMChannel' in the cache   SetDM :: DMChannel -> CacheEff m ()   -- | Get a 'DMChannel' from the cache@@ -69,13 +68,13 @@   GetDMs :: CacheEff m [DMChannel]   -- | Delete a 'DMChannel' from the cache   DelDM :: Snowflake DMChannel -> CacheEff m ()-   -- -- | Set or Update a 'GuildChannel' in the cache   -- SetGuildChannel :: GuildChannel -> CacheEff m ()   -- -- | Get a 'GuildChannel' from the cache   -- GetGuildChannel :: Snowflake GuildChannel -> CacheEff m (Maybe GuildChannel)   -- -- | Delete a 'GuildChannel' from the cache   -- DelGuildChannel :: Snowflake GuildChannel -> CacheEff m ()+   -- | Set or Update a 'User' in the cache   SetUser :: User -> CacheEff m ()   -- | Get a 'User' from the cache@@ -84,7 +83,6 @@   GetUsers :: CacheEff m [User]   -- | Delete a 'User' from the cache   DelUser :: Snowflake User -> CacheEff m ()-   -- | Flag a 'Guild' as unavailable   SetUnavailableGuild :: Snowflake Guild -> CacheEff m ()   -- | Test if a 'Guild' is flagged as unavailable@@ -93,7 +91,6 @@   GetUnavailableGuilds :: CacheEff m [Snowflake Guild]   -- | Unflag a 'Guild' from being unavailable   DelUnavailableGuild :: Snowflake Guild -> CacheEff m ()-   -- | Add or Update a 'Message' in the cache   SetMessage :: Message -> CacheEff m ()   -- | Get a 'Message' from the cache

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}  -- | A 'Cache' handler that operates in memory module Calamity.Cache.InMemory (@@ -8,24 +9,24 @@ ) where  import Calamity.Cache.Eff-import qualified Calamity.Internal.BoundedStore as BS-import qualified Calamity.Internal.SnowflakeMap as SM+import Calamity.Internal.BoundedStore qualified as BS+import Calamity.Internal.SnowflakeMap qualified as SM import Calamity.Internal.Utils import Calamity.Types.Model.Channel import Calamity.Types.Model.Guild import Calamity.Types.Model.User import Calamity.Types.Snowflake import Control.Applicative-import Data.Functor.Identity import Control.Monad.State.Strict import Data.Foldable-import qualified Data.HashMap.Strict as SH-import qualified Data.HashSet as HS+import Data.Functor.Identity+import Data.HashMap.Strict qualified as SH+import Data.HashSet qualified as HS import Data.IORef import Optics-import qualified Polysemy as P-import qualified Polysemy.AtomicState as P-import Optics.State.Operators ((?=), (%=))+import Optics.State.Operators ((%=), (?=))+import Polysemy qualified as P+import Polysemy.AtomicState qualified as P  data Cache f = Cache   { user :: Maybe User@@ -96,7 +97,7 @@ runCache (SetGuild g) = do   #guilds %= SM.insert g   #guildChannels %= SH.filter (\v -> getID @Guild v /= getID @Guild g)-  #guildChannels %= SH.union (SH.fromList $ map (, g) (SM.keys (g ^. #channels)))+  #guildChannels %= SH.union (SH.fromList $ map (,g) (SM.keys (g ^. #channels))) runCache (GetGuild gid) = use (#guilds % at' gid) runCache (GetGuildChannel cid) = use (#guildChannels % at' cid) <&> (>>= (^. #channels % at' cid)) runCache GetGuilds = SM.elems <$> use #guilds

@@ -1,44 +1,46 @@ -- | Module containing the core client stuff-module Calamity.Client-    ( module Calamity.Client.Client-    , module Calamity.Client.Types-    -- * Client stuff-    -- $clientDocs-    ) where+module Calamity.Client (+  module Calamity.Client.Client,+  module Calamity.Client.Types, -import           Calamity.Client.Client-import           Calamity.Client.Types+  -- * Client stuff+  -- $clientDocs+) where --- $clientDocs------ This module provides the core components for running a discord client, along--- with abstractions for registering event handlers, firing custom events, and--- waiting on events.--------- ==== Registered Metrics------     1. Counter: @"events_recieved" [type, shard]@------         Incremented for each event received, the @type@ parameter is the type---         of event (the name of the constructor in---         'Calamity.Gateway.DispatchEvents.DispatchData'), and @shard@ is the---         ID of the shard that received the event.------     2. Histogram: @"cache_update"@------         Tracks how long it takes to update the cache after recieving an event.------     3. Histogram: @"event_handle"@------         Tracks how long it takes to process an event handler for an event.--------- ==== Examples------ A simple client that prints every message recieved:------ @--- 'Control.Monad.void' . 'Polysemy.runFinal' . 'Polysemy.embedToFinal' . 'Calamity.Cache.InMemory.runCacheInMemory' . 'Calamity.Metrics.Noop.runMetricsNoop' $ 'runBotIO' ('Calamity.Types.Token.BotToken' token) $ do---   'react' \@\''MessageCreateEvt' $ \\msg -> 'Polysemy.embed' $ 'print' msg--- @+import Calamity.Client.Client+import Calamity.Client.Types++{- $clientDocs++ This module provides the core components for running a discord client, along+ with abstractions for registering event handlers, firing custom events, and+ waiting on events.+++ ==== Registered Metrics++     1. Counter: @"events_recieved" [type, shard]@++         Incremented for each event received, the @type@ parameter is the type+         of event (the name of the constructor in+         'Calamity.Gateway.DispatchEvents.DispatchData'), and @shard@ is the+         ID of the shard that received the event.++     2. Histogram: @"cache_update"@++         Tracks how long it takes to update the cache after recieving an event.++     3. Histogram: @"event_handle"@++         Tracks how long it takes to process an event handler for an event.+++ ==== Examples++ A simple client that prints every message recieved:++ @+ 'Control.Monad.void' . 'Polysemy.runFinal' . 'Polysemy.embedToFinal' . 'Calamity.Cache.InMemory.runCacheInMemory' . 'Calamity.Metrics.Noop.runMetricsNoop' $ 'runBotIO' ('Calamity.Types.Token.BotToken' token) $ do+   'react' \@\''MessageCreateEvt' $ \\msg -> 'Polysemy.embed' $ 'print' msg+ @+-}

@@ -25,7 +25,7 @@ import Calamity.HTTP.Internal.Ratelimit import Calamity.Internal.ConstructorName import Calamity.Internal.RunIntoIO-import qualified Calamity.Internal.SnowflakeMap as SM+import Calamity.Internal.SnowflakeMap qualified as SM import Calamity.Internal.UnixTimestamp import Calamity.Internal.Updateable import Calamity.Internal.Utils@@ -35,7 +35,7 @@ import Calamity.Types.Model.Guild import Calamity.Types.Model.Presence (Presence (..)) import Calamity.Types.Model.User-import qualified Calamity.Types.Model.Voice as V+import Calamity.Types.Model.Voice qualified as V import Calamity.Types.Snowflake import Calamity.Types.Token import Calamity.Types.TokenEff@@ -50,20 +50,19 @@ import Data.IORef import Data.Maybe import Data.Proxy-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time.Clock.POSIX-import qualified Df1-import qualified Di.Core as DC-import qualified DiPolysemy as Di+import Df1 qualified+import Di.Core qualified as DC+import DiPolysemy qualified as Di import Optics-import qualified Polysemy as P-import qualified Polysemy.Async as P-import qualified Polysemy.AtomicState as P-import qualified Polysemy.Error as P-import qualified Polysemy.Fail as P-import qualified Polysemy.Reader as P-import qualified Polysemy.Resource as P-import PyF+import Polysemy qualified as P+import Polysemy.Async qualified as P+import Polysemy.AtomicState qualified as P+import Polysemy.Error qualified as P+import Polysemy.Fail qualified as P+import Polysemy.Reader qualified as P+import Polysemy.Resource qualified as P import TextShow (TextShow (showt))  timeA :: P.Member (P.Embed IO) r => P.Sem r a -> P.Sem r (Double, a)@@ -663,6 +662,9 @@ handleEvent' eh evt@(InteractionCreate interaction) = do   updateCache evt   pure $ map ($ interaction) (getEventHandlers @'InteractionEvt eh)+handleEvent' _ (UNHANDLED e) = do+  debug . T.pack $ "Not handling event: " <> show e+  pure [] handleEvent' _ e = fail $ "Unhandled event: " <> show e  updateCache :: P.Members '[CacheEff, P.Fail] r => DispatchData -> P.Sem r ()@@ -771,12 +773,14 @@ -- we don't update the cache from interactions -- TODO: should we? updateCache (InteractionCreate _) = pure ()+updateCache (UNHANDLED _) = pure ()  updateReactionAdd :: Bool -> RawEmoji -> Reaction -> Reaction updateReactionAdd isMe emoji reaction =   if emoji == reaction ^. #emoji     then-      reaction & #count %~ succ+      reaction+        & #count %~ succ         & #me %~ (|| isMe)     else reaction @@ -784,6 +788,7 @@ updateReactionRemove isMe emoji reaction =   if emoji == reaction ^. #emoji     then-      reaction & #count %~ pred+      reaction+        & #count %~ pred         & #me %~ (&& not isMe)     else reaction

@@ -8,14 +8,13 @@ import Control.Concurrent.MVar import Control.Concurrent.STM import Control.Monad-import qualified Data.Text as T+import Data.Text qualified as T import Data.Traversable import Optics import Polysemy (Sem)-import qualified Polysemy as P-import qualified Polysemy.Fail as P-import qualified Polysemy.Reader as P-import PyF+import Polysemy qualified as P+import Polysemy.Fail qualified as P+import Polysemy.Reader qualified as P  mapLeft :: (a -> c) -> Either a b -> Either c b mapLeft f (Left a) = Left $ f a

@@ -45,17 +45,17 @@ import Data.Maybe import Data.Time import Data.TypeRepMap (TypeRepMap, WrapTypeable (..))-import qualified Data.TypeRepMap as TM+import Data.TypeRepMap qualified as TM import Data.Typeable import Data.Void (Void)-import qualified Df1-import qualified Di.Core as DC+import Df1 qualified+import Di.Core qualified as DC import GHC.Exts (fromList) import Optics.TH-import qualified Polysemy as P-import qualified Polysemy.Async as P-import qualified Polysemy.AtomicState as P-import qualified Polysemy.Reader as P+import Polysemy qualified as P+import Polysemy.Async qualified as P+import Polysemy.AtomicState qualified as P+import Polysemy.Reader qualified as P  data Client = Client   { shards :: TVar [(InChan ControlMessage, Async (Maybe ()))]@@ -227,7 +227,7 @@   EHType 'UserUpdateEvt = (User, User)   EHType 'VoiceStateUpdateEvt = (Maybe VoiceState, VoiceState)   EHType 'InteractionEvt = Interaction-  EHType ( 'CustomEvt a) = a+  EHType ('CustomEvt a) = a  type StoredEHType t = EHType t -> IO () @@ -244,7 +244,7 @@   deriving newtype (Monoid, Semigroup)  type family EHStorageType (t :: EventType) where-  EHStorageType ( 'CustomEvt _) = TypeRepMap CustomEHTypeStorage+  EHStorageType ('CustomEvt _) = TypeRepMap CustomEHTypeStorage   EHStorageType t = [EventHandlerWithID (StoredEHType t)]  newtype EventHandler (t :: EventType) = EH@@ -290,7 +290,7 @@         , WrapTypeable $ EH @'TypingStartEvt []         , WrapTypeable $ EH @'UserUpdateEvt []         , WrapTypeable $ EH @'InteractionEvt []-        , WrapTypeable $ EH @( 'CustomEvt Void) TM.empty+        , WrapTypeable $ EH @('CustomEvt Void) TM.empty         ]  instance Semigroup EventHandlers where@@ -302,7 +302,7 @@ -- not sure what to think of this  type family EHInstanceSelector (d :: EventType) :: Bool where-  EHInstanceSelector ( 'CustomEvt _) = 'True+  EHInstanceSelector ('CustomEvt _) = 'True   EHInstanceSelector _ = 'False  {- | A helper typeclass that is used to decide how to register regular@@ -317,10 +317,10 @@ class InsertEventHandler' (flag :: Bool) a where   makeEventHandlers' :: Proxy flag -> Proxy a -> Integer -> StoredEHType a -> EventHandlers -instance forall (x :: Type). (Typeable (EHType ( 'CustomEvt x))) => InsertEventHandler' 'True ( 'CustomEvt x) where+instance forall (x :: Type). (Typeable (EHType ('CustomEvt x))) => InsertEventHandler' 'True ('CustomEvt x) where   makeEventHandlers' _ _ id' handler =     EventHandlers . TM.one $-      EH @( 'CustomEvt Void)+      EH @('CustomEvt Void)         (TM.one @x $ CustomEHTypeStorage [EventHandlerWithID id' handler])  instance (Typeable s, EHStorageType s ~ [EventHandlerWithID (StoredEHType s)], Typeable (StoredEHType s)) => InsertEventHandler' 'False s where@@ -335,7 +335,7 @@ class GetEventHandlers' (flag :: Bool) a where   getEventHandlers' :: Proxy a -> Proxy flag -> EventHandlers -> [StoredEHType a] -instance GetEventHandlers' 'True ( 'CustomEvt a) where+instance GetEventHandlers' 'True ('CustomEvt a) where   getEventHandlers' _ _ _ = error "use getCustomEventHandlers instead"  instance (Typeable s, Typeable (StoredEHType s), EHStorageType s ~ [EventHandlerWithID (StoredEHType s)]) => GetEventHandlers' 'False s where@@ -352,10 +352,10 @@ class RemoveEventHandler' (flag :: Bool) a where   removeEventHandler' :: Proxy flag -> Proxy a -> Integer -> EventHandlers -> EventHandlers -instance forall (a :: Type). (Typeable a) => RemoveEventHandler' 'True ( 'CustomEvt a) where+instance forall (a :: Type). (Typeable a) => RemoveEventHandler' 'True ('CustomEvt a) where   removeEventHandler' _ _ id' (EventHandlers handlers) =     EventHandlers $-      TM.adjust @( 'CustomEvt Void)+      TM.adjust @('CustomEvt Void)         ( \(EH ehs) ->             EH               ( TM.adjust @a@@ -378,8 +378,8 @@ getCustomEventHandlers :: forall a. Typeable a => EventHandlers -> [a -> IO ()] getCustomEventHandlers (EventHandlers handlers) =   let handlerMap =-        unwrapEventHandler @( 'CustomEvt Void) $-          fromMaybe mempty (TM.lookup handlers :: Maybe (EventHandler ( 'CustomEvt Void)))+        unwrapEventHandler @('CustomEvt Void) $+          fromMaybe mempty (TM.lookup handlers :: Maybe (EventHandler ('CustomEvt Void)))    in maybe mempty (map eh . unwrapCustomEHTypeStorage) $ TM.lookup @a handlerMap  $(makeFieldLabelsNoPrefix ''Client)

@@ -2,22 +2,22 @@  This module exports the DSL and core types for using commands -} module Calamity.Commands (-    module Calamity.Commands.Dsl,-    module CalamityCommands.Error,-    module Calamity.Commands.Help,-    module CalamityCommands.Parser,-    module Calamity.Commands.Utils,-    module Calamity.Commands.Types,+  module Calamity.Commands.Dsl,+  module CalamityCommands.Error,+  module Calamity.Commands.Help,+  module CalamityCommands.Parser,+  module Calamity.Commands.Utils,+  module Calamity.Commands.Types, -    -- * Commands-    -- $commandDocs+  -- * Commands+  -- $commandDocs ) where  import Calamity.Commands.CalamityParsers () import Calamity.Commands.Dsl import Calamity.Commands.Help-import Calamity.Commands.Utils import Calamity.Commands.Types+import Calamity.Commands.Utils import CalamityCommands.Error import CalamityCommands.Parser 

@@ -12,14 +12,14 @@ import Calamity.Types.Snowflake import CalamityCommands.ParameterInfo import CalamityCommands.Parser-import Optics import Control.Monad import Control.Monad.Trans (lift) import Data.Maybe (fromMaybe, isJust)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Typeable-import qualified Polysemy as P-import qualified Polysemy.Reader as P+import Optics+import Polysemy qualified as P+import Polysemy.Reader qualified as P import Text.Megaparsec hiding (parse) import Text.Megaparsec.Char.Lexer (decimal) import Text.Megaparsec.Error.Builder (errFancy, fancy)@@ -147,8 +147,8 @@ -- | Parses both discord emojis, and unicode emojis instance ParameterParser RawEmoji c r where   parse = parseMP (parserName @RawEmoji) (try parseCustomEmoji <|> UnicodeEmoji <$> takeP (Just "A unicode emoji") 1)-   where-    parseCustomEmoji = CustomEmoji <$> partialEmoji+    where+      parseCustomEmoji = CustomEmoji <$> partialEmoji   parameterDescription = "emoji"  {- | ParameterParser for roles in the guild the command was invoked in, this only

@@ -17,14 +17,14 @@ import Calamity.Types.Model.User import Calamity.Types.Snowflake import Calamity.Types.Tellable-import qualified CalamityCommands.Context as CC+import CalamityCommands.Context qualified as CC import Control.Applicative import Control.Monad-import qualified Data.Text as T+import Data.Text qualified as T import Optics-import qualified Polysemy as P-import qualified Polysemy.Fail as P-import qualified TextShow+import Polysemy qualified as P+import Polysemy.Fail qualified as P+import TextShow qualified  class CommandContext c => CalamityCommandContext c where   -- | The id of the channel that invoked this command@@ -41,25 +41,25 @@  -- | Invokation context for commands data FullContext = FullContext-  { -- | The message that the command was invoked from-    message :: Message-  , -- | If the command was sent in a guild, this will be present-    guild :: Maybe Guild-  , -- | The member that invoked the command, if in a guild-    ---    -- Note: If discord sent a member with the message, this is used; otherwise-    -- we try to fetch the member from the cache.-    member :: Maybe Member-  , -- | The channel the command was invoked from-    channel :: Channel-  , -- | The user that invoked the command-    user :: User-  , -- | The command that was invoked-    command :: Command FullContext-  , -- | The prefix that was used to invoke the command-    prefix :: T.Text-  , -- | The message remaining after consuming the prefix-    unparsedParams :: T.Text+  { message :: Message+  -- ^ The message that the command was invoked from+  , guild :: Maybe Guild+  -- ^ If the command was sent in a guild, this will be present+  , member :: Maybe Member+  -- ^ The member that invoked the command, if in a guild+  --+  -- Note: If discord sent a member with the message, this is used; otherwise+  -- we try to fetch the member from the cache.+  , channel :: Channel+  -- ^ The channel the command was invoked from+  , user :: User+  -- ^ The user that invoked the command+  , command :: Command FullContext+  -- ^ The command that was invoked+  , prefix :: T.Text+  -- ^ The prefix that was used to invoke the command+  , unparsedParams :: T.Text+  -- ^ The message remaining after consuming the prefix   }   deriving (Show)   deriving (TextShow.TextShow) via TextShow.FromStringShow FullContext@@ -103,24 +103,24 @@  -- | A lightweight context that doesn't need any cache information data LightContext = LightContext-  { -- | The message that the command was invoked from-    message :: Message-  , -- | If the command was sent in a guild, this will be present-    guildID :: Maybe (Snowflake Guild)-  , -- | The channel the command was invoked from-    channelID :: Snowflake Channel-  , -- | The user that invoked the command-    user :: User-  , -- | The member that triggered the command.-    ---    -- Note: Only sent if discord sent the member object with the message.-    member :: Maybe Member-  , -- | The command that was invoked-    command :: Command LightContext-  , -- | The prefix that was used to invoke the command-    prefix :: T.Text-  , -- | The message remaining after consuming the prefix-    unparsedParams :: T.Text+  { message :: Message+  -- ^ The message that the command was invoked from+  , guildID :: Maybe (Snowflake Guild)+  -- ^ If the command was sent in a guild, this will be present+  , channelID :: Snowflake Channel+  -- ^ The channel the command was invoked from+  , user :: User+  -- ^ The user that invoked the command+  , member :: Maybe Member+  -- ^ The member that triggered the command.+  --+  -- Note: Only sent if discord sent the member object with the message.+  , command :: Command LightContext+  -- ^ The command that was invoked+  , prefix :: T.Text+  -- ^ The prefix that was used to invoke the command+  , unparsedParams :: T.Text+  -- ^ The message remaining after consuming the prefix   }   deriving (Show)   deriving (TextShow.TextShow) via TextShow.FromStringShow LightContext

@@ -1,5 +1,3 @@-{-# LANGUAGE RecursiveDo #-}- {- | A DSL for generating commands and groups   This is effectively just a re-export of "CalamityCommands.Dsl" but with@@ -25,20 +23,20 @@   fetchHandler, ) where -import qualified CalamityCommands.Dsl as CC+import CalamityCommands.Dsl qualified as CC import CalamityCommands.ParameterInfo  import Calamity.Commands.Types -import qualified Data.Text as T+import Data.Text qualified as T  import CalamityCommands.CommandUtils (CommandForParsers, TypedCommandC)-import qualified CalamityCommands.Context as CC+import CalamityCommands.Context qualified as CC import CalamityCommands.Error (CommandError)-import qualified Polysemy as P-import qualified Polysemy.Fail as P-import qualified Polysemy.Reader as P-import qualified Polysemy.Tagged as P+import Polysemy qualified as P+import Polysemy.Fail qualified as P+import Polysemy.Reader qualified as P+import Polysemy.Tagged qualified as P  {- $dslTutorial 

@@ -7,9 +7,9 @@ import Calamity.Client.Types (BotC) import Calamity.Commands.Types import Calamity.Types.Tellable-import qualified CalamityCommands.Help as CC+import CalamityCommands.Help qualified as CC import Control.Monad (void)-import qualified Polysemy as P+import Polysemy qualified as P  {- | Given a 'CommandHandler', optionally a parent 'Group', and a list of 'Check's,  construct a help command that will provide help for all the commands and

@@ -4,21 +4,21 @@  the more generic variants. -} module Calamity.Commands.Types (-    type Command,-    type Group,-    type CommandHandler,-    type Check,-    type DSLState,-    type DSLC,-    type CommandContext,+  type Command,+  type Group,+  type CommandHandler,+  type Check,+  type DSLState,+  type DSLC,+  type CommandContext, ) where -import qualified CalamityCommands.Check as CC-import qualified CalamityCommands.Command as CC-import qualified CalamityCommands.Dsl as CC-import qualified CalamityCommands.Group as CC-import qualified CalamityCommands.Handler as CC-import qualified CalamityCommands.Context as CC+import CalamityCommands.Check qualified as CC+import CalamityCommands.Command qualified as CC+import CalamityCommands.Context qualified as CC+import CalamityCommands.Dsl qualified as CC+import CalamityCommands.Group qualified as CC+import CalamityCommands.Handler qualified as CC  type Command c = CC.Command IO c () type Group c = CC.Group IO c ()

@@ -19,15 +19,15 @@ import Calamity.Types.Model.Guild.Member (Member) import Calamity.Types.Model.User (User) import CalamityCommands.CommandUtils-import qualified CalamityCommands.Context as CC-import qualified CalamityCommands.Error as CC-import qualified CalamityCommands.ParsePrefix as CC-import qualified CalamityCommands.Utils as CC+import CalamityCommands.Context qualified as CC+import CalamityCommands.Error qualified as CC+import CalamityCommands.ParsePrefix qualified as CC+import CalamityCommands.Utils qualified as CC import Control.Monad-import qualified Data.Text as T+import Data.Text qualified as T import Data.Typeable-import qualified Polysemy as P import Optics.TH (makeFieldLabelsNoPrefix)+import Polysemy qualified as P  data CmdInvokeFailReason c   = NoContext@@ -44,8 +44,8 @@   { msg :: Message   , user :: User   , member :: Maybe Member-  , -- | The groups that were successfully parsed-    path :: [T.Text]+  , path :: [T.Text]+  -- ^ The groups that were successfully parsed   }   deriving (Show) @@ -56,44 +56,49 @@  -- | A default interpretation for 'CC.ParsePrefix' that uses a single constant prefix. useConstantPrefix :: T.Text -> P.Sem (CC.ParsePrefix Message ': r) a -> P.Sem r a-useConstantPrefix pre = P.interpret (\case-                                        CC.ParsePrefix Message { content } -> pure ((pre, ) <$> T.stripPrefix pre content))+useConstantPrefix pre =+  P.interpret+    ( \case+        CC.ParsePrefix Message {content} -> pure ((pre,) <$> T.stripPrefix pre content)+    ) --- | Construct commands and groups from a command DSL, then registers an event--- handler on the bot that manages running those commands.--------- Returns an action to remove the event handler, and the 'CommandHandler' that was constructed.------ ==== Command Resolution------ To determine if a command was invoked, and if so which command was invoked, the following happens:------     1. 'CalamityCommands.ParsePrefix.parsePrefix' is invoked, if no prefix is found: stop here.------     2. The input is read a word at a time until a matching command is found,---        fire the \"command-not-found\" event if not.------     3. A 'Calamity.Commands.Context.Context' is built, and the command invoked.------ ==== Custom Events------ This will fire the following events:------     1. 'CtxCommandError'------         Fired when a command returns an error.------     2. 'CommandNotFound'------         Fired when a valid prefix is used, but the command is not found.------     3. 'CommandInvoked'------         Fired when a command is successfully invoked.----addCommands :: (BotC r, Typeable c, CommandContext c, P.Members [CC.ParsePrefix Message, CC.ConstructContext (Message, User, Maybe Member) c IO ()] r)-  => P.Sem (DSLState c r) a -> P.Sem r (P.Sem r (), CommandHandler c, a)+{- | Construct commands and groups from a command DSL, then registers an event+ handler on the bot that manages running those commands.+++ Returns an action to remove the event handler, and the 'CommandHandler' that was constructed.++ ==== Command Resolution++ To determine if a command was invoked, and if so which command was invoked, the following happens:++     1. 'CalamityCommands.ParsePrefix.parsePrefix' is invoked, if no prefix is found: stop here.++     2. The input is read a word at a time until a matching command is found,+        fire the \"command-not-found\" event if not.++     3. A 'Calamity.Commands.Context.Context' is built, and the command invoked.++ ==== Custom Events++ This will fire the following events:++     1. 'CtxCommandError'++         Fired when a command returns an error.++     2. 'CommandNotFound'++         Fired when a valid prefix is used, but the command is not found.++     3. 'CommandInvoked'++         Fired when a command is successfully invoked.+-}+addCommands ::+  (BotC r, Typeable c, CommandContext c, P.Members [CC.ParsePrefix Message, CC.ConstructContext (Message, User, Maybe Member) c IO ()] r) =>+  P.Sem (DSLState c r) a ->+  P.Sem r (P.Sem r (), CommandHandler c, a) addCommands m = do   (handler, res) <- CC.buildCommands m   remove <- react @'MessageCreateEvt $ \case@@ -103,13 +108,12 @@           r <- CC.handleCommands handler (msg, user, member) prefix cmd           case r of             Left (CC.CommandInvokeError ctx e) -> fire . customEvt $ CtxCommandError ctx e-            Left (CC.NotFound path)            -> fire . customEvt $ CommandNotFound msg user member path-            Left CC.NoContext                  -> pure () -- ignore if context couldn't be built-            Right (ctx, ())        -> do+            Left (CC.NotFound path) -> fire . customEvt $ CommandNotFound msg user member path+            Left CC.NoContext -> pure () -- ignore if context couldn't be built+            Right (ctx, ()) -> do               cmdInvoke <- registerCounter "commands_invoked" [("name", T.unwords $ commandPath (CC.ctxCommand ctx))]               void $ addCounter 1 cmdInvoke               fire . customEvt $ CommandInvoked ctx-         Nothing -> pure ()     _ -> pure ()   pure (remove, handler, res)

@@ -1,23 +1,24 @@--- |-module Calamity.Gateway-    ( module Calamity.Gateway.Shard-    , module Calamity.Gateway.Types-    , module Calamity.Gateway.Intents-    -- * Gateway-    -- $gatewayDocs-    ) where+module Calamity.Gateway (+  module Calamity.Gateway.Shard,+  module Calamity.Gateway.Types,+  module Calamity.Gateway.Intents, -import           Calamity.Gateway.Shard-import           Calamity.Gateway.Types-import           Calamity.Gateway.Intents+  -- * Gateway+  -- $gatewayDocs+) where --- $gatewayDocs------ This module contains all the gateway related things.--------- ==== Registered Metrics------     1. Gauge: @"active_shards"@------         Keeps track of how many shards are currently active.+import Calamity.Gateway.Intents+import Calamity.Gateway.Shard+import Calamity.Gateway.Types++{- $gatewayDocs++ This module contains all the gateway related things.+++ ==== Registered Metrics++     1. Gauge: @"active_shards"@++         Keeps track of how many shards are currently active.+-}

@@ -20,7 +20,7 @@ import Calamity.Types.Model.Voice import Calamity.Types.Snowflake import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Kind (Type) import Data.Text (Text) import Data.Time@@ -75,6 +75,7 @@   | VoiceServerUpdate !VoiceServerUpdateData   | WebhooksUpdate !WebhooksUpdateData   | InteractionCreate !Interaction+  | UNHANDLED Text   deriving (Show, Generic, CtorName)  data ReadyData = ReadyData

@@ -3,23 +3,23 @@  -- | Discord gateway intents module Calamity.Gateway.Intents (-    Intents (..),-    defaultIntents,-    intentGuilds,-    intentGuildMembers,-    intentGuildBans,-    intentGuildEmojis,-    intentGuildIntegrations,-    intentGuildWebhooks,-    intentGuildInvites,-    intentGuildVoiceStates,-    intentGuildPresences,-    intentGuildMessages,-    intentGuildMessageReactions,-    intentGuildMessageTyping,-    intentDirectMessages,-    intentDirectMessageReactions,-    intentDirectMessageTyping,+  Intents (..),+  defaultIntents,+  intentGuilds,+  intentGuildMembers,+  intentGuildBans,+  intentGuildEmojis,+  intentGuildIntegrations,+  intentGuildWebhooks,+  intentGuildInvites,+  intentGuildVoiceStates,+  intentGuildPresences,+  intentGuildMessages,+  intentGuildMessageReactions,+  intentGuildMessageTyping,+  intentDirectMessages,+  intentDirectMessageReactions,+  intentDirectMessageTyping, ) where  import Data.Aeson (ToJSON)@@ -60,4 +60,4 @@  -- | Default intents are all but the privileged intents: members and intents instance Default Intents where-    def = defaultIntents+  def = defaultIntents

@@ -1,6 +1,3 @@-{-# LANGUAGE RecursiveDo #-}-{-# LANGUAGE TemplateHaskell #-}- -- | The shard logic module Calamity.Gateway.Shard (   Shard (..),@@ -63,7 +60,7 @@ import Calamity.Types.Token (Token, rawToken) import Control.Concurrent (threadDelay) import Control.Concurrent.Async (Async, cancel)-import qualified Control.Concurrent.Chan.Unagi as UC+import Control.Concurrent.Chan.Unagi qualified as UC import Control.Concurrent.STM (STM, atomically, retry) import Control.Concurrent.STM.TBMQueue (   TBMQueue,@@ -77,21 +74,19 @@   Exception (fromException),   SomeException,  )-import qualified Control.Exception.Safe as Ex-import Optics-import Optics.State.Operators+import Control.Exception.Safe qualified as Ex import Control.Monad (void, when) import Control.Monad.State.Lazy (runState)-import qualified Data.Aeson as A-import qualified Data.ByteString.Lazy as LBS+import Data.Aeson qualified as A+import Data.ByteString.Lazy qualified as LBS import Data.Default.Class (def) import Data.IORef (newIORef) import Data.Maybe (fromMaybe)-import qualified Data.Text as T+import Data.Text qualified as T import DiPolysemy (attr, push)-import qualified Network.Connection as NC-import qualified Network.TLS as NT-import qualified Network.TLS.Extra as NT+import Network.Connection qualified as NC+import Network.TLS qualified as NT+import Network.TLS.Extra qualified as NT import Network.WebSockets (   Connection,   ConnectionException (..),@@ -99,16 +94,17 @@   sendCloseCode,   sendTextData,  )-import qualified Network.WebSockets as NW-import qualified Network.WebSockets.Stream as NW+import Network.WebSockets qualified as NW+import Network.WebSockets.Stream qualified as NW+import Optics+import Optics.State.Operators import Polysemy (Sem)-import qualified Polysemy as P-import qualified Polysemy.Async as P-import qualified Polysemy.AtomicState as P-import qualified Polysemy.Error as P-import qualified Polysemy.Resource as P-import PyF (fmt)-import qualified System.X509 as X509+import Polysemy qualified as P+import Polysemy.Async qualified as P+import Polysemy.AtomicState qualified as P+import Polysemy.Error qualified as P+import Polysemy.Resource qualified as P+import System.X509 qualified as X509 import TextShow (showt) import Prelude hiding (error) @@ -226,7 +222,7 @@     handleWSException e = pure $ case fromException e of       Just (CloseRequest code _)         | code `elem` [4004, 4010, 4011, 4012, 4013, 4014] ->-          Left (ShutDownShard, Just . showt $ code)+            Left (ShutDownShard, Just . showt $ code)       e -> Left (RestartShard, Just . T.pack . show $ e)      discordStream :: P.Members '[LogEff, MetricEff, P.Embed IO, P.Final IO] r => Connection -> TBMQueue ShardMsg -> Sem r ()@@ -246,7 +242,7 @@                 Right a ->                   P.embed . atomically $ tryWriteTBMQueue' outqueue (Discord a)                 Left e -> do-                  error . T.pack $ "Failed to decode " <> e <> ": "<> show msg'+                  error . T.pack $ "Failed to decode " <> e <> ": " <> show msg'                   pure True               when r inner     outerloop :: ShardC r => Sem r ()@@ -307,7 +303,7 @@                   , compress = False                   , largeThreshold = Nothing                   , shard =-                      Just ( shard ^. #shardID , shard ^. #shardCount )+                      Just (shard ^. #shardID, shard ^. #shardCount)                   , presence = shard ^. #initialStatus                   , intents = shard ^. #intents                   }

@@ -30,17 +30,18 @@ import Calamity.Types.Snowflake import Control.Concurrent.Async import Control.Concurrent.Chan.Unagi-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Aeson.Optics import Data.Aeson.Types (parseMaybe)-import qualified Data.Aeson.Types as AT+import Data.Aeson.Types qualified as AT import Data.Text (Text)+import Data.Text qualified as T import GHC.Generics import Network.WebSockets.Connection (Connection) import Optics-import qualified Polysemy as P-import qualified Polysemy.Async as P-import qualified Polysemy.AtomicState as P+import Polysemy qualified as P+import Polysemy.Async qualified as P+import Polysemy.AtomicState qualified as P  type ShardC r =   ( P.Members@@ -149,6 +150,7 @@ parseDispatchData VOICE_SERVER_UPDATE data' = VoiceServerUpdate <$> Aeson.parseJSON data' parseDispatchData WEBHOOKS_UPDATE data' = WebhooksUpdate <$> Aeson.parseJSON data' parseDispatchData INTERACTION_CREATE data' = InteractionCreate <$> Aeson.parseJSON data'+parseDispatchData e _ = pure . UNHANDLED . T.pack . show $ e  data SentDiscordMessage   = StatusUpdate StatusUpdateData@@ -179,16 +181,29 @@ data DispatchType   = READY   | RESUMED+  | APPLICATION_COMMAND_PERMISSIONS_UPDATE+  | AUTO_MODERATION_RULE_CREATE+  | AUTO_MODERATION_RULE_UPDATE+  | AUTO_MODERATION_RULE_DELETE+  | AUTO_MODERATION_ACTION_EXECUTION   | CHANNEL_CREATE   | CHANNEL_UPDATE   | CHANNEL_DELETE   | CHANNEL_PINS_UPDATE+  | THREAD_CREATE+  | THREAD_UPDATE+  | THREAD_DELETE+  | THREAD_LIST_SYNC+  | THREAD_MEMBER_UPDATE+  | THREAD_MEMBERS_UPDATE   | GUILD_CREATE   | GUILD_UPDATE   | GUILD_DELETE+  | GUILD_AUDIT_LOG_ENTRY_CREATE   | GUILD_BAN_ADD   | GUILD_BAN_REMOVE   | GUILD_EMOJIS_UPDATE+  | GUILD_STICKERS_UPDATE   | GUILD_INTEGRATIONS_UPDATE   | GUILD_MEMBER_ADD   | GUILD_MEMBER_REMOVE@@ -197,6 +212,15 @@   | GUILD_ROLE_CREATE   | GUILD_ROLE_UPDATE   | GUILD_ROLE_DELETE+  | GUILD_SCHEDULED_EVENT_CREATE+  | GUILD_SCHEDULED_EVENT_UPDATE+  | GUILD_SCHEDULED_EVENT_DELETE+  | GUILD_SCHEDULED_EVENT_USER_ADD+  | GUILD_SCHEDULED_EVENT_USER_REMOVE+  | INTEGRATION_CREATE+  | INTEGRATION_UPDATE+  | INTEGRATION_DELETE+  | INTERACTION_CREATE   | INVITE_CREATE   | INVITE_DELETE   | MESSAGE_CREATE@@ -206,13 +230,16 @@   | MESSAGE_REACTION_ADD   | MESSAGE_REACTION_REMOVE   | MESSAGE_REACTION_REMOVE_ALL+  | MESSAGE_REACTION_REMOVE_EMOJI   | PRESENCE_UPDATE+  | STAGE_INSTANCE_CREATE+  | STAGE_INSTANCE_UPDATE+  | STATE_INSTANCE_DELETE   | TYPING_START   | USER_UPDATE   | VOICE_STATE_UPDATE   | VOICE_SERVER_UPDATE   | WEBHOOKS_UPDATE-  | INTERACTION_CREATE   deriving (Show, Eq, Enum, Generic)   deriving (Aeson.ToJSON, Aeson.FromJSON) 

@@ -14,6 +14,7 @@   module Calamity.HTTP.Internal.Types,   RatelimitEff (..),   TokenEff (..),+   -- * HTTP   -- $httpDocs ) where@@ -33,28 +34,29 @@ import Calamity.HTTP.Webhook import Calamity.Types.TokenEff (TokenEff (..)) --- $httpDocs------ This module contains all the http related things--------- ==== Registered Metrics------     1. Gauge: @"inflight_requests" [route]@------         Keeps track of how many requests are currently in-flight, the @route@---         parameter will be the route that is currently active.------     2. Counter: @"total_requests" [route]@------         Incremented on every request, the @route@ parameter is the route that---         the request was made on.--------- ==== Examples------ Editing a message:------ @--- 'invoke' $ 'EditMessage' someChannel someMessage ('Just' "new content") 'Nothing'--- @+{- $httpDocs++ This module contains all the http related things+++ ==== Registered Metrics++     1. Gauge: @"inflight_requests" [route]@++         Keeps track of how many requests are currently in-flight, the @route@+         parameter will be the route that is currently active.++     2. Counter: @"total_requests" [route]@++         Incremented on every request, the @route@ parameter is the route that+         the request was made on.+++ ==== Examples++ Editing a message:++ @+ 'invoke' $ 'EditMessage' someChannel someMessage ('Just' "new content") 'Nothing'+ @+-}

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}  -- | Channel endpoints module Calamity.HTTP.Channel (@@ -31,19 +32,18 @@ import Calamity.Types.Model.Guild.Role (Role) import Calamity.Types.Model.User import Calamity.Types.Snowflake-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.KeyMap as K+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as K import Data.ByteString.Lazy (ByteString) import Data.Default.Class import Data.Maybe (fromMaybe) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Word import Network.HTTP.Client.MultipartFormData import Network.HTTP.Req import Network.Mime import Optics-import PyF import TextShow  data CreateMessageAttachment = CreateMessageAttachment@@ -474,4 +474,3 @@   action (DeletePinnedMessage _ _) = deleteWith   action (GroupDMAddRecipient _ _ o) = putWith' (ReqBodyJson o)   action (GroupDMRemoveRecipient _ _) = deleteWith-

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}  -- | Emoji endpoints module Calamity.HTTP.Emoji (@@ -12,7 +13,7 @@ import Calamity.Internal.Utils (CalamityToJSON (..), CalamityToJSON' (..), (.=)) import Calamity.Types.Model.Guild import Calamity.Types.Snowflake-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Function import Data.Text (Text) import Network.HTTP.Req

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}  -- | Guild endpoints module Calamity.HTTP.Guild (@@ -34,8 +35,8 @@ import Calamity.Types.Model.User import Calamity.Types.Model.Voice import Calamity.Types.Snowflake-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.KeyMap as K+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as K import Data.Colour (Colour) import Data.Default.Class import Data.Text (Text)

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}  -- | Interaction endpoints module Calamity.HTTP.Interaction (@@ -18,19 +19,18 @@ import Calamity.Types.Model.Channel.Message (Message) import Calamity.Types.Model.Interaction import Calamity.Types.Snowflake-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Bits (shiftL, (.|.)) import Data.Default.Class-import qualified Data.HashMap.Strict as H+import Data.HashMap.Strict qualified as H import Data.Maybe (fromMaybe) import Data.Monoid (First (First, getFirst)) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Network.HTTP.Client.MultipartFormData import Network.HTTP.Req import Network.Mime import Optics-import PyF  data InteractionCallback = InteractionCallback   { type_ :: InteractionCallbackType@@ -110,8 +110,8 @@ data InteractionCallbackAutocompleteChoice = InteractionCallbackAutocompleteChoice   { name :: Text   , nameLocalizations :: H.HashMap Text Text-  , -- | Either text or numeric-    value :: Aeson.Value+  , value :: Aeson.Value+  -- ^ Either text or numeric   }   deriving stock (Show)   deriving (Aeson.ToJSON) via CalamityToJSON InteractionCallbackAutocompleteChoice

@@ -16,16 +16,16 @@ import Control.Applicative import Control.Concurrent import Control.Concurrent.Event (Event)-import qualified Control.Concurrent.Event as E+import Control.Concurrent.Event qualified as E import Control.Concurrent.STM-import qualified Control.Exception.Safe as Ex+import Control.Exception.Safe qualified as Ex import Control.Monad-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Aeson.Optics-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as LB+import Data.ByteString qualified as B+import Data.ByteString.Lazy qualified as LB import Data.Maybe-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time import Data.Time.Clock.POSIX import Network.HTTP.Client (responseStatus)@@ -34,11 +34,10 @@ import Optics import Optics.Operators.Unsafe ((^?!)) import Polysemy (Sem, makeSem)-import qualified Polysemy as P-import PyF-import qualified StmContainers.Map as SC+import Polysemy qualified as P+import StmContainers.Map qualified as SC import Prelude hiding (error)-import qualified Prelude+import Prelude qualified  data RatelimitEff m a where   GetRatelimitState :: RatelimitEff m RateLimitState@@ -55,7 +54,7 @@ getRateLimit :: RateLimitState -> RouteKey -> STM Ratelimit getRateLimit s h = do   bucketKey <- SC.lookup h $ bucketKeys s-  bucket <- join <$> sequenceA (flip SC.lookup (buckets s) <$> bucketKey)+  bucket <- join <$> traverse (`SC.lookup` buckets s) bucketKey   case bucket of     Just bucket' ->       pure $ KnownRatelimit bucket'@@ -79,7 +78,6 @@           else old ^. #resetTime     } - updateKnownBucket :: Bucket -> BucketState -> STM () updateKnownBucket bucket bucketState = modifyTVar' (bucket ^. #state) (`mergeBucketStates` bucketState) @@ -119,7 +117,8 @@   modifyTVar'     (bucket ^. #state)     ( \bs ->-        bs & #remaining .~ bs ^. #limit+        bs+          & #remaining .~ bs ^. #limit           & #resetTime .~ Nothing     ) @@ -199,14 +198,10 @@           -- if we needed to sleep, go again so that multiple concurrent requests           -- don't exceed the bucket, to ensure we don't sit in a loop if a           -- request dies on us, bail out after 50 loops-          if tries < 50-            then go (tries + 1)-            else pure () -- print "bailing after number of retries"+          when (tries < 50) $ go (tries + 1) -- print "bailing after number of retries"         WaitRetrySoon -> do           threadDelayMS 20-          if tries < 50-            then go (tries + 1)-            else pure () -- print "bailing after number of retries"+          when (tries < 50) $ go (tries + 1) -- print "bailing after number of retries"         GoNow -> do           -- print "ok going forward with request"           pure ()@@ -219,26 +214,26 @@       let status = responseStatus . toVanillaResponse $ r'       if           | statusIsSuccessful status -> do-            let resp = responseBody r'-            debug $ "Got good response from discord: " <> (T.pack . show $ status)-            now <- P.embed getCurrentTime-            let rlHeaders = buildBucketState now r'-            pure $ Good resp rlHeaders+              let resp = responseBody r'+              debug $ "Got good response from discord: " <> (T.pack . show $ status)+              now <- P.embed getCurrentTime+              let rlHeaders = buildBucketState now r'+              pure $ Good resp rlHeaders           | status == status429 -> do-            now <- P.embed getCurrentTime-            let resp = responseBody r'-            case (resp ^? _Value, buildBucketState now r') of-              (Just !rv, bs) ->-                pure $ Ratelimited (parseRetryAfter now rv) (isGlobal rv) bs-              _ ->-                pure $ ServerError (statusCode status)+              now <- P.embed getCurrentTime+              let resp = responseBody r'+              case (resp ^? _Value, buildBucketState now r') of+                (Just !rv, bs) ->+                  pure $ Ratelimited (parseRetryAfter now rv) (isGlobal rv) bs+                _ ->+                  pure $ ServerError (statusCode status)           | statusIsClientError status -> do-            let err = responseBody r'-            error . T.pack $ ("Something went wrong: " <> show err <> ", response: " <> show r')-            pure $ ClientError (statusCode status) err+              let err = responseBody r'+              error . T.pack $ "Something went wrong: " <> show err <> ", response: " <> show r'+              pure $ ClientError (statusCode status) err           | otherwise -> do-            debug . T.pack $ "Got server error from discord: " <> (show . statusCode $ status)-            pure $ ServerError (statusCode status)+              debug . T.pack $ "Got server error from discord: " <> (show . statusCode $ status)+              pure $ ServerError (statusCode status)     Left e -> do       error . T.pack $ "Something went wrong with the http client: " <> e       pure . InternalResponseError $ T.pack e@@ -255,8 +250,11 @@      end :: Maybe UTCTime     end =-      posixSecondsToUTCTime . realToFrac-        <$> responseHeader r "X-Ratelimit-Reset" ^? _Just % _Double+      posixSecondsToUTCTime+        . realToFrac+        <$> responseHeader r "X-Ratelimit-Reset"+        ^? _Just+        % _Double  buildBucketState :: HttpResponse r => UTCTime -> r -> Maybe (BucketState, B.ByteString) buildBucketState now r = (,) <$> bs <*> bucketKey@@ -355,7 +353,6 @@             void $ updateBucket rlstate (routeKey route) bk bs           (_, Nothing) -> pure ()       pure $ RGood v-     Ratelimited unlockWhen False (Just (bs, bk)) -> do       debug . T.pack $ "429 ratelimited on route, retrying at " <> show unlockWhen @@ -370,7 +367,6 @@         threadDelayUntil unlockWhen        pure $ Retry (HTTPError 429 Nothing)-     Ratelimited unlockWhen False _ -> do       debug "Internal error (ratelimited but no headers), retrying"       case rl of@@ -380,7 +376,6 @@        P.embed $ threadDelayUntil unlockWhen       pure $ Retry (HTTPError 429 Nothing)-     Ratelimited unlockWhen True bs -> do       debug "429 ratelimited globally" 

@@ -26,14 +26,14 @@ import Control.Monad import Data.Aeson hiding (Options) import Data.Aeson.Types (parseEither)-import qualified Data.ByteString.Lazy as LB-import qualified Data.Text as T-import qualified Data.Text.Encoding as TS+import Data.ByteString.Lazy qualified as LB+import Data.Text qualified as T+import Data.Text.Encoding qualified as TS import DiPolysemy hiding (debug, error, info) import Network.HTTP.Req import Optics-import qualified Polysemy as P-import qualified Polysemy.Error as P+import Polysemy qualified as P+import Polysemy.Error qualified as P import Web.HttpApiData  throwIfLeft :: P.Member (P.Error RestError) r => Either String a -> P.Sem r a

@@ -28,14 +28,14 @@ import Data.List (foldl') import Data.Maybe (fromJust) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Typeable import Data.Word import GHC.Generics (Generic) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Network.HTTP.Req import Optics.TH-import qualified TextShow+import TextShow qualified  data RouteFragment   = -- | Static string fragment@@ -121,9 +121,9 @@   AddRequired k reqs = '(k, AddRequiredInner (Lookup k reqs)) ': reqs  type family AddRequiredInner (k :: Maybe RouteRequirement) :: RouteRequirement where-  AddRequiredInner ( 'Just 'Required) = 'Required-  AddRequiredInner ( 'Just 'Satisfied) = 'Satisfied-  AddRequiredInner ( 'Just 'NotNeeded) = 'Required+  AddRequiredInner ('Just 'Required) = 'Required+  AddRequiredInner ('Just 'Satisfied) = 'Satisfied+  AddRequiredInner ('Just 'NotNeeded) = 'Required   AddRequiredInner 'Nothing = 'Required  class Typeable a => RouteFragmentable a reqs where@@ -138,13 +138,13 @@     UnsafeMkRouteBuilder (r <> [S' t]) ids params  instance Typeable a => RouteFragmentable (ID (a :: Type)) (reqs :: [(RequirementType, RouteRequirement)]) where-  type ConsRes (ID a) reqs = RouteBuilder (AddRequired ( 'IDRequirement a) reqs)+  type ConsRes (ID a) reqs = RouteBuilder (AddRequired ('IDRequirement a) reqs)    (UnsafeMkRouteBuilder r ids params) // ID =     UnsafeMkRouteBuilder (r <> [ID' $ typeRep $ Proxy @a]) ids params  instance KnownSymbol s => RouteFragmentable (PS s) (reqs :: [(RequirementType, RouteRequirement)]) where-  type ConsRes (PS s) reqs = RouteBuilder (AddRequired ( 'PSRequirement s) reqs)+  type ConsRes (PS s) reqs = RouteBuilder (AddRequired ('PSRequirement s) reqs)    (UnsafeMkRouteBuilder r ids params) // PS =     UnsafeMkRouteBuilder (r <> [PS' $ symbolVal $ Proxy @s]) ids params

@@ -1,50 +1,51 @@ {-# LANGUAGE TemplateHaskell #-}  -- | Types for the http lib-module Calamity.HTTP.Internal.Types-    ( RestError(..)-    , RateLimitState(..)-    , DiscordResponseType(..)-    , Bucket(..)-    , BucketState(..)-    , GatewayResponse-    , BotGatewayResponse ) where+module Calamity.HTTP.Internal.Types (+  RestError (..),+  RateLimitState (..),+  DiscordResponseType (..),+  Bucket (..),+  BucketState (..),+  GatewayResponse,+  BotGatewayResponse,+) where  import Calamity.HTTP.Internal.Route-import           Control.Concurrent.Event      ( Event )-import           Control.Concurrent.STM.TVar   ( TVar )+import Control.Concurrent.Event (Event)+import Control.Concurrent.STM.TVar (TVar)+import Data.Aeson+import Data.Aeson qualified as Aeson+import Data.ByteString qualified as B+import Data.ByteString.Lazy qualified as LB+import Data.Text as T import Data.Time-import           Data.Aeson-import qualified Data.ByteString.Lazy          as LB-import qualified Data.ByteString          as B-import           Data.Text as T-import qualified StmContainers.Map             as SC-import qualified Data.Aeson as Aeson import Optics.TH+import StmContainers.Map qualified as SC  data RestError-  -- | An error response from discord-  = HTTPError-      { status   :: Int+  = -- | An error response from discord+    HTTPError+      { status :: Int       , response :: Maybe Value       }-  -- | Something failed while making the request (after retrying a few times)-  | InternalClientError T.Text-  deriving ( Show)+  | -- | Something failed while making the request (after retrying a few times)+    InternalClientError T.Text+  deriving (Show)  data BucketState = BucketState   { resetTime :: Maybe UTCTime-    -- ^ The time when the bucket resets, used to heuristically wait out ratelimits-  , resetKey  :: Int-    -- ^ The X-Ratelimit-Reset value discord gave us+  -- ^ The time when the bucket resets, used to heuristically wait out ratelimits+  , resetKey :: Int+  -- ^ The X-Ratelimit-Reset value discord gave us   , remaining :: Int-    -- ^ The number of uses left in the bucket, used to heuristically wait out ratelimits+  -- ^ The number of uses left in the bucket, used to heuristically wait out ratelimits   , limit :: Int-    -- ^ The total number of uses for this bucket+  -- ^ The total number of uses for this bucket   , ongoing :: Int-    -- ^ How many ongoing requests+  -- ^ How many ongoing requests   }-  deriving ( Show )+  deriving (Show)  newtype Bucket = Bucket   { state :: TVar BucketState@@ -52,41 +53,44 @@  data RateLimitState = RateLimitState   { bucketKeys :: SC.Map RouteKey B.ByteString-  , buckets    :: SC.Map B.ByteString Bucket+  , buckets :: SC.Map B.ByteString Bucket   , globalLock :: Event   }  data DiscordResponseType-  = Good-    -- ^ A good response-    LB.ByteString-    (Maybe (BucketState, B.ByteString))-    -- ^ The ratelimit headers if we got them-  | Ratelimited-    -- ^ We hit a 429, no response and ratelimited-    UTCTime-    -- ^ Retry after-    Bool-    -- ^ Global ratelimit-    (Maybe (BucketState, B.ByteString))-  | ServerError Int -- ^ Discord's error, we should retry (HTTP 5XX)-  | ClientError Int LB.ByteString -- ^ Our error, we should fail-  | InternalResponseError T.Text -- ^ Something went wrong with the http client+  = -- | A good response+    Good+      LB.ByteString+      (Maybe (BucketState, B.ByteString))+      -- ^ The ratelimit headers if we got them+  | -- | We hit a 429, no response and ratelimited+    Ratelimited+      UTCTime+      -- ^ Retry after+      Bool+      -- ^ Global ratelimit+      (Maybe (BucketState, B.ByteString))+  | -- | Discord's error, we should retry (HTTP 5XX)+    ServerError Int+  | -- | Our error, we should fail+    ClientError Int LB.ByteString+  | -- | Something went wrong with the http client+    InternalResponseError T.Text  newtype GatewayResponse = GatewayResponse   { url :: T.Text   }-  deriving stock ( Show )+  deriving stock (Show)  instance Aeson.FromJSON GatewayResponse where   parseJSON = Aeson.withObject "GatewayResponse" $ \v ->     GatewayResponse <$> v .: "url"  data BotGatewayResponse = BotGatewayResponse-  { url    :: T.Text+  { url :: T.Text   , shards :: Int   }-  deriving ( Show )+  deriving (Show)  instance Aeson.FromJSON BotGatewayResponse where   parseJSON = Aeson.withObject "BotGatewayResponse" $ \v ->

@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}+ -- | Invite endpoints module Calamity.HTTP.Invite (InviteRequest (..)) where 

@@ -21,5 +21,4 @@    route (Reason a _) = route a -  action (Reason a r) = \u o ->-    action a u (o <> header "X-Audit-Log-Reason" (encodeUtf8 r))+  action (Reason a r) u o = action a u (o <> header "X-Audit-Log-Reason" (encodeUtf8 r))

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}  -- | User endpoints module Calamity.HTTP.User (@@ -14,17 +15,17 @@ import Calamity.Types.Model.Guild import Calamity.Types.Model.User import Calamity.Types.Snowflake-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Default.Class import Data.Function ((&)) import Data.Text (Text)-import Optics.TH import Network.HTTP.Req+import Optics.TH  data ModifyUserData = ModifyUserData   { username :: Maybe Text-  , -- | The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data-    avatar :: Maybe Text+  , avatar :: Maybe Text+  -- ^ The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data   }   deriving (Show)   deriving (Aeson.ToJSON) via CalamityToJSON ModifyUserData@@ -88,7 +89,8 @@   action (ModifyCurrentUser o) = patchWith' $ ReqBodyJson o   action (GetCurrentUserGuilds GetCurrentUserGuildsOptions {before, after, limit}) =     getWithP-      ( "before" =:? (fromSnowflake <$> before) <> "after" =:? (fromSnowflake <$> after)+      ( "before" =:? (fromSnowflake <$> before)+          <> "after" =:? (fromSnowflake <$> after)           <> "limit" =:? limit       )   action (LeaveGuild _) = deleteWith

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}  -- | Webhook endpoints module Calamity.HTTP.Webhook (@@ -15,20 +16,19 @@ import Calamity.Types.Model.Channel import Calamity.Types.Model.Guild import Calamity.Types.Snowflake-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Default.Class import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Network.HTTP.Client.MultipartFormData import Network.HTTP.Req import Network.Mime import Optics-import PyF  data CreateWebhookData = CreateWebhookData   { username :: Maybe Text-  , -- | The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data-    avatar :: Maybe Text+  , avatar :: Maybe Text+  -- ^ The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data   }   deriving (Show)   deriving (Aeson.ToJSON) via CalamityToJSON CreateWebhookData@@ -44,8 +44,8 @@  data ModifyWebhookData = ModifyWebhookData   { username :: Maybe Text-  , -- | The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data-    avatar :: Maybe Text+  , avatar :: Maybe Text+  -- ^ The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data   , channelID :: Maybe (Snowflake Channel)   }   deriving (Show)

@@ -23,7 +23,7 @@  Displaying a 'View'   @- {-# LANGUAGE ApplicativeDo #-}+ {\-# LANGUAGE ApplicativeDo #-\}   let view = 'row' $ do        a <- 'button' 'Calamity.Types.Model.Channel.Component.ButtonPrimary' "defer"

@@ -14,10 +14,10 @@ import Calamity.Types.Model.User (User) import Calamity.Types.Snowflake import Control.Applicative ((<|>))-import Optics ((^.), (^?), _Just, (%)) import Data.Maybe (fromJust)+import Optics ((%), (^.), (^?), _Just) import Polysemy-import qualified Polysemy as P+import Polysemy qualified as P  data InteractionEff m a where   GetInteraction :: InteractionEff m Interaction@@ -39,4 +39,3 @@   let uid = int ^? #user % _Just % #id       mid = int ^? #member % _Just % #id   pure . fromJust $ uid <|> mid-

@@ -13,18 +13,18 @@ ) where  import Calamity.HTTP-import Calamity.Interactions.Eff (InteractionEff, getInteractionID, getInteractionToken, getInteractionUser, getApplicationID)+import Calamity.Interactions.Eff (InteractionEff, getApplicationID, getInteractionID, getInteractionToken, getInteractionUser) import Calamity.Metrics.Eff (MetricEff) import Calamity.Types.LogEff (LogEff) import Calamity.Types.Model.Channel.Component (Component (ActionRow')) import Calamity.Types.Model.User (User) import Calamity.Types.Snowflake (Snowflake) import Calamity.Types.Tellable-import Optics-import qualified Data.HashMap.Strict as H+import Data.HashMap.Strict qualified as H import Data.Text (Text)-import qualified Polysemy as P-import qualified Polysemy.State as P+import Optics+import Polysemy qualified as P+import Polysemy.State qualified as P import System.Random (getStdRandom, uniform)  {- | Provide local state semantics to a running view, the state is keyed to the@@ -50,7 +50,8 @@       )  -- | Respond to an interaction with a globally visible message-respond :: forall t r.+respond ::+  forall t r.   (P.Members '[InteractionEff, RatelimitEff, TokenEff, LogEff, MetricEff, P.Embed IO] r, ToMessage t) =>   t ->   P.Sem r (Either RestError ())@@ -72,7 +73,8 @@         invoke $ CreateResponseMessage interactionID interactionToken opts  -- | Respond to an interaction with an ephemeral message-respondEphemeral :: forall t r.+respondEphemeral ::+  forall t r.   (P.Members '[InteractionEff, RatelimitEff, TokenEff, LogEff, MetricEff, P.Embed IO] r, ToMessage t) =>   t ->   P.Sem r (Either RestError ())@@ -94,7 +96,8 @@         invoke $ CreateResponseMessage interactionID interactionToken opts  -- | Respond to an interaction by editing the message that triggered the interaction-edit :: forall t r.+edit ::+  forall t r.   (P.Members '[InteractionEff, RatelimitEff, TokenEff, LogEff, MetricEff, P.Embed IO] r, ToMessage t) =>   t ->   P.Sem r (Either RestError ())@@ -116,7 +119,8 @@         invoke $ CreateResponseUpdate interactionID interactionToken opts  -- | Create a follow up response to an interaction-followUp :: forall t r.+followUp ::+  forall t r.   (P.Members '[InteractionEff, RatelimitEff, TokenEff, LogEff, MetricEff, P.Embed IO] r, ToMessage t) =>   t ->   P.Sem r (Either RestError ())@@ -138,7 +142,8 @@         invoke $ CreateFollowupMessage applicationID interactionToken opts  -- | Create an ephemeral follow up response to an interaction-followUpEphemeral :: forall t r.+followUpEphemeral ::+  forall t r.   (P.Members '[InteractionEff, RatelimitEff, TokenEff, LogEff, MetricEff, P.Embed IO] r, ToMessage t) =>   t ->   P.Sem r (Either RestError ())@@ -166,8 +171,9 @@   interactionToken <- getInteractionToken   invoke $ CreateResponseDefer interactionID interactionToken False --- | Defer an interaction and show an ephemeral loading state, use @followUp@--- later on+{- | Defer an interaction and show an ephemeral loading state, use @followUp@+ later on+-} deferEphemeral :: P.Members '[InteractionEff, RatelimitEff, TokenEff, LogEff, MetricEff, P.Embed IO] r => P.Sem r (Either RestError ()) deferEphemeral = do   interactionID <- getInteractionID

@@ -28,24 +28,24 @@ import Calamity.Metrics.Eff (MetricEff) import Calamity.Types.LogEff (LogEff) import Calamity.Types.Model.Channel.Component (CustomID)-import qualified Calamity.Types.Model.Channel.Component as C+import Calamity.Types.Model.Channel.Component qualified as C import Calamity.Types.Model.Channel.Message (Message) import Calamity.Types.Model.Interaction import Calamity.Types.TokenEff (TokenEff)-import qualified Control.Concurrent.STM as STM-import Optics+import Control.Concurrent.STM qualified as STM import Control.Monad (guard, void)-import qualified Data.Aeson as Aeson-import qualified Data.List-import qualified Data.Set as S+import Data.Aeson ((.:), (.:?))+import Data.Aeson qualified as Aeson+import Data.Aeson.Optics+import Data.List qualified+import Data.Set qualified as S import Data.Text (Text)-import qualified GHC.TypeLits as E-import qualified Polysemy as P-import qualified Polysemy.Resource as P-import qualified Polysemy.State as P+import GHC.TypeLits qualified as E+import Optics+import Polysemy qualified as P+import Polysemy.Resource qualified as P+import Polysemy.State qualified as P import System.Random-import Data.Aeson ((.:?), (.:))-import Data.Aeson.Optics  data ViewComponent a = ViewComponent   { component :: C.Component@@ -322,14 +322,15 @@       void . invoke $ DeleteMessage m m     Left _ -> pure () --- | Run a 'View', returning the value passed to 'endView'------ This function will not return until 'endView' is used inside the view.--- If you want it to run in the background, consider using "Polysemy.Async".------ This is async exception safe, you can use libraries such as--- [polysemy-conc](https://hackage.haskell.org/package/polysemy-conc) to stop--- views after a timeout.+{- | Run a 'View', returning the value passed to 'endView'++ This function will not return until 'endView' is used inside the view.+ If you want it to run in the background, consider using "Polysemy.Async".++ This is async exception safe, you can use libraries such as+ [polysemy-conc](https://hackage.haskell.org/package/polysemy-conc) to stop+ views after a timeout.+-} runView ::   BotC r =>   -- | The initial view to render

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}  -- | A thing for storing the last N things with IDs module Calamity.Internal.BoundedStore (@@ -9,14 +10,14 @@   dropItem, ) where -import Calamity.Internal.Utils ( unlessM, whenM )-import Calamity.Types.Snowflake ( HasID(getID), Snowflake, HasID' )-import Control.Monad.State.Lazy ( when, execState )-import Data.Default.Class ( Default(..) )+import Calamity.Internal.Utils (unlessM, whenM)+import Calamity.Types.Snowflake (HasID (getID), HasID', Snowflake)+import Control.Monad.State.Lazy (execState, when)+import Data.Default.Class (Default (..)) import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as H+import Data.HashMap.Strict qualified as H import Deque.Lazy (Deque)-import qualified Deque.Lazy as DQ+import Deque.Lazy qualified as DQ import Optics import Optics.State.Operators ((%=), (.=)) 

@@ -1,9 +1,10 @@ -- | Get the constructor name of something-module Calamity.Internal.ConstructorName-    ( CtorName(..)-    , GCtorName(..) ) where+module Calamity.Internal.ConstructorName (+  CtorName (..),+  GCtorName (..),+) where -import           GHC.Generics+import GHC.Generics  class GCtorName f where   gctorName :: f a -> String

@@ -1,3 +1,7 @@+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++{-# HLINT ignore "Redundant bracket due to operator fixities" #-}+ -- | An internal newtype for parsing colours module Calamity.Internal.IntColour (   IntColour (..),

@@ -1,14 +1,15 @@ {-# LANGUAGE TemplateHaskell #-}  -- | A Writer monad that supports local writing, reverse reader I guess?-module Calamity.Internal.LocalWriter-    ( LocalWriter(..)-    , ltell-    , llisten-    , runLocalWriter ) where+module Calamity.Internal.LocalWriter (+  LocalWriter (..),+  ltell,+  llisten,+  runLocalWriter,+) where -import qualified Polysemy       as P-import qualified Polysemy.State as P+import Polysemy qualified as P+import Polysemy.State qualified as P  data LocalWriter o m a where   Ltell :: o -> LocalWriter o m ()@@ -17,11 +18,14 @@ P.makeSem ''LocalWriter  runLocalWriter :: Monoid o => P.Sem (LocalWriter o ': r) a -> P.Sem r (o, a)-runLocalWriter = P.runState mempty . P.reinterpretH-  (\case-     Ltell o   -> do-       P.modify' (<> o) >>= P.pureT-     Llisten m -> do-       mm <- P.runT m-       (o, fa) <- P.raise $ runLocalWriter mm-       pure $ fmap (o, ) fa)+runLocalWriter =+  P.runState mempty+    . P.reinterpretH+      ( \case+          Ltell o -> do+            P.modify' (<> o) >>= P.pureT+          Llisten m -> do+            mm <- P.runT m+            (o, fa) <- P.raise $ runLocalWriter mm+            pure $ fmap (o,) fa+      )

@@ -1,14 +1,13 @@-{-# LANGUAGE TemplateHaskell #-}- -- | Something for converting polysemy actions into IO actions-module Calamity.Internal.RunIntoIO-    ( runSemToIO-    , bindSemToIO ) where+module Calamity.Internal.RunIntoIO (+  runSemToIO,+  bindSemToIO,+) where -import           Data.Functor+import Data.Functor -import qualified Polysemy                         as P-import qualified Polysemy.Final                   as P+import Polysemy qualified as P+import Polysemy.Final qualified as P  runSemToIO :: forall r a. P.Member (P.Final IO) r => P.Sem r a -> P.Sem r (IO (Maybe a)) runSemToIO m = P.withStrategicToFinal $ do

@@ -5,9 +5,9 @@ import Calamity.Types.Snowflake import Data.Aeson (FromJSON (..), ToJSON (..), withArray) import Data.Data-import qualified Data.Foldable as F+import Data.Foldable qualified as F import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as SH+import Data.HashMap.Strict qualified as SH import Data.Hashable import GHC.Exts (IsList) import Optics

@@ -1,8 +1,8 @@ -- | Internal newtype for deserializing timestamps module Calamity.Internal.UnixTimestamp (-    UnixTimestamp (..),-    unixToMilliseconds,-    millisecondsToUnix,+  UnixTimestamp (..),+  unixToMilliseconds,+  millisecondsToUnix, ) where  import Calamity.Internal.Utils ()@@ -15,46 +15,46 @@ import TextShow  newtype UnixTimestamp = UnixTimestamp-    { unUnixTimestamp :: UTCTime-    }-    deriving (Show) via UTCTime-    deriving (TextShow) via FromStringShow UTCTime+  { unUnixTimestamp :: UTCTime+  }+  deriving (Show) via UTCTime+  deriving (TextShow) via FromStringShow UTCTime  unixToMilliseconds :: UnixTimestamp -> Word64 unixToMilliseconds =-    unUnixTimestamp-        >>> utcTimeToPOSIXSeconds-        >>> toRational-        >>> (* 1000)-        >>> round+  unUnixTimestamp+    >>> utcTimeToPOSIXSeconds+    >>> toRational+    >>> (* 1000)+    >>> round  millisecondsToUnix :: Word64 -> UnixTimestamp millisecondsToUnix =-    toRational-        >>> fromRational-        >>> (/ 1000)-        >>> posixSecondsToUTCTime-        >>> UnixTimestamp+  toRational+    >>> fromRational+    >>> (/ 1000)+    >>> posixSecondsToUTCTime+    >>> UnixTimestamp  instance ToJSON UnixTimestamp where-    toJSON =-        unUnixTimestamp-            >>> utcTimeToPOSIXSeconds-            >>> toRational-            >>> round-            >>> toJSON @Word64-    toEncoding =-        unUnixTimestamp-            >>> utcTimeToPOSIXSeconds-            >>> toRational-            >>> round-            >>> word64+  toJSON =+    unUnixTimestamp+      >>> utcTimeToPOSIXSeconds+      >>> toRational+      >>> round+      >>> toJSON @Word64+  toEncoding =+    unUnixTimestamp+      >>> utcTimeToPOSIXSeconds+      >>> toRational+      >>> round+      >>> word64  instance FromJSON UnixTimestamp where-    parseJSON =-        withScientific "UnixTimestamp" $-            toRational-                >>> fromRational-                >>> posixSecondsToUTCTime-                >>> UnixTimestamp-                >>> pure+  parseJSON =+    withScientific "UnixTimestamp" $+      toRational+        >>> fromRational+        >>> posixSecondsToUTCTime+        >>> UnixTimestamp+        >>> pure

@@ -29,16 +29,16 @@ import Calamity.Internal.RunIntoIO import Calamity.Types.LogEff import Control.Applicative-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Aeson.Encoding (null_) import Data.Default.Class-import qualified Data.Map as M+import Data.Map qualified as M import Data.Maybe (catMaybes) import Data.Semigroup (Last (..)) import Data.Text-import qualified Data.Vector.Unboxing as VU-import qualified DiPolysemy as Di-import qualified Polysemy as P+import Data.Vector.Unboxing qualified as VU+import DiPolysemy qualified as Di+import Polysemy qualified as P import TextShow  {- | Like whileM, but stateful effects are not preserved to mitigate memory leaks

@@ -17,7 +17,7 @@  import Calamity.Metrics.Internal import Data.Default.Class-import qualified Data.Map as Map+import Data.Map qualified as Map import Data.Text import Optics.TH import Polysemy

@@ -1,8 +1,9 @@ -- | Internal data structures to the metrics effect-module Calamity.Metrics.Internal-    ( Counter(..)-    , Gauge(..)-    , Histogram(..) ) where+module Calamity.Metrics.Internal (+  Counter (..),+  Gauge (..),+  Histogram (..),+) where  -- | A handle to a counter newtype Counter = Counter

@@ -1,20 +1,18 @@ -- | Noop handler for metrics-module Calamity.Metrics.Noop-    ( runMetricsNoop ) where+module Calamity.Metrics.Noop (runMetricsNoop) where -import           Calamity.Metrics.Eff-import           Calamity.Metrics.Internal+import Calamity.Metrics.Eff+import Calamity.Metrics.Internal -import           Data.Default.Class+import Data.Default.Class -import           Polysemy+import Polysemy  runMetricsNoop :: Sem (MetricEff ': r) a -> Sem r a runMetricsNoop = interpret $ \case-  RegisterCounter _ _     -> pure (Counter 0)-  RegisterGauge _ _       -> pure (Gauge 0)-  RegisterHistogram _ _ _ -> pure (Histogram 0)--  AddCounter _ _          -> pure def-  ModifyGauge _ _         -> pure def-  ObserveHistogram _ _    -> pure def+  RegisterCounter _ _ -> pure (Counter 0)+  RegisterGauge _ _ -> pure (Gauge 0)+  RegisterHistogram {} -> pure (Histogram 0)+  AddCounter _ _ -> pure def+  ModifyGauge _ _ -> pure def+  ObserveHistogram _ _ -> pure def

@@ -1,15 +1,15 @@ -- | Things that can be fetched from the discord CDN-module Calamity.Types.CDNAsset-  ( CDNAsset (..),-    fetchAsset,-    fetchAsset',-  )+module Calamity.Types.CDNAsset (+  CDNAsset (..),+  fetchAsset,+  fetchAsset',+) where -import qualified Control.Exception.Safe as Ex+import Control.Exception.Safe qualified as Ex import Data.ByteString.Lazy (ByteString)-import qualified Network.HTTP.Req as Req-import qualified Polysemy as P+import Network.HTTP.Req qualified as Req+import Polysemy qualified as P  -- | Retrieve the asset from the CDN, like 'fetchAsset' but gives you more control fetchAsset' :: (CDNAsset a, Req.MonadHttp m) => a -> m ByteString

@@ -6,11 +6,11 @@   LogC, ) where -import qualified Df1+import Df1 qualified  import DiPolysemy -import qualified Polysemy as P+import Polysemy qualified as P  type LogEff = Di Df1.Level Df1.Path Df1.Message 

@@ -10,7 +10,7 @@ import {-# SOURCE #-} Calamity.Types.Model.User import Calamity.Types.Snowflake (Snowflake, fromSnowflake) import Calamity.Utils.CDNUrl (assetHashFile, cdnURL)-import qualified Data.Text as T+import Data.Text qualified as T import Network.HTTP.Req ((/:), (/~)) import Optics (makeFieldLabelsNoPrefix) import TextShow (showt)

@@ -30,7 +30,7 @@ import Calamity.Types.Model.Guild.Permissions (Permissions) import Calamity.Types.Snowflake import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Text (Text) import Optics.TH import TextShow.TH

@@ -7,7 +7,7 @@  import Calamity.Types.Snowflake import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Text (Text) import Data.Word import Optics.TH

@@ -3,7 +3,7 @@ -- | Types of channels module Calamity.Types.Model.Channel.ChannelType (ChannelType (..)) where -import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Scientific import Optics.TH import TextShow.TH

@@ -26,14 +26,14 @@ import Calamity.Types.Model.Guild.Emoji import Control.Monad (replicateM) import Data.Aeson ((.!=), (.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson+import Data.Maybe (catMaybes) import Data.Scientific (toBoundedInteger)-import qualified Data.Text as T+import Data.Text qualified as T import Optics.TH import System.Random (Uniform) import System.Random.Stateful (Uniform (uniformM), UniformRange (uniformRM)) import TextShow.TH-import Data.Maybe (catMaybes)  newtype CustomID = CustomID T.Text   deriving stock (Eq, Ord, Show)@@ -131,7 +131,6 @@ $(deriveTextShow ''Button) $(makeFieldLabelsNoPrefix ''Button) - instance Aeson.FromJSON Button where   parseJSON = Aeson.withObject "Components.Button" $ \v ->     Button@@ -153,13 +152,13 @@  instance CalamityToJSON' LinkButton where   toPairs LinkButton {..} =-      [ "style" .= style-      , "label" .?= label-      , "emoji" .?= emoji-      , "url" .= url-      , "disabled" .= disabled-      , "type" .= ButtonType-      ]+    [ "style" .= style+    , "label" .?= label+    , "emoji" .?= emoji+    , "url" .= url+    , "disabled" .= disabled+    , "type" .= ButtonType+    ]  instance Aeson.FromJSON LinkButton where   parseJSON = Aeson.withObject "Components.Linkbutton" $ \v ->@@ -219,12 +218,12 @@  instance CalamityToJSON' SelectOption where   toPairs SelectOption {..} =-      [ "label" .= label-      , "value" .= value-      , "description" .?= description-      , "emoji" .?= emoji-      , "default" .= default_-      ]+    [ "label" .= label+    , "value" .= value+    , "description" .?= description+    , "emoji" .?= emoji+    , "default" .= default_+    ]  instance Aeson.FromJSON SelectOption where   parseJSON = Aeson.withObject "Components.SelectOption" $ \v ->@@ -251,14 +250,14 @@  instance CalamityToJSON' Select where   toPairs Select {..} =-      [ "options" .= options-      , "placeholder" .?= placeholder-      , "min_values" .?= minValues-      , "max_values" .?= maxValues-      , "disabled" .= disabled-      , "custom_id" .= customID-      , "type" .= SelectType-      ]+    [ "options" .= options+    , "placeholder" .?= placeholder+    , "min_values" .?= minValues+    , "max_values" .?= maxValues+    , "disabled" .= disabled+    , "custom_id" .= customID+    , "type" .= SelectType+    ]  instance Aeson.FromJSON Select where   parseJSON = Aeson.withObject "Components.Select" $ \v ->@@ -322,16 +321,16 @@  instance CalamityToJSON' TextInput where   toPairs TextInput {..} =-      [ "style" .= style-      , "label" .= label-      , "min_length" .= minLength-      , "max_length" .= maxLength-      , "required" .= required-      , "value" .= value-      , "placeholder" .= placeholder-      , "custom_id" .= customID-      , "type" .= TextInputType-      ]+    [ "style" .= style+    , "label" .= label+    , "min_length" .= minLength+    , "max_length" .= maxLength+    , "required" .= required+    , "value" .= value+    , "placeholder" .= placeholder+    , "custom_id" .= customID+    , "type" .= TextInputType+    ]  instance Aeson.FromJSON TextInput where   parseJSON = Aeson.withObject "Components.TextInput" $ \v ->

@@ -8,10 +8,10 @@ import Calamity.Types.Model.User import Calamity.Types.Snowflake import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Time import Optics.TH-import qualified TextShow+import TextShow qualified  data DMChannel = DMChannel   { id :: Snowflake DMChannel

@@ -21,7 +21,7 @@ import Calamity.Internal.IntColour (IntColour (..)) import Calamity.Internal.Utils (CalamityToJSON (..), CalamityToJSON' (..), (.=), (.?=)) import Data.Aeson ((.!=), (.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Colour (Colour) import Data.Default.Class import Data.Semigroup@@ -30,7 +30,7 @@ import Data.Word import Optics ((%~), (&), (^.)) import Optics.TH-import qualified TextShow+import TextShow qualified import TextShow.TH  data Embed = Embed

@@ -8,11 +8,11 @@ import Calamity.Types.Model.User import Calamity.Types.Snowflake import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Text (Text) import Data.Time import Optics.TH-import qualified TextShow+import TextShow qualified  data GroupChannel = GroupChannel   { id :: Snowflake GroupChannel

@@ -16,7 +16,7 @@ import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild import Calamity.Types.Snowflake import Data.Aeson ((.:))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Optics ((^.)) import Optics.TH import TextShow.TH

@@ -8,7 +8,7 @@ import Calamity.Types.Model.Guild.Overwrite import Calamity.Types.Snowflake import Data.Aeson ((.!=), (.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Text (Text) import Optics.TH import TextShow.TH

@@ -10,11 +10,11 @@ import Calamity.Types.Model.Guild.Overwrite import Calamity.Types.Snowflake import Data.Aeson ((.!=), (.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Text (Text) import Data.Time import Optics.TH-import qualified TextShow+import TextShow qualified  data TextChannel = TextChannel   { id :: Snowflake TextChannel

@@ -10,7 +10,7 @@ import Calamity.Types.Model.Guild.Overwrite import Calamity.Types.Snowflake import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Text (Text) import Optics.TH import TextShow.TH

@@ -24,15 +24,15 @@ import Calamity.Types.Model.User import Calamity.Types.Snowflake import Data.Aeson ((.!=), (.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Maybe (isJust) import Data.Scientific import Data.Text (Text) import Data.Time-import qualified Data.Vector.Unboxing as UV+import Data.Vector.Unboxing qualified as UV import Data.Word (Word64) import Optics.TH-import qualified TextShow+import TextShow qualified import TextShow.TH  data MessageAuthorWebhook = MessageAuthorWebhook@@ -114,7 +114,9 @@                 ( \v ->                     Webhook'                       <$> ( MessageAuthorWebhook-                              <$> v .: "id" <*> v .: "username" <*> v .:? "avatar"+                              <$> v .: "id"+                              <*> v .: "username"+                              <*> v .:? "avatar"                           )                 )                 =<< v .: "author"

@@ -6,7 +6,7 @@ import Calamity.Internal.Utils (CalamityToJSON (..), CalamityToJSON' (toPairs), (.=)) import Calamity.Types.Model.Guild.Emoji import Data.Aeson ((.:))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Optics.TH import TextShow.TH 

@@ -11,13 +11,13 @@ import Calamity.Types.Model.User import Calamity.Types.Snowflake import Data.Aeson ((.:), (.:!), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Text (Text) import Data.Time-import qualified Data.Vector.Unboxing as UV+import Data.Vector.Unboxing qualified as UV import Data.Word import Optics.TH-import qualified TextShow+import TextShow qualified  data UpdatedMessage = UpdatedMessage   { id :: Snowflake Message

@@ -8,7 +8,7 @@ import Calamity.Types.Model.User import Calamity.Types.Snowflake import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Text (Text) import Optics.TH import TextShow.TH

@@ -14,11 +14,11 @@ import Calamity.Types.Model.User import Calamity.Types.Snowflake import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Scientific import Data.Text (Text) import Optics.TH-import qualified TextShow+import TextShow qualified import TextShow.TH  data AuditLog = AuditLog

@@ -7,7 +7,7 @@ import Calamity.Types.Model.User import Calamity.Types.Snowflake import Data.Aeson ((.:))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Optics.TH import TextShow.TH 

@@ -15,18 +15,18 @@   (.=),  ) import Calamity.Types.CDNAsset (CDNAsset (..))-import Calamity.Types.Model.Guild.Role+import {-# SOURCE #-} Calamity.Types.Model.Guild.Role import Calamity.Types.Model.User import Calamity.Types.Snowflake import Calamity.Utils.CDNUrl (cdnURL) import Data.Aeson ((.!=), (.:), (.:?))-import qualified Data.Aeson as Aeson-import qualified Data.Text as T+import Data.Aeson qualified as Aeson+import Data.Text qualified as T import Data.Vector.Unboxing (Vector) import Network.HTTP.Req ((/:)) import Optics.TH import TextShow (showt)-import qualified TextShow+import TextShow qualified  data Emoji = Emoji   { id :: Snowflake Emoji

@@ -1,13 +0,0 @@--- | Discord Emojis-module Calamity.Types.Model.Guild.Emoji-    ( RawEmoji-    ) where--import Data.Aeson--data RawEmoji--instance Show RawEmoji-instance Eq RawEmoji--instance FromJSON RawEmoji

@@ -12,7 +12,7 @@ ) where  import Calamity.Internal.SnowflakeMap (SnowflakeMap)-import qualified Calamity.Internal.SnowflakeMap as SM+import Calamity.Internal.SnowflakeMap qualified as SM import Calamity.Internal.Utils (CalamityToJSON (..), CalamityToJSON' (..), (.=)) import Calamity.Types.CDNAsset (CDNAsset (..)) import Calamity.Types.Model.Channel@@ -25,17 +25,17 @@ import Calamity.Types.Snowflake import Calamity.Utils.CDNUrl (assetHashFile, cdnURL) import Data.Aeson ((.!=), (.:), (.:?))-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson+import Data.Aeson qualified as Aeson+import Data.Aeson.Types qualified as Aeson import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as LH+import Data.HashMap.Strict qualified as LH import Data.Maybe-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time import Data.Word import Network.HTTP.Req ((/:), (/~)) import Optics-import qualified TextShow+import TextShow qualified import TextShow.TH (deriveTextShow)  data GuildIcon = GuildIcon@@ -132,7 +132,8 @@      presences' <- do       presences' <- v .: "presences"-      pure . LH.fromList+      pure+        . LH.fromList         . mapMaybe           ( Aeson.parseMaybe @Aeson.Object @(Snowflake User, Presence)               ( \m -> do

@@ -7,11 +7,11 @@ import Calamity.Types.Model.Guild.Guild import Calamity.Types.Model.User import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Text (Text) import Data.Time (UTCTime) import Optics.TH-import qualified TextShow+import TextShow qualified  data Invite = Invite   { code :: Text

@@ -10,16 +10,16 @@ import Calamity.Types.Model.User import Calamity.Types.Snowflake import Data.Aeson ((.!=), (.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Colour (Colour) import Data.Text (Text) import Data.Text.Read (decimal) import Data.Time import Data.Vector.Unboxing (Vector)-import qualified Data.Vector.Unboxing as V+import Data.Vector.Unboxing qualified as V import Data.Word (Word64) import Optics.TH-import qualified TextShow+import TextShow qualified  data Member = Member   { id :: Snowflake User

@@ -7,7 +7,7 @@ import Calamity.Types.Model.Guild.Permissions import Calamity.Types.Snowflake import Data.Aeson ((.:))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Optics.TH import TextShow.TH 

@@ -9,18 +9,18 @@ import Calamity.Internal.IntColour import Calamity.Internal.Utils import Calamity.Types.CDNAsset (CDNAsset (..))-import {-# SOURCE #-} Calamity.Types.Model.Guild.Emoji+import Calamity.Types.Model.Guild.Emoji import Calamity.Types.Model.Guild.Permissions import Calamity.Types.Snowflake import Calamity.Utils.CDNUrl (assetHashFile, cdnURL) import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Colour import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Network.HTTP.Req ((/:), (/~)) import Optics.TH-import qualified TextShow+import TextShow qualified  data RoleIcon = RoleIcon   { roleID :: Snowflake Role@@ -64,6 +64,7 @@   parseJSON = Aeson.withObject "Role" $ \v -> do     id <- v .: "id"     icon <- (RoleIcon id <$>) <$> v .: "icon"+    emoji <- (UnicodeEmoji <$>) <$> v .:? "unicode_emoji"      Role       <$> pure id@@ -71,7 +72,7 @@       <*> (fromIntColour <$> v .: "color")       <*> v .: "hoist"       <*> pure icon-      <*> v .:? "unicode_emoji"+      <*> pure emoji       <*> v .: "position"       <*> v .: "permissions"       <*> v .: "managed"

@@ -0,0 +1,16 @@+-- | Guild roles+module Calamity.Types.Model.Guild.Role (+  Role,+  RoleIcon,+) where++import Data.Aeson++data RoleIcon++data Role++instance Show Role+instance Eq Role++instance FromJSON Role

@@ -7,7 +7,7 @@ import Calamity.Types.Model.Guild.Guild import Calamity.Types.Snowflake import Data.Aeson ((.!=), (.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Optics.TH import TextShow.TH 

@@ -18,13 +18,13 @@ import Calamity.Types.Model.Guild.Member (Member) import Calamity.Types.Model.User (User) import Calamity.Types.Snowflake-import Data.Aeson ((.:), (.:?), (.!=))-import qualified Data.Aeson as Aeson-import qualified Data.HashMap.Strict as H+import Data.Aeson ((.!=), (.:), (.:?))+import Data.Aeson qualified as Aeson+import Data.HashMap.Strict qualified as H import Data.Scientific (toBoundedInteger)-import qualified Data.Text as T+import Data.Text qualified as T import Optics.TH-import qualified TextShow+import TextShow qualified import TextShow.TH  -- | Empty type to flag application IDs

@@ -15,13 +15,13 @@ import Calamity.Internal.Utils import Calamity.Types.Snowflake import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Scientific import Data.Text (Text) import Data.Time (UTCTime) import Data.Word import Optics.TH-import qualified TextShow+import TextShow qualified import TextShow.TH  data ActivityType

@@ -12,7 +12,7 @@ import Calamity.Types.Model.User import Calamity.Types.Snowflake import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Text (Text) import Optics.TH import TextShow.TH

@@ -16,15 +16,15 @@ import Calamity.Types.Snowflake import Calamity.Utils.CDNUrl (assetHashFile, cdnURL) import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Colour (Colour) import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Text.Read (decimal) import Data.Word import Network.HTTP.Req ((/:), (/~)) import Optics.TH-import qualified TextShow+import TextShow qualified import TextShow.TH  data UserBanner = UserBanner@@ -85,7 +85,7 @@ newtype instance Partial User = PartialUser   { id :: Snowflake User   }-  deriving (Show, Eq)+  deriving stock (Show, Eq)   deriving (HasID User) via HasIDField "id" (Partial User)  instance Aeson.FromJSON (Partial User) where

@@ -3,13 +3,13 @@ -- | Voice regions module Calamity.Types.Model.Voice.VoiceRegion (VoiceRegion (..)) where +import Calamity.Internal.Utils import Calamity.Types.Snowflake import Data.Aeson ((.:))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Text (Text) import Optics.TH import TextShow.TH-import Calamity.Internal.Utils  data VoiceRegion = VoiceRegion   { id :: Snowflake VoiceRegion@@ -24,13 +24,13 @@  instance CalamityToJSON' VoiceRegion where   toPairs VoiceRegion {..} =-      [ "id" .= id-      , "name" .= name-      , "vip" .= vip-      , "optimal" .= optimal-      , "deprecated" .= deprecated-      , "custom" .= custom-      ]+    [ "id" .= id+    , "name" .= name+    , "vip" .= vip+    , "optimal" .= optimal+    , "deprecated" .= deprecated+    , "custom" .= custom+    ]  instance Aeson.FromJSON VoiceRegion where   parseJSON = Aeson.withObject "VoiceRegion" $ \v ->

@@ -8,7 +8,7 @@ import Calamity.Types.Model.User import Calamity.Types.Snowflake import Data.Aeson ((.:), (.:?))-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Text (Text) import Optics.TH import TextShow.TH

@@ -15,7 +15,7 @@ import Data.Hashable import Data.Kind import Data.Text.Read-import qualified Data.Vector.Unboxing as U+import Data.Vector.Unboxing qualified as U import Data.Word import GHC.Records (HasField (getField)) import TextShow@@ -26,7 +26,7 @@ newtype Snowflake (t :: Type) = Snowflake   { fromSnowflake :: Word64   }-  deriving (Eq, Ord, Data)+  deriving stock (Eq, Ord, Data)   deriving newtype (Show, TextShow, FromJSONKey)   deriving newtype (ToJSONKey, U.Unboxable)   deriving newtype (ToHttpApiData)

@@ -25,11 +25,11 @@ import Calamity.Types.Snowflake import Data.Default.Class import Data.Monoid-import qualified Data.Text as T-import qualified Data.Text.Lazy as L+import Data.Text qualified as T+import Data.Text.Lazy qualified as L import Optics-import qualified Polysemy as P-import qualified Polysemy.Error as P+import Polysemy qualified as P+import Polysemy.Error qualified as P  -- | A wrapper type for allowing mentions newtype TMention a = TMention (Snowflake a)

@@ -1,24 +1,24 @@ -- | Things that can be upgraded from snowflakes to their full data-module Calamity.Types.Upgradeable-    ( Upgradeable(..) ) where+module Calamity.Types.Upgradeable (Upgradeable (..)) where -import           Calamity.Cache.Eff-import           Calamity.Client.Types-import           Calamity.HTTP                  as H-import           Calamity.Internal.Utils-import qualified Calamity.Internal.SnowflakeMap as SM-import           Calamity.Types.Model.Channel-import           Calamity.Types.Model.Guild-import           Calamity.Types.Model.User-import           Calamity.Types.Snowflake-import           Control.Applicative-import           Optics-import qualified Polysemy                       as P-import qualified Polysemy.Fail                  as P-import qualified Polysemy.NonDet                as P+import Calamity.Cache.Eff+import Calamity.Client.Types+import Calamity.HTTP as H+import Calamity.Internal.SnowflakeMap qualified as SM+import Calamity.Internal.Utils+import Calamity.Types.Model.Channel+import Calamity.Types.Model.Guild+import Calamity.Types.Model.User+import Calamity.Types.Snowflake+import Control.Applicative+import Optics+import Polysemy qualified as P+import Polysemy.Fail qualified as P+import Polysemy.NonDet qualified as P --- | A typeclass that represents snowflakes that can be upgraded to their--- complete data, either through the cache or HTTP.+{- | A typeclass that represents snowflakes that can be upgraded to their+ complete data, either through the cache or HTTP.+-} class Upgradeable a ids | a -> ids, ids -> a where   -- | Upgrade a snowflake to its complete data.   --@@ -85,30 +85,34 @@         pure c'  instance Upgradeable VoiceChannel (Snowflake VoiceChannel) where-    upgrade s = upgrade (coerceSnowflake @_ @Channel s) <&> \case-            Just (GuildChannel' (GuildVoiceChannel vc)) -> Just vc-            _ -> Nothing+  upgrade s =+    upgrade (coerceSnowflake @_ @Channel s) <&> \case+      Just (GuildChannel' (GuildVoiceChannel vc)) -> Just vc+      _ -> Nothing  instance Upgradeable DMChannel (Snowflake DMChannel) where-    upgrade s = upgrade (coerceSnowflake @_ @Channel s) <&> \case-            Just (DMChannel' dc) -> Just dc-            _ -> Nothing+  upgrade s =+    upgrade (coerceSnowflake @_ @Channel s) <&> \case+      Just (DMChannel' dc) -> Just dc+      _ -> Nothing  instance Upgradeable GroupChannel (Snowflake GroupChannel) where-    upgrade s = upgrade (coerceSnowflake @_ @Channel s) <&> \case-            Just (GroupChannel' gc) -> Just gc-            _ -> Nothing+  upgrade s =+    upgrade (coerceSnowflake @_ @Channel s) <&> \case+      Just (GroupChannel' gc) -> Just gc+      _ -> Nothing  instance Upgradeable TextChannel (Snowflake TextChannel) where-    upgrade s = upgrade (coerceSnowflake @_ @Channel s) <&> \case-            Just (GuildChannel' (GuildTextChannel tc)) -> Just tc-            _ -> Nothing+  upgrade s =+    upgrade (coerceSnowflake @_ @Channel s) <&> \case+      Just (GuildChannel' (GuildTextChannel tc)) -> Just tc+      _ -> Nothing  instance Upgradeable Category (Snowflake Category) where-    upgrade s = upgrade (coerceSnowflake @_ @Channel s) <&> \case-            Just (GuildChannel' (GuildCategory c)) -> Just c-            _ -> Nothing-+  upgrade s =+    upgrade (coerceSnowflake @_ @Channel s) <&> \case+      Just (GuildChannel' (GuildCategory c)) -> Just c+      _ -> Nothing  instance Upgradeable Emoji (Snowflake Guild, Snowflake Emoji) where   upgrade (gid, eid) = P.runNonDetMaybe (getcache <|> gethttp)

@@ -1,9 +1,10 @@ -- | Useful things-module Calamity.Utils-    ( module Calamity.Utils.Permissions-    , module Calamity.Utils.Message-    , module Calamity.Utils.Colour ) where+module Calamity.Utils (+  module Calamity.Utils.Permissions,+  module Calamity.Utils.Message,+  module Calamity.Utils.Colour,+) where -import           Calamity.Utils.Colour-import           Calamity.Utils.Message-import           Calamity.Utils.Permissions+import Calamity.Utils.Colour+import Calamity.Utils.Message+import Calamity.Utils.Permissions

@@ -5,8 +5,8 @@   isGIFAsset, ) where -import qualified Data.Text as T-import qualified Network.HTTP.Req as Req+import Data.Text qualified as T+import Network.HTTP.Req qualified as Req  -- | The CDN URL cdnURL :: Req.Url 'Req.Https@@ -16,7 +16,8 @@ isGIFAsset :: T.Text -> Bool isGIFAsset = T.isPrefixOf "a_" --- | Generate \'hash.ext\' for an asset hash. @ext@ will be \'gif\' for animated--- assets, \'png\' otherwise.+{- | Generate \'hash.ext\' for an asset hash. @ext@ will be \'gif\' for animated+ assets, \'png\' otherwise.+-} assetHashFile :: T.Text -> T.Text assetHashFile h = if isGIFAsset h then h <> ".gif" else h <> ".png"

@@ -1,15 +1,17 @@ -- | Discord colour utilities-module Calamity.Utils.Colour-    ( colourToWord64-    , colourFromWord64-    -- * Useful colours-    , blurple-    , greyple ) where+module Calamity.Utils.Colour (+  colourToWord64,+  colourFromWord64, -import           Calamity.Internal.IntColour+  -- * Useful colours+  blurple,+  greyple,+) where -import           Data.Colour-import           Data.Colour.SRGB            ( sRGB24 )+import Calamity.Internal.IntColour++import Data.Colour+import Data.Colour.SRGB (sRGB24)  blurple :: (Ord a, Floating a) => Colour a blurple = sRGB24 0x72 0x89 0xda

@@ -39,7 +39,7 @@ import Data.Foldable (Foldable (foldl')) import Data.Maybe (fromMaybe) import Data.String (IsString, fromString)-import qualified Data.Text as T+import Data.Text qualified as T import GHC.Records (HasField (getField)) import Optics import TextShow (TextShow (showt))@@ -101,7 +101,9 @@   T.Text ->   T.Text codeblock' lang content =-  "```" <> fromMaybe "" lang <> "\n"+  "```"+    <> fromMaybe "" lang+    <> "\n"     <> escapeCodeblocks content     <> "\n```" @@ -227,9 +229,8 @@   -- | If discord should error when replying to deleted messages   Bool ->   MessageReference-asReference msg failIfNotExists =+asReference msg =   MessageReference     (Just $ getID @Message msg)     (Just $ getID @Channel msg)     (msg ^. #guildID)-    failIfNotExists

@@ -1,39 +1,41 @@ -- | Permission utilities-module Calamity.Utils.Permissions-    ( basePermissions-    , applyOverwrites-    , PermissionsIn(..)-    , PermissionsIn'(..) ) where+module Calamity.Utils.Permissions (+  basePermissions,+  applyOverwrites,+  PermissionsIn (..),+  PermissionsIn' (..),+) where -import           Calamity.Client.Types-import           Calamity.Types.Model.Channel.Guild-import           Calamity.Types.Model.Guild.Guild-import           Calamity.Types.Model.Guild.Member-import           Calamity.Types.Model.Guild.Overwrite-import           Calamity.Types.Model.Guild.Permissions-import           Calamity.Types.Model.User-import           Calamity.Types.Snowflake-import           Calamity.Types.Upgradeable-import           Data.Maybe (mapMaybe)-import           Data.Flags-import qualified Data.Vector.Unboxing                   as V+import Calamity.Client.Types+import Calamity.Internal.SnowflakeMap qualified as SM+import Calamity.Types.Model.Channel.Guild+import Calamity.Types.Model.Guild.Guild+import Calamity.Types.Model.Guild.Member+import Calamity.Types.Model.Guild.Overwrite+import Calamity.Types.Model.Guild.Permissions+import Calamity.Types.Model.User+import Calamity.Types.Snowflake+import Calamity.Types.Upgradeable+import Data.Flags+import Data.Foldable (Foldable (foldl'))+import Data.Maybe (mapMaybe)+import Data.Vector.Unboxing qualified as V import Optics-import qualified Polysemy                               as P-import Data.Foldable (Foldable(foldl'))-import qualified Calamity.Internal.SnowflakeMap as SM+import Polysemy qualified as P  -- | Calculate a 'Member'\'s 'Permissions' in a 'Guild' basePermissions :: Guild -> Member -> Permissions basePermissions g m   | g ^. #ownerID == getID m = allFlags-  | otherwise = let everyoneRole  = g ^. #roles % at (coerceSnowflake $ getID @Guild g)-                    permsEveryone = maybe noFlags (^. #permissions) everyoneRole-                    roleIDs       = V.toList $ m ^. #roles-                    rolePerms     = mapMaybe (\rid -> g ^? #roles % ix rid % #permissions) roleIDs-                    perms         = foldl' andFlags noFlags (permsEveryone:rolePerms)-                in if perms .<=. administrator-                   then allFlags-                   else perms+  | otherwise =+      let everyoneRole = g ^. #roles % at (coerceSnowflake $ getID @Guild g)+          permsEveryone = maybe noFlags (^. #permissions) everyoneRole+          roleIDs = V.toList $ m ^. #roles+          rolePerms = mapMaybe (\rid -> g ^? #roles % ix rid % #permissions) roleIDs+          perms = foldl' andFlags noFlags (permsEveryone : rolePerms)+       in if perms .<=. administrator+            then allFlags+            else perms  overwrites :: GuildChannel -> SM.SnowflakeMap Overwrite overwrites (GuildTextChannel c) = c ^. #permissionOverwrites@@ -46,20 +48,20 @@ applyOverwrites c m p   | p .<=. administrator = allFlags   | otherwise =-    let everyoneOverwrite = overwrites c ^. at (coerceSnowflake $ getID @Guild c)-        everyoneAllow     = maybe noFlags (^. #allow) everyoneOverwrite-        everyoneDeny      = maybe noFlags (^. #deny) everyoneOverwrite-        p'                = p .-. everyoneDeny .+. everyoneAllow-        roleOverwriteIDs  = map (coerceSnowflake @_ @Overwrite) . V.toList $ m ^. #roles-        roleOverwrites    = mapMaybe (\oid -> overwrites c ^? ix oid) roleOverwriteIDs-        roleAllow         = foldl' andFlags noFlags (roleOverwrites ^.. traversed % #allow)-        roleDeny          = foldl' andFlags noFlags (roleOverwrites ^.. traversed % #deny)-        p''               = p' .-. roleDeny .+. roleAllow-        memberOverwrite   = overwrites c ^. at (coerceSnowflake @_ @Overwrite $ getID @Member m)-        memberAllow       = maybe noFlags (^. #allow) memberOverwrite-        memberDeny        = maybe noFlags (^. #deny) memberOverwrite-        p'''              = p'' .-. memberDeny .+. memberAllow-    in p'''+      let everyoneOverwrite = overwrites c ^. at (coerceSnowflake $ getID @Guild c)+          everyoneAllow = maybe noFlags (^. #allow) everyoneOverwrite+          everyoneDeny = maybe noFlags (^. #deny) everyoneOverwrite+          p' = p .-. everyoneDeny .+. everyoneAllow+          roleOverwriteIDs = map (coerceSnowflake @_ @Overwrite) . V.toList $ m ^. #roles+          roleOverwrites = mapMaybe (\oid -> overwrites c ^? ix oid) roleOverwriteIDs+          roleAllow = foldl' andFlags noFlags (roleOverwrites ^.. traversed % #allow)+          roleDeny = foldl' andFlags noFlags (roleOverwrites ^.. traversed % #deny)+          p'' = p' .-. roleDeny .+. roleAllow+          memberOverwrite = overwrites c ^. at (coerceSnowflake @_ @Overwrite $ getID @Member m)+          memberAllow = maybe noFlags (^. #allow) memberOverwrite+          memberDeny = maybe noFlags (^. #deny) memberOverwrite+          p''' = p'' .-. memberDeny .+. memberAllow+       in p'''  -- | Things that 'Member's have 'Permissions' in class PermissionsIn a where@@ -77,23 +79,24 @@  -- | A 'Member'\'s 'Permissions' in a guild are just their roles instance PermissionsIn Guild where-  permissionsIn g m = basePermissions g m+  permissionsIn = basePermissions  -- | A variant of 'PermissionsIn' that will use the cache/http. class PermissionsIn' a where   -- | Calculate the permissions of something that has a 'User' id   permissionsIn' :: (BotC r, HasID User u) => a -> u -> P.Sem r Permissions --- | A 'User''s 'Permissions' in a channel are their roles and overwrites------ This will fetch the guild from the cache or http as needed+{- | A 'User''s 'Permissions' in a channel are their roles and overwrites++ This will fetch the guild from the cache or http as needed+-} instance PermissionsIn' GuildChannel where   permissionsIn' c (getID @User -> uid) = do     m <- upgrade (getID @Guild c, coerceSnowflake @_ @Member uid)     g <- upgrade (getID @Guild c)     case (m, g) of       (Just m, Just g') -> pure $ permissionsIn (g', c) m-      _cantFind         -> pure noFlags+      _cantFind -> pure noFlags  -- | A 'Member'\'s 'Permissions' in a guild are just their roles instance PermissionsIn' Guild where@@ -103,19 +106,21 @@       Just m' -> pure $ permissionsIn g m'       Nothing -> pure noFlags --- | A 'Member'\'s 'Permissions' in a channel are their roles and overwrites------ This will fetch the guild and channel from the cache or http as needed+{- | A 'Member'\'s 'Permissions' in a channel are their roles and overwrites++ This will fetch the guild and channel from the cache or http as needed+-} instance PermissionsIn' (Snowflake GuildChannel) where   permissionsIn' cid u = do     c <- upgrade cid     case c of-      Just c'  -> permissionsIn' c' u-      Nothing  -> pure noFlags+      Just c' -> permissionsIn' c' u+      Nothing -> pure noFlags --- | A 'Member'\'s 'Permissions' in a guild are just their roles------ This will fetch the guild from the cache or http as needed+{- | A 'Member'\'s 'Permissions' in a guild are just their roles++ This will fetch the guild from the cache or http as needed+-} instance PermissionsIn' (Snowflake Guild) where   permissionsIn' gid u = do     g <- upgrade gid

@@ -1,239 +1,240 @@-cabal-version: 2.0---- This file has been generated from package.yaml by hpack version 0.34.4.------ see: https://github.com/sol/hpack+cabal-version:      2.0+name:               calamity+version:            0.8.0.0+synopsis:           A library for writing discord bots in haskell+description:+  Please see the README on GitHub at <https://github.com/simmsb/calamity#readme> -name:           calamity-version:        0.7.1.0-synopsis:       A library for writing discord bots in haskell-description:    Please see the README on GitHub at <https://github.com/simmsb/calamity#readme>-category:       Network, Web-homepage:       https://github.com/simmsb/calamity-bug-reports:    https://github.com/simmsb/calamity/issues-author:         Ben Simms-maintainer:     ben@bensimms.moe-copyright:      2020 Ben Simms-license:        MIT-license-file:   LICENSE-build-type:     Simple-tested-with:-    GHC == 8.10.7, GHC == 9.2.5+category:           Network, Web+homepage:           https://github.com/simmsb/calamity+bug-reports:        https://github.com/simmsb/calamity/issues+author:             Ben Simms+maintainer:         ben@bensimms.moe+copyright:          2020 Ben Simms+license:            MIT+license-file:       LICENSE+build-type:         Simple+tested-with:        GHC ==9.4.4 extra-source-files:-    README.md-    ChangeLog.md-extra-doc-files:-    README.md+  ChangeLog.md+  README.md +extra-doc-files:    README.md+ source-repository head-  type: git+  type:     git   location: https://github.com/simmsb/calamity  library   exposed-modules:-      Calamity-      Calamity.Cache.Eff-      Calamity.Cache.InMemory-      Calamity.Client-      Calamity.Client.Client-      Calamity.Client.ShardManager-      Calamity.Client.Types-      Calamity.Commands-      Calamity.Commands.CalamityParsers-      Calamity.Commands.Context-      Calamity.Commands.Dsl-      Calamity.Commands.Help-      Calamity.Commands.Types-      Calamity.Commands.Utils-      Calamity.Gateway-      Calamity.Gateway.DispatchEvents-      Calamity.Gateway.Intents-      Calamity.Gateway.Shard-      Calamity.Gateway.Types-      Calamity.HTTP-      Calamity.HTTP.AuditLog-      Calamity.HTTP.Channel-      Calamity.HTTP.Emoji-      Calamity.HTTP.Guild-      Calamity.HTTP.Interaction-      Calamity.HTTP.Internal.Ratelimit-      Calamity.HTTP.Internal.Request-      Calamity.HTTP.Internal.Route-      Calamity.HTTP.Internal.Types-      Calamity.HTTP.Invite-      Calamity.HTTP.MiscRoutes-      Calamity.HTTP.Reason-      Calamity.HTTP.User-      Calamity.HTTP.Webhook-      Calamity.Interactions-      Calamity.Interactions.Eff-      Calamity.Interactions.Utils-      Calamity.Interactions.View-      Calamity.Internal.BoundedStore-      Calamity.Internal.ConstructorName-      Calamity.Internal.IntColour-      Calamity.Internal.LocalWriter-      Calamity.Internal.RunIntoIO-      Calamity.Internal.SnowflakeMap-      Calamity.Internal.UnixTimestamp-      Calamity.Internal.Updateable-      Calamity.Internal.Utils-      Calamity.Metrics.Eff-      Calamity.Metrics.Internal-      Calamity.Metrics.Noop-      Calamity.Types-      Calamity.Types.LogEff-      Calamity.Types.Model-      Calamity.Types.Model.Avatar-      Calamity.Types.Model.Channel-      Calamity.Types.Model.Channel.Attachment-      Calamity.Types.Model.Channel.ChannelType-      Calamity.Types.Model.Channel.Component-      Calamity.Types.Model.Channel.DM-      Calamity.Types.Model.Channel.Embed-      Calamity.Types.Model.Channel.Group-      Calamity.Types.Model.Channel.Guild-      Calamity.Types.Model.Channel.Guild.Category-      Calamity.Types.Model.Channel.Guild.Text-      Calamity.Types.Model.Channel.Guild.Voice-      Calamity.Types.Model.Channel.Message-      Calamity.Types.Model.Channel.Reaction-      Calamity.Types.Model.Channel.UpdatedMessage-      Calamity.Types.Model.Channel.Webhook-      Calamity.Types.Model.Guild-      Calamity.Types.Model.Guild.AuditLog-      Calamity.Types.Model.Guild.Ban-      Calamity.Types.Model.Guild.Emoji-      Calamity.Types.Model.Guild.Guild-      Calamity.Types.Model.Guild.Invite-      Calamity.Types.Model.Guild.Member-      Calamity.Types.Model.Guild.Overwrite-      Calamity.Types.Model.Guild.Permissions-      Calamity.Types.Model.Guild.Role-      Calamity.Types.Model.Guild.UnavailableGuild-      Calamity.Types.Model.Interaction-      Calamity.Types.Model.Presence-      Calamity.Types.Model.Presence.Activity-      Calamity.Types.Model.Presence.Presence-      Calamity.Types.Model.User-      Calamity.Types.Model.Voice-      Calamity.Types.Model.Voice.VoiceRegion-      Calamity.Types.Model.Voice.VoiceState-      Calamity.Types.CDNAsset-      Calamity.Types.Partial-      Calamity.Types.Snowflake-      Calamity.Types.Tellable-      Calamity.Types.Token-      Calamity.Types.TokenEff-      Calamity.Types.Upgradeable-      Calamity.Utils-      Calamity.Utils.CDNUrl-      Calamity.Utils.Colour-      Calamity.Utils.Message-      Calamity.Utils.Permissions-  hs-source-dirs:-      ./+    Calamity+    Calamity.Cache.Eff+    Calamity.Cache.InMemory+    Calamity.Client+    Calamity.Client.Client+    Calamity.Client.ShardManager+    Calamity.Client.Types+    Calamity.Commands+    Calamity.Commands.CalamityParsers+    Calamity.Commands.Context+    Calamity.Commands.Dsl+    Calamity.Commands.Help+    Calamity.Commands.Types+    Calamity.Commands.Utils+    Calamity.Gateway+    Calamity.Gateway.DispatchEvents+    Calamity.Gateway.Intents+    Calamity.Gateway.Shard+    Calamity.Gateway.Types+    Calamity.HTTP+    Calamity.HTTP.AuditLog+    Calamity.HTTP.Channel+    Calamity.HTTP.Emoji+    Calamity.HTTP.Guild+    Calamity.HTTP.Interaction+    Calamity.HTTP.Internal.Ratelimit+    Calamity.HTTP.Internal.Request+    Calamity.HTTP.Internal.Route+    Calamity.HTTP.Internal.Types+    Calamity.HTTP.Invite+    Calamity.HTTP.MiscRoutes+    Calamity.HTTP.Reason+    Calamity.HTTP.User+    Calamity.HTTP.Webhook+    Calamity.Interactions+    Calamity.Interactions.Eff+    Calamity.Interactions.Utils+    Calamity.Interactions.View+    Calamity.Internal.BoundedStore+    Calamity.Internal.ConstructorName+    Calamity.Internal.IntColour+    Calamity.Internal.LocalWriter+    Calamity.Internal.RunIntoIO+    Calamity.Internal.SnowflakeMap+    Calamity.Internal.UnixTimestamp+    Calamity.Internal.Updateable+    Calamity.Internal.Utils+    Calamity.Metrics.Eff+    Calamity.Metrics.Internal+    Calamity.Metrics.Noop+    Calamity.Types+    Calamity.Types.CDNAsset+    Calamity.Types.LogEff+    Calamity.Types.Model+    Calamity.Types.Model.Avatar+    Calamity.Types.Model.Channel+    Calamity.Types.Model.Channel.Attachment+    Calamity.Types.Model.Channel.ChannelType+    Calamity.Types.Model.Channel.Component+    Calamity.Types.Model.Channel.DM+    Calamity.Types.Model.Channel.Embed+    Calamity.Types.Model.Channel.Group+    Calamity.Types.Model.Channel.Guild+    Calamity.Types.Model.Channel.Guild.Category+    Calamity.Types.Model.Channel.Guild.Text+    Calamity.Types.Model.Channel.Guild.Voice+    Calamity.Types.Model.Channel.Message+    Calamity.Types.Model.Channel.Reaction+    Calamity.Types.Model.Channel.UpdatedMessage+    Calamity.Types.Model.Channel.Webhook+    Calamity.Types.Model.Guild+    Calamity.Types.Model.Guild.AuditLog+    Calamity.Types.Model.Guild.Ban+    Calamity.Types.Model.Guild.Emoji+    Calamity.Types.Model.Guild.Guild+    Calamity.Types.Model.Guild.Invite+    Calamity.Types.Model.Guild.Member+    Calamity.Types.Model.Guild.Overwrite+    Calamity.Types.Model.Guild.Permissions+    Calamity.Types.Model.Guild.Role+    Calamity.Types.Model.Guild.UnavailableGuild+    Calamity.Types.Model.Interaction+    Calamity.Types.Model.Presence+    Calamity.Types.Model.Presence.Activity+    Calamity.Types.Model.Presence.Presence+    Calamity.Types.Model.User+    Calamity.Types.Model.Voice+    Calamity.Types.Model.Voice.VoiceRegion+    Calamity.Types.Model.Voice.VoiceState+    Calamity.Types.Partial+    Calamity.Types.Snowflake+    Calamity.Types.Tellable+    Calamity.Types.Token+    Calamity.Types.TokenEff+    Calamity.Types.Upgradeable+    Calamity.Utils+    Calamity.Utils.CDNUrl+    Calamity.Utils.Colour+    Calamity.Utils.Message+    Calamity.Utils.Permissions++  hs-source-dirs:     ./   default-extensions:-      StrictData-      AllowAmbiguousTypes-      BlockArguments-      NoMonomorphismRestriction-      BangPatterns-      BinaryLiterals-      UndecidableInstances-      ConstraintKinds-      DataKinds-      DefaultSignatures-      DeriveDataTypeable-      DeriveFoldable-      DeriveFunctor-      DeriveGeneric-      DeriveTraversable-      DoAndIfThenElse-      EmptyDataDecls-      ExistentialQuantification-      FlexibleContexts-      FlexibleInstances-      FunctionalDependencies-      GADTs-      DerivingVia-      DerivingStrategies-      GeneralizedNewtypeDeriving-      StandaloneDeriving-      DeriveAnyClass-      InstanceSigs-      KindSignatures-      LambdaCase-      MultiParamTypeClasses-      MultiWayIf-      NamedFieldPuns-      OverloadedStrings-      OverloadedLabels-      PartialTypeSignatures-      PatternGuards-      PolyKinds-      RankNTypes-      RecordWildCards-      ScopedTypeVariables-      TupleSections-      TypeFamilies-      TypeSynonymInstances-      ViewPatterns-      DuplicateRecordFields-      TypeOperators-      TypeApplications-      RoleAnnotations-      QuasiQuotes-  ghc-options: -fplugin=Polysemy.Plugin -funbox-strict-fields -Wall -fno-warn-name-shadowing+    NoMonomorphismRestriction+    AllowAmbiguousTypes+    BangPatterns+    BinaryLiterals+    BlockArguments+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveAnyClass+    DeriveDataTypeable+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveTraversable+    DerivingStrategies+    DerivingVia+    DoAndIfThenElse+    DuplicateRecordFields+    EmptyDataDecls+    ExistentialQuantification+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    ImportQualifiedPost+    InstanceSigs+    KindSignatures+    LambdaCase+    MultiParamTypeClasses+    MultiWayIf+    NamedFieldPuns+    OverloadedLabels+    OverloadedStrings+    PartialTypeSignatures+    PatternGuards+    PolyKinds+    QuasiQuotes+    RankNTypes+    RecordWildCards+    RoleAnnotations+    ScopedTypeVariables+    StandaloneDeriving+    StrictData+    TupleSections+    TypeApplications+    TypeFamilies+    TypeOperators+    TypeSynonymInstances+    UndecidableInstances+    ViewPatterns++  ghc-options:+    -fplugin=Polysemy.Plugin -funbox-strict-fields -Wall+    -fno-warn-name-shadowing+   build-depends:-      PyF ==0.11.*-    , aeson >=2.0 && <2.2-    , async >=2.2 && <3-    , base >=4.13 && <5-    , bytestring >=0.10 && <0.12-    , calamity-commands ==0.4.*-    , colour >=2.3.5 && <2.4-    , concurrent-extra ==0.7.*-    , connection >=0.2.6 && <0.4-    , containers ==0.6.*-    , data-default-class ==0.1.*-    , data-flags >=0.0.3 && <0.1-    , deepseq >=1.4.4.0 && <2-    , deque ==0.4.*-    , df1 ==0.4.*-    , di-core >=1.0.4 && <1.1-    , di-polysemy ==0.2.*-    , exceptions ==0.10.*-    , focus >=1.0 && <2-    , hashable >=1.2 && <2-    , http-api-data >=0.4.3 && <0.6-    , http-client >=0.5 && <0.8-    , http-date >=0.0.8 && <0.1-    , http-types ==0.12.*-    , megaparsec >=8 && <10-    , mime-types ==0.1.*-    , mtl >=2.2 && <3-    , polysemy >=1.5 && <2-    , polysemy-plugin >=0.3 && <0.5-    , reflection >=2.1 && <3-    , req >=3.9.2 && <3.14-    , safe-exceptions >=0.1 && <2-    , scientific ==0.3.*-    , stm >=2.5 && <3-    , stm-chans >=3.0 && <4-    , stm-containers >=1.1 && <2-    , text >=1.2 && <2.1-    , text-show >=3.8 && <4-    , time >=1.8 && <1.13-    , tls >=1.4 && <2-    , typerep-map >=0.5 && <0.7-    , unagi-chan ==0.4.*-    , unboxing-vector ==0.2.*-    , unordered-containers ==0.2.*-    , vector >=0.12 && <0.14-    , websockets >=0.12 && <0.13-    , x509-system >=1.6.6 && <1.7-    , random >=1.2 && <1.3-    , optics >=0.4.1 && <0.5-    , aeson-optics >=1.2 && <2-  default-language: Haskell2010+      aeson                 >=2.0     && <2.2+    , aeson-optics          >=1.2     && <2+    , async                 >=2.2     && <3+    , base                  >=4.13    && <5+    , bytestring            >=0.10    && <0.12+    , calamity-commands     >=0.4     && <0.5+    , colour                >=2.3.5   && <2.4+    , concurrent-extra      >=0.7     && <0.8+    , connection            >=0.2.6   && <0.4+    , containers            >=0.6     && <0.7+    , data-default-class    >=0.1     && <0.2+    , data-flags            >=0.0.3   && <0.1+    , deepseq               >=1.4.4.0 && <2+    , deque                 >=0.4     && <0.5+    , df1                   >=0.4     && <0.5+    , di-core               >=1.0.4   && <1.1+    , di-polysemy           >=0.2     && <0.3+    , exceptions            >=0.10    && <0.11+    , focus                 >=1.0     && <2+    , hashable              >=1.2     && <2+    , http-api-data         >=0.4.3   && <0.6+    , http-client           >=0.5     && <0.8+    , http-date             >=0.0.8   && <0.1+    , http-types            >=0.12    && <0.13+    , megaparsec            >=8       && <10+    , mime-types            >=0.1     && <0.2+    , mtl                   >=2.2     && <3+    , optics                >=0.4.1   && <0.5+    , polysemy              >=1.5     && <2+    , polysemy-plugin       >=0.3     && <0.5+    , random                >=1.2     && <1.3+    , reflection            >=2.1     && <3+    , req                   >=3.9.2   && <3.14+    , safe-exceptions       >=0.1     && <2+    , scientific            >=0.3     && <0.4+    , stm                   >=2.5     && <3+    , stm-chans             >=3.0     && <4+    , stm-containers        >=1.1     && <2+    , text                  >=1.2     && <2.1+    , text-show             >=3.8     && <4+    , time                  >=1.8     && <1.13+    , tls                   >=1.4     && <2+    , typerep-map           >=0.5     && <0.7+    , unagi-chan            >=0.4     && <0.5+    , unboxing-vector       >=0.2     && <0.3+    , unordered-containers  >=0.2     && <0.3+    , vector                >=0.12    && <0.14+    , websockets            >=0.12    && <0.13+    , x509-system           >=1.6.6   && <1.7++  default-language:   Haskell2010