calamity 0.1.31.0 → 0.2.0.0
raw patch · 46 files changed
+657/−637 lines, 46 filesdep ~PyFdep ~aesondep ~calamity-commandsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: PyF, aeson, calamity-commands, lens, lens-aeson, req, text
API changes (from Hackage documentation)
- Calamity.Types.Model.Channel.Guild: instance Data.Generics.Product.Fields.HasField' "name" Calamity.Types.Model.Channel.Guild.GuildChannel Data.Text.Internal.Lazy.Text
+ Calamity.Types.Model.Channel.Guild: instance Data.Generics.Product.Fields.HasField' "name" Calamity.Types.Model.Channel.Guild.GuildChannel Data.Text.Internal.Text
- Calamity.Cache.Eff: delDM :: forall r_acW9K. MemberWithError CacheEff r_acW9K => Snowflake DMChannel -> Sem r_acW9K ()
+ Calamity.Cache.Eff: delDM :: forall r_acZNY. Member CacheEff r_acZNY => Snowflake DMChannel -> Sem r_acZNY ()
- Calamity.Cache.Eff: delGuild :: forall r_acW9D. MemberWithError CacheEff r_acW9D => Snowflake Guild -> Sem r_acW9D ()
+ Calamity.Cache.Eff: delGuild :: forall r_acZNR. Member CacheEff r_acZNR => Snowflake Guild -> Sem r_acZNR ()
- Calamity.Cache.Eff: delMessage :: forall r_acWa5. MemberWithError CacheEff r_acWa5 => Snowflake Message -> Sem r_acWa5 ()
+ Calamity.Cache.Eff: delMessage :: forall r_acZOj. Member CacheEff r_acZOj => Snowflake Message -> Sem r_acZOj ()
- Calamity.Cache.Eff: delUnavailableGuild :: forall r_acW9Y. MemberWithError CacheEff r_acW9Y => Snowflake Guild -> Sem r_acW9Y ()
+ Calamity.Cache.Eff: delUnavailableGuild :: forall r_acZOc. Member CacheEff r_acZOc => Snowflake Guild -> Sem r_acZOc ()
- Calamity.Cache.Eff: delUser :: forall r_acW9R. MemberWithError CacheEff r_acW9R => Snowflake User -> Sem r_acW9R ()
+ Calamity.Cache.Eff: delUser :: forall r_acZO5. Member CacheEff r_acZO5 => Snowflake User -> Sem r_acZO5 ()
- Calamity.Cache.Eff: getBotUser :: forall r_acW9v. MemberWithError CacheEff r_acW9v => Sem r_acW9v (Maybe User)
+ Calamity.Cache.Eff: getBotUser :: forall r_acZNJ. Member CacheEff r_acZNJ => Sem r_acZNJ (Maybe User)
- Calamity.Cache.Eff: getDM :: forall r_acW9H. MemberWithError CacheEff r_acW9H => Snowflake DMChannel -> Sem r_acW9H (Maybe DMChannel)
+ Calamity.Cache.Eff: getDM :: forall r_acZNV. Member CacheEff r_acZNV => Snowflake DMChannel -> Sem r_acZNV (Maybe DMChannel)
- Calamity.Cache.Eff: getDMs :: forall r_acW9J. MemberWithError CacheEff r_acW9J => Sem r_acW9J [DMChannel]
+ Calamity.Cache.Eff: getDMs :: forall r_acZNX. Member CacheEff r_acZNX => Sem r_acZNX [DMChannel]
- Calamity.Cache.Eff: getGuild :: forall r_acW9y. MemberWithError CacheEff r_acW9y => Snowflake Guild -> Sem r_acW9y (Maybe Guild)
+ Calamity.Cache.Eff: getGuild :: forall r_acZNM. Member CacheEff r_acZNM => Snowflake Guild -> Sem r_acZNM (Maybe Guild)
- Calamity.Cache.Eff: getGuildChannel :: forall r_acW9A. MemberWithError CacheEff r_acW9A => Snowflake GuildChannel -> Sem r_acW9A (Maybe GuildChannel)
+ Calamity.Cache.Eff: getGuildChannel :: forall r_acZNO. Member CacheEff r_acZNO => Snowflake GuildChannel -> Sem r_acZNO (Maybe GuildChannel)
- Calamity.Cache.Eff: getGuilds :: forall r_acW9C. MemberWithError CacheEff r_acW9C => Sem r_acW9C [Guild]
+ Calamity.Cache.Eff: getGuilds :: forall r_acZNQ. Member CacheEff r_acZNQ => Sem r_acZNQ [Guild]
- Calamity.Cache.Eff: getMessage :: forall r_acWa2. MemberWithError CacheEff r_acWa2 => Snowflake Message -> Sem r_acWa2 (Maybe Message)
+ Calamity.Cache.Eff: getMessage :: forall r_acZOg. Member CacheEff r_acZOg => Snowflake Message -> Sem r_acZOg (Maybe Message)
- Calamity.Cache.Eff: getMessages :: forall r_acWa4. MemberWithError CacheEff r_acWa4 => Sem r_acWa4 [Message]
+ Calamity.Cache.Eff: getMessages :: forall r_acZOi. Member CacheEff r_acZOi => Sem r_acZOi [Message]
- Calamity.Cache.Eff: getUnavailableGuilds :: forall r_acW9X. MemberWithError CacheEff r_acW9X => Sem r_acW9X [Snowflake Guild]
+ Calamity.Cache.Eff: getUnavailableGuilds :: forall r_acZOb. Member CacheEff r_acZOb => Sem r_acZOb [Snowflake Guild]
- Calamity.Cache.Eff: getUser :: forall r_acW9O. MemberWithError CacheEff r_acW9O => Snowflake User -> Sem r_acW9O (Maybe User)
+ Calamity.Cache.Eff: getUser :: forall r_acZO2. Member CacheEff r_acZO2 => Snowflake User -> Sem r_acZO2 (Maybe User)
- Calamity.Cache.Eff: getUsers :: forall r_acW9Q. MemberWithError CacheEff r_acW9Q => Sem r_acW9Q [User]
+ Calamity.Cache.Eff: getUsers :: forall r_acZO4. Member CacheEff r_acZO4 => Sem r_acZO4 [User]
- Calamity.Cache.Eff: isUnavailableGuild :: forall r_acW9V. MemberWithError CacheEff r_acW9V => Snowflake Guild -> Sem r_acW9V Bool
+ Calamity.Cache.Eff: isUnavailableGuild :: forall r_acZO9. Member CacheEff r_acZO9 => Snowflake Guild -> Sem r_acZO9 Bool
- Calamity.Cache.Eff: setBotUser :: forall r_acW9t. MemberWithError CacheEff r_acW9t => User -> Sem r_acW9t ()
+ Calamity.Cache.Eff: setBotUser :: forall r_acZNH. Member CacheEff r_acZNH => User -> Sem r_acZNH ()
- Calamity.Cache.Eff: setDM :: forall r_acW9F. MemberWithError CacheEff r_acW9F => DMChannel -> Sem r_acW9F ()
+ Calamity.Cache.Eff: setDM :: forall r_acZNT. Member CacheEff r_acZNT => DMChannel -> Sem r_acZNT ()
- Calamity.Cache.Eff: setGuild :: forall r_acW9w. MemberWithError CacheEff r_acW9w => Guild -> Sem r_acW9w ()
+ Calamity.Cache.Eff: setGuild :: forall r_acZNK. Member CacheEff r_acZNK => Guild -> Sem r_acZNK ()
- Calamity.Cache.Eff: setMessage :: forall r_acWa0. MemberWithError CacheEff r_acWa0 => Message -> Sem r_acWa0 ()
+ Calamity.Cache.Eff: setMessage :: forall r_acZOe. Member CacheEff r_acZOe => Message -> Sem r_acZOe ()
- Calamity.Cache.Eff: setUnavailableGuild :: forall r_acW9T. MemberWithError CacheEff r_acW9T => Snowflake Guild -> Sem r_acW9T ()
+ Calamity.Cache.Eff: setUnavailableGuild :: forall r_acZO7. Member CacheEff r_acZO7 => Snowflake Guild -> Sem r_acZO7 ()
- Calamity.Cache.Eff: setUser :: forall r_acW9M. MemberWithError CacheEff r_acW9M => User -> Sem r_acW9M ()
+ Calamity.Cache.Eff: setUser :: forall r_acZO0. Member CacheEff r_acZO0 => User -> Sem r_acZO0 ()
- Calamity.HTTP: invoke :: (BotC r, Request a, FromJSON (Result a)) => a -> Sem r (Either RestError (Result a))
+ Calamity.HTTP: invoke :: (BotC r, Request a, ReadResponse (Result a)) => a -> Sem r (Either RestError (Result a))
- Calamity.HTTP.Internal.Request: invoke :: (BotC r, Request a, FromJSON (Result a)) => a -> Sem r (Either RestError (Result a))
+ Calamity.HTTP.Internal.Request: invoke :: (BotC r, Request a, ReadResponse (Result a)) => a -> Sem r (Either RestError (Result a))
- Calamity.Internal.LocalWriter: llisten :: forall o_atus r_atvR a_Xtus. MemberWithError (LocalWriter o_atus) r_atvR => Sem r_atvR a_Xtus -> Sem r_atvR (o_atus, a_Xtus)
+ Calamity.Internal.LocalWriter: llisten :: forall o_aspu r_asr0 a_Xspu. Member (LocalWriter o_aspu) r_asr0 => Sem r_asr0 a_Xspu -> Sem r_asr0 (o_aspu, a_Xspu)
- Calamity.Internal.LocalWriter: ltell :: forall o_atuo r_atvP. MemberWithError (LocalWriter o_atuo) r_atvP => o_atuo -> Sem r_atvP ()
+ Calamity.Internal.LocalWriter: ltell :: forall o_aspq r_asqY. Member (LocalWriter o_aspq) r_asqY => o_aspq -> Sem r_asqY ()
- Calamity.Metrics.Eff: addCounter :: forall r_aC1E. MemberWithError MetricEff r_aC1E => Int -> Counter -> Sem r_aC1E Int
+ Calamity.Metrics.Eff: addCounter :: forall r_aBLN. Member MetricEff r_aBLN => Int -> Counter -> Sem r_aBLN Int
- Calamity.Metrics.Eff: modifyGauge :: forall r_aC1H. MemberWithError MetricEff r_aC1H => (Double -> Double) -> Gauge -> Sem r_aC1H Double
+ Calamity.Metrics.Eff: modifyGauge :: forall r_aBLQ. Member MetricEff r_aBLQ => (Double -> Double) -> Gauge -> Sem r_aBLQ Double
- Calamity.Metrics.Eff: observeHistogram :: forall r_aC1K. MemberWithError MetricEff r_aC1K => Double -> Histogram -> Sem r_aC1K HistogramSample
+ Calamity.Metrics.Eff: observeHistogram :: forall r_aBLT. Member MetricEff r_aBLT => Double -> Histogram -> Sem r_aBLT HistogramSample
- Calamity.Metrics.Eff: registerCounter :: forall r_aC1u. MemberWithError MetricEff r_aC1u => Text -> [(Text, Text)] -> Sem r_aC1u Counter
+ Calamity.Metrics.Eff: registerCounter :: forall r_aBLD. Member MetricEff r_aBLD => Text -> [(Text, Text)] -> Sem r_aBLD Counter
- Calamity.Metrics.Eff: registerGauge :: forall r_aC1x. MemberWithError MetricEff r_aC1x => Text -> [(Text, Text)] -> Sem r_aC1x Gauge
+ Calamity.Metrics.Eff: registerGauge :: forall r_aBLG. Member MetricEff r_aBLG => Text -> [(Text, Text)] -> Sem r_aBLG Gauge
- Calamity.Metrics.Eff: registerHistogram :: forall r_aC1A. MemberWithError MetricEff r_aC1A => Text -> [(Text, Text)] -> [Double] -> Sem r_aC1A Histogram
+ Calamity.Metrics.Eff: registerHistogram :: forall r_aBLJ. Member MetricEff r_aBLJ => Text -> [(Text, Text)] -> [Double] -> Sem r_aBLJ Histogram
Files
- Calamity/Client/Client.hs +4/−4
- Calamity/Commands.hs +1/−1
- Calamity/Commands/CalamityParsers.hs +95/−66
- Calamity/Commands/Context.hs +6/−6
- Calamity/Commands/Dsl.hs +23/−24
- Calamity/Commands/Utils.hs +6/−7
- Calamity/Gateway/DispatchEvents.hs +1/−1
- Calamity/Gateway/Shard.hs +15/−15
- Calamity/Gateway/Types.hs +1/−1
- Calamity/HTTP/Channel.hs +7/−7
- Calamity/HTTP/Guild.hs +56/−55
- Calamity/HTTP/Internal/Ratelimit.hs +2/−2
- Calamity/HTTP/Internal/Request.hs +14/−16
- Calamity/HTTP/Internal/Types.hs +5/−9
- Calamity/Internal/AesonThings.hs +3/−4
- Calamity/Internal/Utils.hs +1/−1
- Calamity/Types/Model/Channel.hs +43/−44
- Calamity/Types/Model/Channel/Attachment.hs +31/−29
- Calamity/Types/Model/Channel/Component.hs +5/−5
- Calamity/Types/Model/Channel/Embed.hs +1/−1
- Calamity/Types/Model/Channel/Group.hs +2/−3
- Calamity/Types/Model/Channel/Guild.hs +2/−6
- Calamity/Types/Model/Channel/Guild/Category.hs +1/−1
- Calamity/Types/Model/Channel/Guild/Text.hs +2/−3
- Calamity/Types/Model/Channel/Guild/Voice.hs +1/−1
- Calamity/Types/Model/Channel/Message.hs +2/−2
- Calamity/Types/Model/Channel/UpdatedMessage.hs +3/−3
- Calamity/Types/Model/Channel/Webhook.hs +20/−21
- Calamity/Types/Model/Guild/AuditLog.hs +121/−120
- Calamity/Types/Model/Guild/Emoji.hs +10/−11
- Calamity/Types/Model/Guild/Guild.hs +1/−1
- Calamity/Types/Model/Guild/Invite.hs +21/−22
- Calamity/Types/Model/Guild/Member.hs +1/−1
- Calamity/Types/Model/Guild/Role.hs +2/−2
- Calamity/Types/Model/Interaction.hs +4/−4
- Calamity/Types/Model/Presence/Activity.hs +1/−1
- Calamity/Types/Model/Presence/Presence.hs +1/−1
- Calamity/Types/Model/User.hs +2/−4
- Calamity/Types/Model/Voice/VoiceRegion.hs +16/−17
- Calamity/Types/Model/Voice/VoiceState.hs +1/−1
- Calamity/Types/Tellable.hs +50/−50
- Calamity/Types/Token.hs +1/−1
- Calamity/Utils/Message.hs +35/−35
- ChangeLog.md +8/−0
- README.md +20/−19
- calamity.cabal +9/−9
Calamity/Client/Client.hs view
@@ -51,7 +51,7 @@ import Data.IORef import Data.Maybe import Data.Proxy-import qualified Data.Text as S+import qualified Data.Text as T import Data.Time.Clock.POSIX import qualified Df1 import qualified Di.Core as DC@@ -278,7 +278,7 @@ Waiting for a message containing the text \"hi\": @- f = do msg \<\- 'waitUntil' @\''MessageCreateEvt' (\\m -> 'Data.Text.Lazy.isInfixOf' "hi" $ m ^. #content)+ f = do msg \<\- 'waitUntil' @\''MessageCreateEvt' (\\m -> 'Data.Text.isInfixOf' "hi" $ m ^. #content) print $ msg ^. #content @ -}@@ -319,7 +319,7 @@ Waiting for a message containing the text \"hi\": @- f = do msg \<\- 'waitUntilM' @\''MessageCreateEvt' (\\m -> ('debug' $ "got message: " <> 'showt' msg) >> ('pure' $ 'Data.Text.Lazy.isInfixOf' "hi" $ m ^. #content))+ f = do msg \<\- 'waitUntilM' @\''MessageCreateEvt' (\\m -> ('debug' $ "got message: " <> 'showt' msg) >> ('pure' $ 'Data.Text.isInfixOf' "hi" $ m ^. #content)) print $ msg ^. #content @ -}@@ -398,7 +398,7 @@ debug "handling an event" eventHandlers <- P.atomicGet actions <- P.runFail $ do- evtCounter <- registerCounter "events_received" [("type", S.pack $ ctorName data'), ("shard", showt shardID)]+ evtCounter <- registerCounter "events_received" [("type", T.pack $ ctorName data'), ("shard", showt shardID)] void $ addCounter 1 evtCounter cacheUpdateHisto <- registerHistogram "cache_update" mempty [10, 20 .. 100] (time, res) <- timeA . resetDi $ handleEvent' eventHandlers data'
Calamity/Commands.hs view
@@ -90,7 +90,7 @@ 'addCommands' $ do 'helpCommand' 'command' \@\'['Calamity.Types.Model.User.User'] "utest" $ \\ctx u \-\> do- 'Control.Monad.void' $ 'Calamity.Types.Tellable.tell' ctx $ "got user: " '<>' 'TextShow.showtl' u+ 'Control.Monad.void' $ 'Calamity.Types.Tellable.tell' ctx $ "got user: " '<>' 'TextShow.showt' u 'group' "admin" $ do 'command' \@'[] "bye" $ \\ctx -> do 'Control.Monad.void' $ 'Calamity.Types.Tellable.tell' ctx "bye!"
Calamity/Commands/CalamityParsers.hs view
@@ -16,8 +16,7 @@ import Control.Monad import Control.Monad.Trans (lift) import Data.Maybe (fromMaybe, isJust)-import qualified Data.Text as S-import qualified Data.Text.Lazy as L+import qualified Data.Text as T import Data.Typeable import qualified Polysemy as P import qualified Polysemy.Reader as P@@ -25,40 +24,41 @@ import Text.Megaparsec.Char.Lexer (decimal) import Text.Megaparsec.Error.Builder (errFancy, fancy) -parserName :: forall a c r. ParameterParser a c r => S.Text-parserName = let ParameterInfo (fromMaybe "" -> name) type_ _ = parameterInfo @a @c @r- in name <> ":" <> S.pack (show type_)+parserName :: forall a c r. ParameterParser a c r => T.Text+parserName =+ let ParameterInfo (fromMaybe "" -> name) type_ _ = parameterInfo @a @c @r+ in name <> ":" <> T.pack (show type_) instance Typeable (Snowflake a) => ParameterParser (Snowflake a) c r where parse = parseMP (parserName @(Snowflake a)) snowflake parameterDescription = "discord id" -- | Accepts both plain IDs and mentions-instance {-# OVERLAPS #-}ParameterParser (Snowflake User) c r where+instance {-# OVERLAPS #-} ParameterParser (Snowflake User) c r where parse = parseMP (parserName @(Snowflake User)) (try (ping "@") <|> snowflake) parameterDescription = "user mention or id" -- | Accepts both plain IDs and mentions-instance {-# OVERLAPS #-}ParameterParser (Snowflake Member) c r where+instance {-# OVERLAPS #-} ParameterParser (Snowflake Member) c r where parse = parseMP (parserName @(Snowflake Member)) (try (ping "@") <|> snowflake) parameterDescription = "user mention or id" -- | Accepts both plain IDs and mentions-instance {-# OVERLAPS #-}ParameterParser (Snowflake Channel) c r where+instance {-# OVERLAPS #-} ParameterParser (Snowflake Channel) c r where parse = parseMP (parserName @(Snowflake Channel)) (try (ping "#") <|> snowflake) parameterDescription = "channel mention or id" -- | Accepts both plain IDs and mentions-instance {-# OVERLAPS #-}ParameterParser (Snowflake Role) c r where+instance {-# OVERLAPS #-} ParameterParser (Snowflake Role) c r where parse = parseMP (parserName @(Snowflake Role)) (try (ping "@&") <|> snowflake) parameterDescription = "role mention or id" -- | Accepts both plain IDs and uses of emoji-instance {-# OVERLAPS #-}ParameterParser (Snowflake Emoji) c r where+instance {-# OVERLAPS #-} ParameterParser (Snowflake Emoji) c r where parse = parseMP (parserName @(Snowflake Emoji)) (try emoji <|> snowflake) parameterDescription = "emoji or id" -mapParserMaybeM :: (Monad m, Stream s) => ParsecT SpannedError s m a -> L.Text -> (a -> m (Maybe b)) -> ParsecT SpannedError s m b+mapParserMaybeM :: (Monad m, Stream s) => ParsecT SpannedError s m a -> T.Text -> (a -> m (Maybe b)) -> ParsecT SpannedError s m b mapParserMaybeM m e f = do offs <- getOffset r <- m >>= lift . f@@ -67,99 +67,128 @@ Just r' -> pure r' Nothing -> parseError . errFancy offs . fancy . ErrorCustom $ SpannedError e offs offe --- | ParameterParser for members in the guild the command was invoked in, this only looks--- in the cache. Use @'Snowflake' 'Member'@ and use--- 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching from http.+{- | ParameterParser for members in the guild the command was invoked in, this only looks+ in the cache. Use @'Snowflake' 'Member'@ and use+ 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching from http.+-} instance (P.Member CacheEff r, CalamityCommandContext c) => ParameterParser Member c r where- parse = parseMP (parserName @Member @c @r) $ mapParserMaybeM (try (ping "@") <|> snowflake)- "Couldn't find a Member with this id"- (\mid -> do- ctx <- P.ask- guild <- join <$> getGuild `traverse` ctxGuildID ctx- pure $ guild ^? _Just . #members . ix mid)+ parse =+ parseMP (parserName @Member @c @r) $+ mapParserMaybeM+ (try (ping "@") <|> snowflake)+ "Couldn't find a Member with this id"+ ( \mid -> do+ ctx <- P.ask+ guild <- join <$> getGuild `traverse` ctxGuildID ctx+ pure $ guild ^? _Just . #members . ix mid+ ) parameterDescription = "user mention or id" --- | ParameterParser for users, this only looks in the cache. Use @'Snowflake'--- 'User'@ and use 'Calamity.Types.Upgradeable.upgrade' if you want to allow--- fetching from http.+{- | ParameterParser for users, this only looks in the cache. Use @'Snowflake'+ 'User'@ and use 'Calamity.Types.Upgradeable.upgrade' if you want to allow+ fetching from http.+-} instance P.Member CacheEff r => ParameterParser User c r where- parse = parseMP (parserName @User @c @r) $ mapParserMaybeM (try (ping "@") <|> snowflake)- "Couldn't find a User with this id"- getUser+ parse =+ parseMP (parserName @User @c @r) $+ mapParserMaybeM+ (try (ping "@") <|> snowflake)+ "Couldn't find a User with this id"+ getUser parameterDescription = "user mention or id" --- | ParameterParser for channels in the guild the command was invoked in, this only--- looks in the cache. Use @'Snowflake' 'Channel'@ and use--- 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching from http.+{- | ParameterParser for channels in the guild the command was invoked in, this only+ looks in the cache. Use @'Snowflake' 'Channel'@ and use+ 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching from http.+-} instance (P.Member CacheEff r, CalamityCommandContext c) => ParameterParser GuildChannel c r where- parse = parseMP (parserName @GuildChannel @c @r) $ mapParserMaybeM (try (ping "#") <|> snowflake)- "Couldn't find a GuildChannel with this id"- (\cid -> do- ctx <- P.ask- guild <- join <$> getGuild `traverse` ctxGuildID ctx- pure $ guild ^? _Just . #channels . ix cid)+ parse =+ parseMP (parserName @GuildChannel @c @r) $+ mapParserMaybeM+ (try (ping "#") <|> snowflake)+ "Couldn't find a GuildChannel with this id"+ ( \cid -> do+ ctx <- P.ask+ guild <- join <$> getGuild `traverse` ctxGuildID ctx+ pure $ guild ^? _Just . #channels . ix cid+ ) parameterDescription = "channel mention or id" --- | ParameterParser for guilds, this only looks in the cache. Use @'Snowflake' 'Guild'@--- and use 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching--- from http.+{- | ParameterParser for guilds, this only looks in the cache. Use @'Snowflake' 'Guild'@+ and use 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching+ from http.+-} instance P.Member CacheEff r => ParameterParser Guild c r where- parse = parseMP (parserName @Guild @c @r) $ mapParserMaybeM snowflake- "Couldn't find a Guild with this id"- getGuild+ parse =+ parseMP (parserName @Guild @c @r) $+ mapParserMaybeM+ snowflake+ "Couldn't find a Guild with this id"+ getGuild parameterDescription = "guild id" --- | ParameterParser for emojis in the guild the command was invoked in, this only--- looks in the cache. Use @'Snowflake' 'Emoji'@ and use--- 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching from http.+{- | ParameterParser for emojis in the guild the command was invoked in, this only+ looks in the cache. Use @'Snowflake' 'Emoji'@ and use+ 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching from http.+-} instance (P.Member CacheEff r, CalamityCommandContext c) => ParameterParser Emoji c r where- parse = parseMP (parserName @Emoji @c @r) $ mapParserMaybeM (try emoji <|> snowflake)- "Couldn't find an Emoji with this id"- (\eid -> do- ctx <- P.ask- guild <- join <$> getGuild `traverse` ctxGuildID ctx- pure $ guild ^? _Just . #emojis . ix eid)+ parse =+ parseMP (parserName @Emoji @c @r) $+ mapParserMaybeM+ (try emoji <|> snowflake)+ "Couldn't find an Emoji with this id"+ ( \eid -> do+ ctx <- P.ask+ guild <- join <$> getGuild `traverse` ctxGuildID ctx+ pure $ guild ^? _Just . #emojis . ix eid+ ) parameterDescription = "emoji or id" -- | 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--- looks in the cache. Use @'Snowflake' 'Role'@ and use--- 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching from http.+{- | ParameterParser for roles in the guild the command was invoked in, this only+ looks in the cache. Use @'Snowflake' 'Role'@ and use+ 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching from http.+-} instance (P.Member CacheEff r, CalamityCommandContext c) => ParameterParser Role c r where- parse = parseMP (parserName @Role @c @r) $ mapParserMaybeM (try (ping "@&") <|> snowflake)- "Couldn't find an Emoji with this id"- (\rid -> do- ctx <- P.ask- guild <- join <$> getGuild `traverse` ctxGuildID ctx- pure $ guild ^? _Just . #roles . ix rid)+ parse =+ parseMP (parserName @Role @c @r) $+ mapParserMaybeM+ (try (ping "@&") <|> snowflake)+ "Couldn't find an Emoji with this id"+ ( \rid -> do+ ctx <- P.ask+ guild <- join <$> getGuild `traverse` ctxGuildID ctx+ pure $ guild ^? _Just . #roles . ix rid+ ) parameterDescription = "role mention or id" -- skipN :: (Stream s, Ord e) => Int -> ParsecT e s m () -- skipN n = void $ takeP Nothing n -ping :: MonadParsec e L.Text m => L.Text -> m (Snowflake a)+ping :: MonadParsec e T.Text m => T.Text -> m (Snowflake a) ping c = chunk ("<" <> c) *> optional (chunk "!") *> snowflake <* chunk ">" -ping' :: MonadParsec e L.Text m => m () -> m (Snowflake a)+ping' :: MonadParsec e T.Text m => m () -> m (Snowflake a) ping' m = chunk "<" *> m *> snowflake <* chunk ">" -snowflake :: MonadParsec e L.Text m => m (Snowflake a)+snowflake :: MonadParsec e T.Text m => m (Snowflake a) snowflake = Snowflake <$> decimal -partialEmoji :: MonadParsec e L.Text m => m (Partial Emoji)+partialEmoji :: MonadParsec e T.Text m => m (Partial Emoji) partialEmoji = do animated <- isJust <$> (chunk "<" *> optional (chunk "a"))- name <- between (chunk ":") (chunk ":") (takeWhileP (Just "Emoji name") (/= ':'))+ name <- between (chunk ":") (chunk ":") (takeWhileP (Just "Emoji name") (/= ':')) id <- snowflake void $ chunk ">" pure (PartialEmoji id name animated) -emoji :: MonadParsec e L.Text m => m (Snowflake a)+emoji :: MonadParsec e T.Text m => m (Snowflake a) emoji = ping' (optional (chunk "a") *> between (chunk ":") (chunk ":") (void $ takeWhileP Nothing (/= ':'))) -- trackOffsets :: MonadParsec e s m => m a -> m (a, Int)
Calamity/Commands/Context.hs view
@@ -19,7 +19,7 @@ import Control.Applicative import Control.Lens hiding (Context) import Control.Monad-import qualified Data.Text.Lazy as L+import qualified Data.Text as T import GHC.Generics import qualified Polysemy as P import qualified Polysemy.Fail as P@@ -57,9 +57,9 @@ , -- | The command that was invoked command :: Command FullContext , -- | The prefix that was used to invoke the command- prefix :: L.Text+ prefix :: T.Text , -- | The message remaining after consuming the prefix- unparsedParams :: L.Text+ unparsedParams :: T.Text } deriving (Show, Generic) deriving (TextShow) via TSG.FromGeneric FullContext@@ -88,7 +88,7 @@ CC.ConstructContext (pre, cmd, up) (msg, usr, mem) -> buildContext msg usr mem pre cmd up ) -buildContext :: P.Member CacheEff r => Message -> User -> Maybe Member -> L.Text -> Command FullContext -> L.Text -> P.Sem r (Maybe FullContext)+buildContext :: P.Member CacheEff r => Message -> User -> Maybe Member -> T.Text -> Command FullContext -> T.Text -> P.Sem r (Maybe FullContext) buildContext msg usr mem prefix command unparsed = (rightToMaybe <$>) . P.runFail $ do guild <- join <$> getGuild `traverse` (msg ^. #guildID) let member = mem <|> guild ^? _Just . #members . ix (coerceSnowflake $ getID @User msg)@@ -116,9 +116,9 @@ , -- | The command that was invoked command :: Command LightContext , -- | The prefix that was used to invoke the command- prefix :: L.Text+ prefix :: T.Text , -- | The message remaining after consuming the prefix- unparsedParams :: L.Text+ unparsedParams :: T.Text } deriving (Show, Generic) deriving (TextShow) via TSG.FromGeneric LightContext
Calamity/Commands/Dsl.hs view
@@ -30,8 +30,7 @@ import Calamity.Commands.Types -import qualified Data.Text as S-import qualified Data.Text.Lazy as L+import qualified Data.Text as T import CalamityCommands.CommandUtils (CommandForParsers, TypedCommandC) import qualified CalamityCommands.Context as CC@@ -78,7 +77,7 @@ $ 'Calamity.Commands.Utils.addCommands' $ do 'Calamity.Commands.Help.helpCommand' 'Calamity.Commands.Dsl.command' \@'[] "test" \\ctx ->- 'Control.Monad.void' $ 'Calamity.Types.Tellable.tell' \@'L.Text' ctx "hi"+ 'Control.Monad.void' $ 'Calamity.Types.Tellable.tell' \@'T.Text' ctx "hi" @ The above block will create a command with no parameters named \'test\',@@ -95,7 +94,7 @@ command' :: P.Member (P.Final IO) r => -- | The name of the command- S.Text ->+ T.Text -> -- | The command's parameters [ParameterInfo] -> -- | The parser for this command@@ -115,9 +114,9 @@ commandA' :: P.Member (P.Final IO) r => -- | The name of the command- S.Text ->+ T.Text -> -- | The aliases for the command- [S.Text] ->+ [T.Text] -> -- | The command's parameters [ParameterInfo] -> -- | The parser for this command@@ -144,12 +143,12 @@ @ 'Calamity.Commands.Dsl.command' \@\'['CalamityCommands.Parser.Named' "user" ('Calamity.Types.Snowflake' 'Calamity.Types.Model.User'),- 'CalamityCommands.Parser.Named' "reason" ('CalamityCommands.Parser.KleeneStarConcat' 'S.Text')]+ 'CalamityCommands.Parser.Named' "reason" ('CalamityCommands.Parser.KleeneStarConcat' 'T.Text')] "ban" $ \\ctx uid r -> case (ctx 'Control.Lens.^.' #guild) of 'Just' guild -> do 'Control.Monad.void' . 'Calamity.HTTP.invoke' $ 'Calamity.HTTP.Guild.CreateGuildBan' guild uid ('Calamity.HTTP.Guild.CreateGuildBanData' 'Nothing' $ 'Just' r) 'Control.Monad.void' $ 'Calamity.Types.Tellable.tell' ctx ("Banned user `" '<>' 'TextShow.showt' uid '<>' "` with reason: " '<>' r)- 'Nothing' -> 'void' $ 'Calamity.Types.Tellable.tell' @'L.Text' ctx "Can only ban users from guilds."+ 'Nothing' -> 'void' $ 'Calamity.Types.Tellable.tell' @'T.Text' ctx "Can only ban users from guilds." @ -} command ::@@ -159,7 +158,7 @@ , TypedCommandC ps c () r ) => -- | The name of the command- S.Text ->+ T.Text -> -- | The callback for this command (c -> CommandForParsers ps r ()) -> P.Sem (DSLState c r) (Command c)@@ -177,12 +176,12 @@ @ 'commandA' \@\'['CalamityCommands.Parser.Named' "user" ('Calamity.Types.Snowflake' 'Calamity.Types.Model.User'),- 'CalamityCommands.Parser.Named' "reason" ('CalamityCommands.Parser.KleeneStarConcat' 'S.Text')]+ 'CalamityCommands.Parser.Named' "reason" ('CalamityCommands.Parser.KleeneStarConcat' 'T.Text')] "ban" [] $ \\ctx uid r -> case (ctx 'Control.Lens.^.' #guild) of 'Just' guild -> do 'Control.Monad.void' . 'Calamity.HTTP.invoke' $ 'Calamity.HTTP.Guild.CreateGuildBan' guild uid ('Calamity.HTTP.Guild.CreateGuildBanData' 'Nothing' $ 'Just' r) 'Control.Monad.void' $ 'Calamity.Types.Tellable.tell' ctx ("Banned user `" '<>' 'TextShow.showt' uid '<>' "` with reason: " '<>' r)- 'Nothing' -> 'void' $ 'Calamity.Types.Tellable.tell' @'L.Text' ctx "Can only ban users from guilds."+ 'Nothing' -> 'void' $ 'Calamity.Types.Tellable.tell' @'T.Text' ctx "Can only ban users from guilds." @ -} commandA ::@@ -192,9 +191,9 @@ , TypedCommandC ps c () r ) => -- | The name of the command- S.Text ->+ T.Text -> -- | The aliases for the command- [S.Text] ->+ [T.Text] -> -- | The callback for this command (c -> CommandForParsers ps r ()) -> P.Sem (DSLState c r) (Command c)@@ -211,8 +210,8 @@ -- | Set the help for any groups or commands registered inside the given action. help ::- P.Member (P.Reader (c -> L.Text)) r =>- (c -> L.Text) ->+ P.Member (P.Reader (c -> T.Text)) r =>+ (c -> T.Text) -> P.Sem r a -> P.Sem r a help = CC.help@@ -234,9 +233,9 @@ requires' :: P.Member (P.Final IO) r => -- | The name of the check- S.Text ->+ T.Text -> -- | The callback for the check- (c -> P.Sem r (Maybe L.Text)) ->+ (c -> P.Sem r (Maybe T.Text)) -> P.Sem (DSLState c r) a -> P.Sem (DSLState c r) a requires' = CC.requires'@@ -247,7 +246,7 @@ Refer to 'CalamityCommands.Check.Check' for more info on checks. -} requiresPure ::- [(S.Text, c -> Maybe L.Text)] ->+ [(T.Text, c -> Maybe T.Text)] -> -- A list of check names and check callbacks P.Sem (DSLState c r) a -> P.Sem (DSLState c r) a@@ -262,7 +261,7 @@ group :: P.Member (P.Final IO) r => -- | The name of the group- S.Text ->+ T.Text -> P.Sem (DSLState c r) a -> P.Sem (DSLState c r) a group = CC.group@@ -279,9 +278,9 @@ groupA :: P.Member (P.Final IO) r => -- | The name of the group- S.Text ->+ T.Text -> -- | The aliases of the group- [S.Text] ->+ [T.Text] -> P.Sem (DSLState c r) a -> P.Sem (DSLState c r) a groupA = CC.groupA@@ -298,7 +297,7 @@ group' :: P.Member (P.Final IO) r => -- | The name of the group- S.Text ->+ T.Text -> P.Sem (DSLState c r) a -> P.Sem (DSLState c r) a group' = CC.group'@@ -315,9 +314,9 @@ groupA' :: P.Member (P.Final IO) r => -- | The name of the group- S.Text ->+ T.Text -> -- | The aliases of the group- [S.Text] ->+ [T.Text] -> P.Sem (DSLState c r) a -> P.Sem (DSLState c r) a groupA' = CC.groupA'
Calamity/Commands/Utils.hs view
@@ -25,15 +25,14 @@ import qualified CalamityCommands.ParsePrefix as CC import qualified CalamityCommands.Utils as CC import Control.Monad-import qualified Data.Text as S-import qualified Data.Text.Lazy as L+import qualified Data.Text as T import Data.Typeable import GHC.Generics (Generic) import qualified Polysemy as P data CmdInvokeFailReason c = NoContext- | NotFound [L.Text]+ | NotFound [T.Text] | CommandInvokeError c CC.CommandError data CtxCommandError c = CtxCommandError@@ -47,7 +46,7 @@ , user :: User , member :: Maybe Member , -- | The groups that were successfully parsed- path :: [L.Text]+ path :: [T.Text] } deriving (Show, Generic) @@ -57,9 +56,9 @@ deriving stock (Show, Generic) -- | A default interpretation for 'CC.ParsePrefix' that uses a single constant prefix.-useConstantPrefix :: L.Text -> P.Sem (CC.ParsePrefix Message ': r) a -> P.Sem r a+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, ) <$> L.stripPrefix pre content))+ 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.@@ -108,7 +107,7 @@ 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", S.unwords $ commandPath (CC.ctxCommand ctx))]+ cmdInvoke <- registerCounter "commands_invoked" [("name", T.unwords $ commandPath (CC.ctxCommand ctx))] void $ addCounter 1 cmdInvoke fire . customEvt $ CommandInvoked ctx
Calamity/Gateway/DispatchEvents.hs view
@@ -20,7 +20,7 @@ import Calamity.Types.Snowflake import Data.Aeson import Data.Kind (Type)-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Time import Data.Typeable (Typeable) import GHC.Generics
Calamity/Gateway/Shard.hs view
@@ -31,7 +31,7 @@ import Data.Functor import Data.IORef import Data.Maybe-import qualified Data.Text.Lazy as L+import qualified Data.Text as T import DiPolysemy hiding (debug, error, info) import qualified Network.Connection as NC import qualified Network.TLS as NT@@ -51,15 +51,15 @@ import qualified Polysemy.AtomicState as P import qualified Polysemy.Error as P import qualified Polysemy.Resource as P+import PyF import qualified System.X509 as X509-import TextShow (showtl)+import TextShow (showt) import Prelude hiding (error)-import PyF runWebsocket :: P.Members '[LogEff, P.Final IO, P.Embed IO] r =>- L.Text ->- L.Text ->+ T.Text ->+ T.Text -> (Connection -> P.Sem r a) -> P.Sem r (Maybe a) runWebsocket host path ma = do@@ -77,7 +77,7 @@ ctx <- NC.initConnectionContext certStore <- X509.getSystemCertificateStore let clientParams =- (NT.defaultParamsClient (L.unpack host) "443")+ (NT.defaultParamsClient (T.unpack host) "443") { NT.clientSupported = def{NT.supportedCiphers = NT.ciphersuite_default} , NT.clientShared = def@@ -85,7 +85,7 @@ } } let tlsSettings = NC.TLSSettings clientParams- connParams = NC.ConnectionParams (L.unpack host) 443 (Just tlsSettings) Nothing+ connParams = NC.ConnectionParams (T.unpack host) 443 (Just tlsSettings) Nothing Ex.bracket (NC.connectTo ctx connParams)@@ -95,7 +95,7 @@ NW.makeStream (Just <$> NC.connectionGetChunk conn) (maybe (pure ()) (NC.connectionPut conn . LBS.toStrict))- NW.runClientWithStream stream (L.unpack host) (L.unpack path) NW.defaultConnectionOptions [] inner+ NW.runClientWithStream stream (T.unpack host) (T.unpack path) NW.defaultConnectionOptions [] inner ) newShardState :: Shard -> ShardState@@ -104,7 +104,7 @@ -- | Creates and launches a shard newShard :: P.Members '[LogEff, MetricEff, P.Embed IO, P.Final IO, P.Async] r =>- L.Text ->+ T.Text -> Int -> Int -> Token ->@@ -142,7 +142,7 @@ Just True -> pure True Nothing -> pure False -restartUnless :: P.Members '[LogEff, P.Error ShardFlowControl] r => L.Text -> Maybe a -> P.Sem r a+restartUnless :: P.Members '[LogEff, P.Error ShardFlowControl] r => T.Text -> Maybe a -> P.Sem r a restartUnless _ (Just a) = pure a restartUnless msg Nothing = do error msg@@ -166,12 +166,12 @@ r <- atomically $ tryWriteTBMQueue' outqueue (Control v) when r inner - handleWSException :: SomeException -> IO (Either (ControlMessage, Maybe L.Text) a)+ handleWSException :: SomeException -> IO (Either (ControlMessage, Maybe T.Text) a) handleWSException e = pure $ case fromException e of Just (CloseRequest code _) | code `elem` [4004, 4010, 4011, 4012, 4013, 4014] ->- Left (ShutDownShard, Just . showtl $ code)- e -> Left (RestartShard, Just . L.pack . show $ e)+ 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 () discordStream ws outqueue = inner@@ -196,7 +196,7 @@ outerloop = whileMFinalIO $ do shard :: Shard <- P.atomicGets (^. #shardS) let host = shard ^. #gateway- let host' = fromMaybe host $ L.stripPrefix "wss://" host+ let host' = fromMaybe host $ T.stripPrefix "wss://" host info [fmt|starting up shard {shardID shard} of {shardCount shard}|] innerLoopVal <- runWebsocket host' "/?v=9&encoding=json" innerloop@@ -351,5 +351,5 @@ unlessM (P.atomicGets (^. #hbResponse)) $ do debug "No heartbeat response, restarting shard" wsConn <- P.note () =<< P.atomicGets (^. #wsConn)- P.embed $ sendCloseCode wsConn 4000 ("No heartbeat in time" :: L.Text)+ P.embed $ sendCloseCode wsConn 4000 ("No heartbeat in time" :: T.Text) P.throw ()
Calamity/Gateway/Types.hs view
@@ -33,7 +33,7 @@ import qualified Data.Aeson.Types as AT import Data.Generics.Labels () import Data.Maybe-import Data.Text.Lazy ( Text )+import Data.Text ( Text ) import GHC.Generics
Calamity/HTTP/Channel.hs view
@@ -26,10 +26,10 @@ import Calamity.Types.Snowflake import Control.Lens hiding ((.=)) import Data.Aeson+import qualified Data.Aeson.KeyMap as K import Data.ByteString.Lazy (ByteString) import Data.Default.Class import Data.Generics.Product.Subtype (upcast)-import qualified Data.HashMap.Strict as H import Data.Text (Text) import qualified Data.Text as S import Data.Word@@ -106,16 +106,16 @@ deriving newtype (ToJSON, Semigroup, Monoid) editMessageContent :: Maybe Text -> EditMessageData-editMessageContent v = EditMessageData $ H.fromList [("content", toJSON v)]+editMessageContent v = EditMessageData $ K.fromList [("content", toJSON v)] editMessageEmbed :: Maybe Embed -> EditMessageData-editMessageEmbed v = EditMessageData $ H.fromList [("embed", toJSON v)]+editMessageEmbed v = EditMessageData $ K.fromList [("embed", toJSON v)] editMessageFlags :: Maybe Word64 -> EditMessageData-editMessageFlags v = EditMessageData $ H.fromList [("flags", toJSON v)]+editMessageFlags v = EditMessageData $ K.fromList [("flags", toJSON v)] editMessageAllowedMentions :: Maybe AllowedMentions -> EditMessageData-editMessageAllowedMentions v = EditMessageData $ H.fromList [("allowed_mentions", toJSON v)]+editMessageAllowedMentions v = EditMessageData $ K.fromList [("allowed_mentions", toJSON v)] data ChannelUpdate = ChannelUpdate { name :: Maybe Text@@ -205,8 +205,8 @@ & giveID id renderEmoji :: RawEmoji -> Text-renderEmoji (UnicodeEmoji e) = e ^. strict-renderEmoji (CustomEmoji e) = e ^. #name . strict <> ":" <> showt (e ^. #id)+renderEmoji (UnicodeEmoji e) = e+renderEmoji (CustomEmoji e) = e ^. #name <> ":" <> showt (e ^. #id) instance Request (ChannelRequest a) where type Result (ChannelRequest a) = a
Calamity/HTTP/Guild.hs view
@@ -1,26 +1,26 @@ -- | Guild endpoints module Calamity.HTTP.Guild (- GuildRequest (..),- CreateGuildData (..),- ModifyGuildData (..),- ChannelCreateData (..),- ChannelPosition (..),- ListMembersOptions (..),- AddGuildMemberData (..),- ModifyGuildMemberData (..),- modifyGuildMemberNick,- modifyGuildMemberRoles,- modifyGuildMemberMute,- modifyGuildMemberDeaf,- modifyGuildMemberChannelID,- CreateGuildBanData (..),- ModifyGuildRoleData (..),- modifyGuildRoleName,- modifyGuildRolePermissions,- modifyGuildRoleColour,- modifyGuildRoleHoist,- modifyGuildRoleMentionable,- ModifyGuildRolePositionsData (..),+ GuildRequest (..),+ CreateGuildData (..),+ ModifyGuildData (..),+ ChannelCreateData (..),+ ChannelPosition (..),+ ListMembersOptions (..),+ AddGuildMemberData (..),+ ModifyGuildMemberData (..),+ modifyGuildMemberNick,+ modifyGuildMemberRoles,+ modifyGuildMemberMute,+ modifyGuildMemberDeaf,+ modifyGuildMemberChannelID,+ CreateGuildBanData (..),+ ModifyGuildRoleData (..),+ modifyGuildRoleName,+ modifyGuildRolePermissions,+ modifyGuildRoleColour,+ modifyGuildRoleHoist,+ modifyGuildRoleMentionable,+ ModifyGuildRolePositionsData (..), ) where import Calamity.HTTP.Internal.Request@@ -34,10 +34,10 @@ import Calamity.Types.Snowflake import Control.Lens hiding ((.=)) import Data.Aeson+import qualified Data.Aeson.KeyMap as K import Data.Aeson.Lens import Data.Colour (Colour) import Data.Default.Class-import qualified Data.HashMap.Strict as H import Data.Text (Text) import GHC.Generics import Network.HTTP.Req@@ -111,33 +111,34 @@ deriving (Show, Generic) deriving (ToJSON) via CalamityJSON AddGuildMemberData --- | Parameters to the Modify Guild Member endpoint.------ Use the provided methods (@modifyGuildMemberX@) to create a value with the--- field set, use the Semigroup instance to union the values.------ ==== Examples------ >>> encode $ modifyGuildMemberNick (Just "test") <> modifyGuildMemberDeaf Nothing--- "{\"nick\":\"test\",\"deaf\":null}"+{- | Parameters to the Modify Guild Member endpoint.++ Use the provided methods (@modifyGuildMemberX@) to create a value with the+ field set, use the Semigroup instance to union the values.++ ==== Examples++ >>> encode $ modifyGuildMemberNick (Just "test") <> modifyGuildMemberDeaf Nothing+ "{\"nick\":\"test\",\"deaf\":null}"+-} newtype ModifyGuildMemberData = ModifyGuildMemberData Object- deriving (Show, Generic)- deriving newtype (ToJSON, Semigroup, Monoid)+ deriving (Show, Generic)+ deriving newtype (ToJSON, Semigroup, Monoid) modifyGuildMemberNick :: Maybe Text -> ModifyGuildMemberData-modifyGuildMemberNick v = ModifyGuildMemberData $ H.fromList [("nick", toJSON v)]+modifyGuildMemberNick v = ModifyGuildMemberData $ K.fromList [("nick", toJSON v)] modifyGuildMemberRoles :: Maybe [Snowflake Role] -> ModifyGuildMemberData-modifyGuildMemberRoles v = ModifyGuildMemberData $ H.fromList [("roles", toJSON v)]+modifyGuildMemberRoles v = ModifyGuildMemberData $ K.fromList [("roles", toJSON v)] modifyGuildMemberMute :: Maybe Bool -> ModifyGuildMemberData-modifyGuildMemberMute v = ModifyGuildMemberData $ H.fromList [("mute", toJSON v)]+modifyGuildMemberMute v = ModifyGuildMemberData $ K.fromList [("mute", toJSON v)] modifyGuildMemberDeaf :: Maybe Bool -> ModifyGuildMemberData-modifyGuildMemberDeaf v = ModifyGuildMemberData $ H.fromList [("deaf", toJSON v)]+modifyGuildMemberDeaf v = ModifyGuildMemberData $ K.fromList [("deaf", toJSON v)] modifyGuildMemberChannelID :: Maybe (Snowflake VoiceChannel) -> ModifyGuildMemberData-modifyGuildMemberChannelID v = ModifyGuildMemberData $ H.fromList [("channel_id", toJSON v)]+modifyGuildMemberChannelID v = ModifyGuildMemberData $ K.fromList [("channel_id", toJSON v)] data CreateGuildBanData = CreateGuildBanData { deleteMessageDays :: Maybe Integer@@ -145,34 +146,34 @@ } deriving (Show, Generic, Default) --- | Parameters to the Modify Guild Role endpoint.------ Use the provided methods (@modifyGuildRoleX@) to create a value with the--- field set, use the Semigroup instance to union the values.------ ==== Examples------ >>> encode $ modifyGuildRoleName (Just "test") <> modifyGuildRolePermissions Nothing--- "{\"name\":\"test\",\"permissions\":null}"-newtype ModifyGuildRoleData = ModifyGuildRoleData Object- deriving (Show, Generic)- deriving newtype (ToJSON, Semigroup, Monoid)+{- | Parameters to the Modify Guild Role endpoint. + Use the provided methods (@modifyGuildRoleX@) to create a value with the+ field set, use the Semigroup instance to union the values. + ==== Examples++ >>> encode $ modifyGuildRoleName (Just "test") <> modifyGuildRolePermissions Nothing+ "{\"name\":\"test\",\"permissions\":null}"+-}+newtype ModifyGuildRoleData = ModifyGuildRoleData Object+ deriving (Show, Generic)+ deriving newtype (ToJSON, Semigroup, Monoid)+ modifyGuildRoleName :: Maybe Text -> ModifyGuildRoleData-modifyGuildRoleName v = ModifyGuildRoleData $ H.fromList [("name", toJSON v)]+modifyGuildRoleName v = ModifyGuildRoleData $ K.fromList [("name", toJSON v)] modifyGuildRolePermissions :: Maybe Permissions -> ModifyGuildRoleData-modifyGuildRolePermissions v = ModifyGuildRoleData $ H.fromList [("permissions", toJSON v)]+modifyGuildRolePermissions v = ModifyGuildRoleData $ K.fromList [("permissions", toJSON v)] modifyGuildRoleColour :: Maybe (Colour Double) -> ModifyGuildRoleData-modifyGuildRoleColour v = ModifyGuildRoleData $ H.fromList [("colour", toJSON (IntColour <$> v))]+modifyGuildRoleColour v = ModifyGuildRoleData $ K.fromList [("colour", toJSON (IntColour <$> v))] modifyGuildRoleHoist :: Maybe Bool -> ModifyGuildRoleData-modifyGuildRoleHoist v = ModifyGuildRoleData $ H.fromList [("hoist", toJSON v)]+modifyGuildRoleHoist v = ModifyGuildRoleData $ K.fromList [("hoist", toJSON v)] modifyGuildRoleMentionable :: Maybe Bool -> ModifyGuildRoleData-modifyGuildRoleMentionable v = ModifyGuildRoleData $ H.fromList [("mentionable", toJSON v)]+modifyGuildRoleMentionable v = ModifyGuildRoleData $ K.fromList [("mentionable", toJSON v)] data ModifyGuildRolePositionsData = ModifyGuildRolePositionsData { id :: Snowflake Role
Calamity/HTTP/Internal/Ratelimit.hs view
@@ -21,7 +21,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.Maybe-import qualified Data.Text.Lazy as LT+import qualified Data.Text as T import Data.Time import Data.Time.Clock.POSIX import Network.HTTP.Client (responseStatus)@@ -220,7 +220,7 @@ pure $ ServerError (statusCode status) Left e -> do error [fmt|Something went wrong with the http client: {e}|]- pure . InternalResponseError $ LT.pack e+ pure . InternalResponseError $ T.pack e -- | Parse a ratelimit header returning when it unlocks parseRateLimitHeader :: HttpResponse r => UTCTime -> r -> Maybe UTCTime
Calamity/HTTP/Internal/Request.hs view
@@ -27,10 +27,10 @@ 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 qualified Data.Text.Lazy as TL import DiPolysemy hiding (debug, error, info) @@ -42,26 +42,22 @@ import qualified Polysemy.Error as P import qualified Polysemy.Reader as P -fromResult :: P.Member (P.Error RestError) r => Data.Aeson.Result a -> Sem r a-fromResult (Success a) = pure a-fromResult (Error e) = P.throw (InternalClientError . TL.pack $ e)--fromJSONDecode :: P.Member (P.Error RestError) r => Either String a -> Sem r a-fromJSONDecode (Right a) = pure a-fromJSONDecode (Left e) = P.throw (InternalClientError . TL.pack $ e)+throwIfLeft :: P.Member (P.Error RestError) r => Either String a -> Sem r a+throwIfLeft (Right a) = pure a+throwIfLeft (Left e) = P.throw (InternalClientError . T.pack $ e) extractRight :: P.Member (P.Error e) r => Either e a -> Sem r a extractRight (Left e) = P.throw e extractRight (Right a) = pure a class ReadResponse a where- readResp :: LB.ByteString -> Either String a+ processResp :: LB.ByteString -> (Value -> Value) -> Either String a -instance ReadResponse () where- readResp = const (Right ())+instance {-# OVERLAPPABLE #-} FromJSON a => ReadResponse a where+ processResp s f = eitherDecode s >>= parseEither parseJSON . f -instance {-# OVERLAPS #-} FromJSON a => ReadResponse a where- readResp = eitherDecode+instance ReadResponse () where+ processResp _ _ = Right () class Request a where type Result a@@ -73,7 +69,7 @@ modifyResponse :: a -> Value -> Value modifyResponse _ = id -invoke :: (BotC r, Request a, FromJSON (Calamity.HTTP.Internal.Request.Result a)) => a -> Sem r (Either RestError (Calamity.HTTP.Internal.Request.Result a))+invoke :: (BotC r, Request a, ReadResponse (Calamity.HTTP.Internal.Request.Result a)) => a -> Sem r (Either RestError (Calamity.HTTP.Internal.Request.Result a)) invoke a = do rlState' <- P.asks (^. #rlState) token' <- P.asks (^. #token)@@ -92,7 +88,9 @@ void $ modifyGauge (subtract 1) inFlightRequests - P.runError $ fromResult . fromJSON . modifyResponse a =<< fromJSONDecode . readResp =<< extractRight resp+ P.runError $ do+ s <- extractRight resp+ throwIfLeft $ processResp s (modifyResponse a) reqConfig :: HttpConfig reqConfig =@@ -106,7 +104,7 @@ <> header "X-RateLimit-Precision" "millisecond" requestOptions :: Token -> Option 'Https-requestOptions t = defaultRequestOptions <> header "Authorization" (TS.encodeUtf8 . TL.toStrict $ formatToken t)+requestOptions t = defaultRequestOptions <> header "Authorization" (TS.encodeUtf8 $ formatToken t) getWith :: Url 'Https -> Option 'Https -> Req LbsResponse getWith u = req GET u NoReqBody lbsResponse
Calamity/HTTP/Internal/Types.hs view
@@ -10,18 +10,14 @@ import Calamity.HTTP.Internal.Route import Calamity.Internal.AesonThings- import Control.Concurrent.Event ( Event ) import Control.Concurrent.STM.TVar ( TVar )- import Data.Time import Data.Aeson import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString as B-import Data.Text.Lazy-+import Data.Text as T import GHC.Generics- import qualified StmContainers.Map as SC data RestError@@ -31,7 +27,7 @@ , response :: Maybe Value } -- | Something failed while making the request (after retrying a few times)- | InternalClientError Text+ | InternalClientError T.Text deriving ( Show, Generic ) data BucketState = BucketState@@ -75,16 +71,16 @@ (Maybe (BucketState, B.ByteString)) | ServerError Int -- ^ Discord's error, we should retry (HTTP 5XX) | ClientError Int LB.ByteString -- ^ Our error, we should fail- | InternalResponseError Text -- ^ Something went wrong with the http client+ | InternalResponseError T.Text -- ^ Something went wrong with the http client newtype GatewayResponse = GatewayResponse- { url :: Text+ { url :: T.Text } deriving ( Generic, Show ) deriving ( FromJSON ) via CalamityJSON GatewayResponse data BotGatewayResponse = BotGatewayResponse- { url :: Text+ { url :: T.Text , shards :: Int } deriving ( Generic, Show )
Calamity/Internal/AesonThings.hs view
@@ -21,16 +21,15 @@ import Data.Aeson.Types ( Parser ) import Data.Kind import Data.Reflection ( Reifies(..) )-import Data.Text ( Text )-import Data.Text.Strict.Lens import Data.Typeable+import Data.String ( IsString(fromString) ) import GHC.Generics import GHC.TypeLits ( KnownSymbol, symbolVal ) import Control.Monad ((>=>)) -textSymbolVal :: forall n. KnownSymbol n => Text-textSymbolVal = symbolVal @n Proxy ^. packed+textSymbolVal :: forall n s. (KnownSymbol n, IsString s) => s+textSymbolVal = fromString $ symbolVal @n Proxy data IfNoneThen label def data ExtractFieldInto label field target
Calamity/Internal/Utils.hs view
@@ -30,7 +30,7 @@ import Data.Default.Class import qualified Data.Map as M import Data.Semigroup (Last (..))-import Data.Text.Lazy+import Data.Text import qualified Data.Vector.Unboxing as VU import qualified DiPolysemy as Di import qualified Polysemy as P
Calamity/Types/Model/Channel.hs view
@@ -1,44 +1,43 @@ -- | The generic channel type-module Calamity.Types.Model.Channel- ( Channel(..)- , Partial(PartialChannel)- , module Calamity.Types.Model.Channel.DM- , module Calamity.Types.Model.Channel.Group- , module Calamity.Types.Model.Channel.Guild- , module Calamity.Types.Model.Channel.Attachment- , module Calamity.Types.Model.Channel.Reaction- , module Calamity.Types.Model.Channel.Webhook- , module Calamity.Types.Model.Channel.Embed- , module Calamity.Types.Model.Channel.ChannelType- , module Calamity.Types.Model.Channel.Message ) where--import Calamity.Internal.AesonThings-import Calamity.Types.Model.Channel.Attachment-import Calamity.Types.Model.Channel.ChannelType-import Calamity.Types.Model.Channel.DM-import Calamity.Types.Model.Channel.Embed-import Calamity.Types.Model.Channel.Group-import Calamity.Types.Model.Channel.Guild-import Calamity.Types.Model.Channel.Message-import Calamity.Types.Model.Channel.Reaction-import Calamity.Types.Model.Channel.Webhook-import Calamity.Types.Partial-import Calamity.Types.Snowflake--import Data.Aeson-import Data.Text.Lazy ( Text )+module Calamity.Types.Model.Channel (+ Channel (..),+ Partial (PartialChannel),+ module Calamity.Types.Model.Channel.DM,+ module Calamity.Types.Model.Channel.Group,+ module Calamity.Types.Model.Channel.Guild,+ module Calamity.Types.Model.Channel.Attachment,+ module Calamity.Types.Model.Channel.Reaction,+ module Calamity.Types.Model.Channel.Webhook,+ module Calamity.Types.Model.Channel.Embed,+ module Calamity.Types.Model.Channel.ChannelType,+ module Calamity.Types.Model.Channel.Message,+) where -import GHC.Generics+import Calamity.Internal.AesonThings+import Calamity.Types.Model.Channel.Attachment+import Calamity.Types.Model.Channel.ChannelType+import Calamity.Types.Model.Channel.DM+import Calamity.Types.Model.Channel.Embed+import Calamity.Types.Model.Channel.Group+import Calamity.Types.Model.Channel.Guild+import Calamity.Types.Model.Channel.Message+import Calamity.Types.Model.Channel.Reaction+import Calamity.Types.Model.Channel.Webhook+import Calamity.Types.Partial+import Calamity.Types.Snowflake -import TextShow-import qualified TextShow.Generic as TSG+import Data.Aeson+import Data.Text (Text)+import GHC.Generics+import TextShow+import qualified TextShow.Generic as TSG data Channel = DMChannel' DMChannel | GroupChannel' GroupChannel | GuildChannel' GuildChannel- deriving ( Show, Eq, Generic )- deriving ( TextShow ) via TSG.FromGeneric Channel+ deriving (Show, Eq, Generic)+ deriving (TextShow) via TSG.FromGeneric Channel instance HasID Channel Channel where getID (DMChannel' a) = getID a@@ -50,19 +49,19 @@ type_ <- v .: "type" case type_ of- GuildTextType -> GuildChannel' <$> parseJSON (Object v)- GuildVoiceType -> GuildChannel' <$> parseJSON (Object v)+ GuildTextType -> GuildChannel' <$> parseJSON (Object v)+ GuildVoiceType -> GuildChannel' <$> parseJSON (Object v) GuildCategoryType -> GuildChannel' <$> parseJSON (Object v)- DMType -> DMChannel' <$> parseJSON (Object v)- GroupDMType -> GroupChannel' <$> parseJSON (Object v)+ DMType -> DMChannel' <$> parseJSON (Object v)+ GroupDMType -> GroupChannel' <$> parseJSON (Object v) data instance Partial Channel = PartialChannel- { id :: Snowflake Channel- , name :: Text- , type_ :: !ChannelType+ { id :: Snowflake Channel+ , name :: Text+ , type_ :: !ChannelType , parentID :: Maybe (Snowflake Category) }- deriving ( Show, Eq, Generic )- deriving ( TextShow ) via TSG.FromGeneric (Partial Channel)- deriving ( ToJSON, FromJSON ) via CalamityJSON (Partial Channel)- deriving ( HasID Channel ) via HasIDField "id" (Partial Channel)+ deriving (Show, Eq, Generic)+ deriving (TextShow) via TSG.FromGeneric (Partial Channel)+ deriving (ToJSON, FromJSON) via CalamityJSON (Partial Channel)+ deriving (HasID Channel) via HasIDField "id" (Partial Channel)
Calamity/Types/Model/Channel/Attachment.hs view
@@ -1,15 +1,14 @@ -- | Message attachments-module Calamity.Types.Model.Channel.Attachment- ( Attachment(..) ) where+module Calamity.Types.Model.Channel.Attachment (Attachment (..)) where -import Calamity.Internal.AesonThings ()-import Calamity.Types.Snowflake-import Data.Aeson-import Data.Text.Lazy ( Text )-import Data.Word-import GHC.Generics-import TextShow-import qualified TextShow.Generic as TSG+import Calamity.Internal.AesonThings ()+import Calamity.Types.Snowflake+import Data.Aeson+import Data.Text (Text)+import Data.Word+import GHC.Generics+import TextShow+import qualified TextShow.Generic as TSG fuseTup2 :: Monad f => (f a, f b) -> f (a, b) fuseTup2 (a, b) = do@@ -18,27 +17,29 @@ pure (a', b') data Attachment = Attachment- { id :: Snowflake Attachment- , filename :: !Text- , size :: Word64- , url :: !Text- , proxyUrl :: !Text+ { id :: Snowflake Attachment+ , filename :: !Text+ , size :: Word64+ , url :: !Text+ , proxyUrl :: !Text , dimensions :: !(Maybe (Word64, Word64)) }- deriving ( Eq, Show, Generic )- deriving ( TextShow ) via TSG.FromGeneric Attachment- deriving ( HasID Attachment ) via HasIDField "id" Attachment+ deriving (Eq, Show, Generic)+ deriving (TextShow) via TSG.FromGeneric Attachment+ deriving (HasID Attachment) via HasIDField "id" Attachment instance ToJSON Attachment where- toJSON Attachment { id, filename, size, url, proxyUrl, dimensions = Just (width, height) } = object- [ "id" .= id- , "filename" .= filename- , "size" .= size- , "url" .= url- , "proxy_url" .= proxyUrl- , "width" .= width- , "height" .= height]- toJSON Attachment { id, filename, size, url, proxyUrl } =+ toJSON Attachment{id, filename, size, url, proxyUrl, dimensions = Just (width, height)} =+ object+ [ "id" .= id+ , "filename" .= filename+ , "size" .= size+ , "url" .= url+ , "proxy_url" .= proxyUrl+ , "width" .= width+ , "height" .= height+ ]+ toJSON Attachment{id, filename, size, url, proxyUrl} = object ["id" .= id, "filename" .= filename, "size" .= size, "url" .= url, "proxy_url" .= proxyUrl] instance FromJSON Attachment where@@ -46,5 +47,6 @@ width <- v .:? "width" height <- v .:? "height" - Attachment <$> v .: "id" <*> v .: "filename" <*> v .: "size" <*> v .: "url" <*> v .: "proxy_url" <*> pure- (fuseTup2 (width, height))+ Attachment <$> v .: "id" <*> v .: "filename" <*> v .: "size" <*> v .: "url" <*> v .: "proxy_url"+ <*> pure+ (fuseTup2 (width, height))
Calamity/Types/Model/Channel/Component.hs view
@@ -13,17 +13,17 @@ import Calamity.Types.Model.Guild.Emoji import Data.Aeson import Data.Scientific (toBoundedInteger)-import qualified Data.Text.Lazy as L+import qualified Data.Text as T import GHC.Generics import TextShow import qualified TextShow.Generic as TSG data Button = Button { style :: ButtonStyle- , label :: Maybe L.Text+ , label :: Maybe T.Text , emoji :: Maybe RawEmoji- , customID :: Maybe L.Text- , url :: Maybe L.Text+ , customID :: Maybe T.Text+ , url :: Maybe T.Text , disabled :: Bool } deriving (Show, Generic)@@ -53,7 +53,7 @@ {- | Constuct a non-disabled 'Button' with the given 'ButtonStyle' and label, all other fields are set to 'Nothing' -}-button' :: ButtonStyle -> L.Text -> Button+button' :: ButtonStyle -> T.Text -> Button button' s l = Button s (Just l) Nothing Nothing Nothing False instance ToJSON ButtonStyle where
Calamity/Types/Model/Channel/Embed.hs view
@@ -26,7 +26,7 @@ import Data.Default.Class import Data.Generics.Labels () import Data.Semigroup-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Time import Data.Word import GHC.Generics
Calamity/Types/Model/Channel/Group.hs view
@@ -2,15 +2,14 @@ module Calamity.Types.Model.Channel.Group (GroupChannel (..)) where import Calamity.Internal.AesonThings+import Calamity.Internal.OverriddenVia import Calamity.Internal.Utils import {-# SOURCE #-} Calamity.Types.Model.Channel import {-# SOURCE #-} Calamity.Types.Model.Channel.Message import Calamity.Types.Model.User import Calamity.Types.Snowflake--import Calamity.Internal.OverriddenVia import Data.Aeson-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Time import Data.Vector.Unboxing (Vector) import GHC.Generics
Calamity/Types/Model/Channel/Guild.hs view
@@ -15,16 +15,12 @@ import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild import Calamity.Types.Model.Guild.Overwrite import Calamity.Types.Snowflake-+import Control.DeepSeq (NFData) import Control.Lens- import Data.Aeson import Data.Generics.Product.Fields-import Data.Text.Lazy (Text)-+import Data.Text (Text) import GHC.Generics--import Control.DeepSeq (NFData) import TextShow import qualified TextShow.Generic as TSG
Calamity/Types/Model/Channel/Guild/Category.hs view
@@ -9,7 +9,7 @@ import Calamity.Types.Snowflake import Control.DeepSeq (NFData) import Data.Aeson-import Data.Text.Lazy (Text)+import Data.Text (Text) import GHC.Generics import TextShow import qualified TextShow.Generic as TSG
Calamity/Types/Model/Channel/Guild/Text.hs view
@@ -2,6 +2,7 @@ module Calamity.Types.Model.Channel.Guild.Text (TextChannel (..)) where import Calamity.Internal.AesonThings+import Calamity.Internal.OverriddenVia import Calamity.Internal.SnowflakeMap (SnowflakeMap) import Calamity.Internal.Utils import {-# SOURCE #-} Calamity.Types.Model.Channel@@ -12,12 +13,11 @@ import Calamity.Types.Snowflake import Control.DeepSeq (NFData) import Data.Aeson-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Time import GHC.Generics import TextShow import qualified TextShow.Generic as TSG-import Calamity.Internal.OverriddenVia data TextChannel' = TextChannel' { id :: Snowflake TextChannel@@ -34,7 +34,6 @@ } deriving (Generic) deriving (TextShow) via TSG.FromGeneric TextChannel'- data TextChannel = TextChannel { id :: Snowflake TextChannel
Calamity/Types/Model/Channel/Guild/Voice.hs view
@@ -11,7 +11,7 @@ import Calamity.Types.Snowflake import Control.DeepSeq (NFData) import Data.Aeson-import Data.Text.Lazy (Text)+import Data.Text (Text) import GHC.Generics import TextShow import qualified TextShow.Generic as TSG
Calamity/Types/Model/Channel/Message.hs view
@@ -20,7 +20,7 @@ import Calamity.Types.Snowflake import Data.Aeson import Data.Scientific-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Time import qualified Data.Vector.Unboxing as UV import Data.Word (Word64)@@ -86,7 +86,7 @@ , attachments :: ![Attachment] , embeds :: ![Embed] , reactions :: ![Reaction]- , nonce :: Maybe Value + , nonce :: Maybe Value , pinned :: Bool , webhookID :: Maybe (Snowflake Webhook) , type_ :: !MessageType
Calamity/Types/Model/Channel/UpdatedMessage.hs view
@@ -7,18 +7,18 @@ import Calamity.Internal.OverriddenVia import Calamity.Internal.Utils import Calamity.Types.Model.Channel+import Calamity.Types.Model.Channel.Component import Calamity.Types.Model.Guild.Role import Calamity.Types.Model.User import Calamity.Types.Snowflake import Data.Aeson-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Time import qualified Data.Vector.Unboxing as UV+import Data.Word import GHC.Generics import TextShow import qualified TextShow.Generic as TSG-import Data.Word-import Calamity.Types.Model.Channel.Component data UpdatedMessage' = UpdatedMessage' { id :: Snowflake Message
Calamity/Types/Model/Channel/Webhook.hs view
@@ -1,32 +1,31 @@ -- | Channel webhooks-module Calamity.Types.Model.Channel.Webhook- ( Webhook(..) ) where+module Calamity.Types.Model.Channel.Webhook (Webhook (..)) where -import Calamity.Internal.AesonThings+import Calamity.Internal.AesonThings import {-# SOURCE #-} Calamity.Types.Model.Channel import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild-import Calamity.Types.Model.User-import Calamity.Types.Snowflake+import Calamity.Types.Model.User+import Calamity.Types.Snowflake -import Data.Aeson-import Data.Text.Lazy ( Text )+import Data.Aeson+import Data.Text (Text) -import GHC.Generics+import GHC.Generics -import TextShow-import qualified TextShow.Generic as TSG+import TextShow+import qualified TextShow.Generic as TSG data Webhook = Webhook- { id :: Snowflake Webhook- , type_ :: Integer- , guildID :: Maybe (Snowflake Guild)+ { id :: Snowflake Webhook+ , type_ :: Integer+ , guildID :: Maybe (Snowflake Guild) , channelID :: Maybe (Snowflake Channel)- , user :: Maybe (Snowflake User)- , name :: Text- , avatar :: Text- , token :: Maybe Text+ , user :: Maybe (Snowflake User)+ , name :: Text+ , avatar :: Text+ , token :: Maybe Text }- deriving ( Eq, Show, Generic )- deriving ( TextShow ) via TSG.FromGeneric Webhook- deriving ( FromJSON ) via WithSpecialCases '["user" `ExtractFieldFrom` "id"] Webhook- deriving ( HasID Webhook ) via HasIDField "id" Webhook+ deriving (Eq, Show, Generic)+ deriving (TextShow) via TSG.FromGeneric Webhook+ deriving (FromJSON) via WithSpecialCases '["user" `ExtractFieldFrom` "id"] Webhook+ deriving (HasID Webhook) via HasIDField "id" Webhook
Calamity/Types/Model/Guild/AuditLog.hs view
@@ -1,72 +1,73 @@ -- | Audit Log models-module Calamity.Types.Model.Guild.AuditLog- ( AuditLog(..)- , AuditLogEntry(..)- , AuditLogEntryInfo(..)- , AuditLogChange(..)- , AuditLogAction(..) ) where+module Calamity.Types.Model.Guild.AuditLog (+ AuditLog (..),+ AuditLogEntry (..),+ AuditLogEntryInfo (..),+ AuditLogChange (..),+ AuditLogAction (..),+) where -import Calamity.Internal.AesonThings-import Calamity.Internal.SnowflakeMap ( SnowflakeMap )-import Calamity.Types.Model.Channel-import Calamity.Types.Model.User-import Calamity.Types.Snowflake+import Calamity.Internal.AesonThings+import Calamity.Internal.SnowflakeMap (SnowflakeMap)+import Calamity.Types.Model.Channel+import Calamity.Types.Model.User+import Calamity.Types.Snowflake -import Data.Aeson-import Data.Scientific-import Data.Text.Lazy ( Text )+import Data.Aeson+import Data.Scientific+import Data.Text (Text) -import GHC.Generics+import GHC.Generics -import TextShow-import qualified TextShow.Generic as TSG+import TextShow+import qualified TextShow.Generic as TSG data AuditLog = AuditLog- { webhooks :: SnowflakeMap Webhook- , users :: SnowflakeMap User+ { webhooks :: SnowflakeMap Webhook+ , users :: SnowflakeMap User , auditLogEntries :: SnowflakeMap AuditLogEntry }- deriving ( Show, Generic )- deriving ( TextShow ) via TSG.FromGeneric AuditLog- deriving ( FromJSON ) via CalamityJSON AuditLog+ deriving (Show, Generic)+ deriving (TextShow) via TSG.FromGeneric AuditLog+ deriving (FromJSON) via CalamityJSON AuditLog data AuditLogEntry = AuditLogEntry- { targetID :: Maybe (Snowflake ())- , changes :: [AuditLogChange]- , userID :: Snowflake User- , id :: Snowflake AuditLogEntry+ { targetID :: Maybe (Snowflake ())+ , changes :: [AuditLogChange]+ , userID :: Snowflake User+ , id :: Snowflake AuditLogEntry , actionType :: !AuditLogAction- , options :: Maybe AuditLogEntryInfo- , reason :: Maybe Text+ , options :: Maybe AuditLogEntryInfo+ , reason :: Maybe Text }- deriving ( Show, Generic )- deriving ( TextShow ) via TSG.FromGeneric AuditLogEntry- deriving ( FromJSON ) via CalamityJSON AuditLogEntry- deriving ( HasID User ) via HasIDField "userID" AuditLogEntry- deriving ( HasID AuditLogEntry ) via HasIDField "id" AuditLogEntry+ deriving (Show, Generic)+ deriving (TextShow) via TSG.FromGeneric AuditLogEntry+ deriving (FromJSON) via CalamityJSON AuditLogEntry+ deriving (HasID User) via HasIDField "userID" AuditLogEntry+ deriving (HasID AuditLogEntry) via HasIDField "id" AuditLogEntry data AuditLogEntryInfo = AuditLogEntryInfo { deleteMemberDays :: Maybe Text- , membersRemoved :: Maybe Text- , channelID :: Maybe (Snowflake Channel)- , messageID :: Maybe (Snowflake Message)- , count :: Maybe Text- , id :: Maybe (Snowflake ())- , type_ :: Maybe Text- , roleName :: Maybe Text+ , membersRemoved :: Maybe Text+ , channelID :: Maybe (Snowflake Channel)+ , messageID :: Maybe (Snowflake Message)+ , count :: Maybe Text+ , id :: Maybe (Snowflake ())+ , type_ :: Maybe Text+ , roleName :: Maybe Text }- deriving ( Show, Generic )- deriving ( TextShow ) via TSG.FromGeneric AuditLogEntryInfo- deriving ( FromJSON ) via CalamityJSON AuditLogEntryInfo+ deriving (Show, Generic)+ deriving (TextShow) via TSG.FromGeneric AuditLogEntryInfo+ deriving (FromJSON) via CalamityJSON AuditLogEntryInfo data AuditLogChange = AuditLogChange { newValue :: Maybe Value , oldValue :: Maybe Value- , key :: Text+ , key :: Text }- deriving ( Show, Generic )- deriving ( TextShow ) via FromStringShow AuditLogChange- deriving ( FromJSON ) via CalamityJSON AuditLogChange+ deriving (Show, Generic)+ deriving (TextShow) via FromStringShow AuditLogChange+ deriving (FromJSON) via CalamityJSON AuditLogChange data AuditLogAction = GUILD_UPDATE@@ -104,89 +105,89 @@ | INTEGRATION_CREATE | INTEGRATION_UPDATE | INTEGRATION_DELETE- deriving ( Show, Generic )- deriving ( TextShow ) via TSG.FromGeneric AuditLogAction+ deriving (Show, Generic)+ deriving (TextShow) via TSG.FromGeneric AuditLogAction instance Enum AuditLogAction where toEnum v = case v of- 1 -> GUILD_UPDATE- 10 -> CHANNEL_CREATE- 11 -> CHANNEL_UPDATE- 12 -> CHANNEL_DELETE- 13 -> CHANNEL_OVERWRITE_CREATE- 14 -> CHANNEL_OVERWRITE_UPDATE- 15 -> CHANNEL_OVERWRITE_DELETE- 20 -> MEMBER_KICK- 21 -> MEMBER_PRUNE- 22 -> MEMBER_BAN_ADD- 23 -> MEMBER_BAN_REMOVE- 24 -> MEMBER_UPDATE- 25 -> MEMBER_ROLE_UPDATE- 26 -> MEMBER_MOVE- 27 -> MEMBER_DISCONNECT- 28 -> BOT_ADD- 30 -> ROLE_CREATE- 31 -> ROLE_UPDATE- 32 -> ROLE_DELETE- 40 -> INVITE_CREATE- 41 -> INVITE_UPDATE- 42 -> INVITE_DELETE- 50 -> WEBHOOK_CREATE- 51 -> WEBHOOK_UPDATE- 52 -> WEBHOOK_DELETE- 60 -> EMOJI_CREATE- 61 -> EMOJI_UPDATE- 62 -> EMOJI_DELETE- 72 -> MESSAGE_DELETE- 73 -> MESSAGE_BULK_DELETE- 74 -> MESSAGE_PIN- 75 -> MESSAGE_UNPIN- 80 -> INTEGRATION_CREATE- 81 -> INTEGRATION_UPDATE- 82 -> INTEGRATION_DELETE- _ -> error $ "Invalid AuditLogAction: " <> show v+ 1 -> GUILD_UPDATE+ 10 -> CHANNEL_CREATE+ 11 -> CHANNEL_UPDATE+ 12 -> CHANNEL_DELETE+ 13 -> CHANNEL_OVERWRITE_CREATE+ 14 -> CHANNEL_OVERWRITE_UPDATE+ 15 -> CHANNEL_OVERWRITE_DELETE+ 20 -> MEMBER_KICK+ 21 -> MEMBER_PRUNE+ 22 -> MEMBER_BAN_ADD+ 23 -> MEMBER_BAN_REMOVE+ 24 -> MEMBER_UPDATE+ 25 -> MEMBER_ROLE_UPDATE+ 26 -> MEMBER_MOVE+ 27 -> MEMBER_DISCONNECT+ 28 -> BOT_ADD+ 30 -> ROLE_CREATE+ 31 -> ROLE_UPDATE+ 32 -> ROLE_DELETE+ 40 -> INVITE_CREATE+ 41 -> INVITE_UPDATE+ 42 -> INVITE_DELETE+ 50 -> WEBHOOK_CREATE+ 51 -> WEBHOOK_UPDATE+ 52 -> WEBHOOK_DELETE+ 60 -> EMOJI_CREATE+ 61 -> EMOJI_UPDATE+ 62 -> EMOJI_DELETE+ 72 -> MESSAGE_DELETE+ 73 -> MESSAGE_BULK_DELETE+ 74 -> MESSAGE_PIN+ 75 -> MESSAGE_UNPIN+ 80 -> INTEGRATION_CREATE+ 81 -> INTEGRATION_UPDATE+ 82 -> INTEGRATION_DELETE+ _ -> error $ "Invalid AuditLogAction: " <> show v fromEnum v = case v of- GUILD_UPDATE -> 1- CHANNEL_CREATE -> 10- CHANNEL_UPDATE -> 11- CHANNEL_DELETE -> 12+ GUILD_UPDATE -> 1+ CHANNEL_CREATE -> 10+ CHANNEL_UPDATE -> 11+ CHANNEL_DELETE -> 12 CHANNEL_OVERWRITE_CREATE -> 13 CHANNEL_OVERWRITE_UPDATE -> 14 CHANNEL_OVERWRITE_DELETE -> 15- MEMBER_KICK -> 20- MEMBER_PRUNE -> 21- MEMBER_BAN_ADD -> 22- MEMBER_BAN_REMOVE -> 23- MEMBER_UPDATE -> 24- MEMBER_ROLE_UPDATE -> 25- MEMBER_MOVE -> 26- MEMBER_DISCONNECT -> 27- BOT_ADD -> 28- ROLE_CREATE -> 30- ROLE_UPDATE -> 31- ROLE_DELETE -> 32- INVITE_CREATE -> 40- INVITE_UPDATE -> 41- INVITE_DELETE -> 42- WEBHOOK_CREATE -> 50- WEBHOOK_UPDATE -> 51- WEBHOOK_DELETE -> 52- EMOJI_CREATE -> 60- EMOJI_UPDATE -> 61- EMOJI_DELETE -> 62- MESSAGE_DELETE -> 72- MESSAGE_BULK_DELETE -> 73- MESSAGE_PIN -> 74- MESSAGE_UNPIN -> 75- INTEGRATION_CREATE -> 80- INTEGRATION_UPDATE -> 81- INTEGRATION_DELETE -> 82+ MEMBER_KICK -> 20+ MEMBER_PRUNE -> 21+ MEMBER_BAN_ADD -> 22+ MEMBER_BAN_REMOVE -> 23+ MEMBER_UPDATE -> 24+ MEMBER_ROLE_UPDATE -> 25+ MEMBER_MOVE -> 26+ MEMBER_DISCONNECT -> 27+ BOT_ADD -> 28+ ROLE_CREATE -> 30+ ROLE_UPDATE -> 31+ ROLE_DELETE -> 32+ INVITE_CREATE -> 40+ INVITE_UPDATE -> 41+ INVITE_DELETE -> 42+ WEBHOOK_CREATE -> 50+ WEBHOOK_UPDATE -> 51+ WEBHOOK_DELETE -> 52+ EMOJI_CREATE -> 60+ EMOJI_UPDATE -> 61+ EMOJI_DELETE -> 62+ MESSAGE_DELETE -> 72+ MESSAGE_BULK_DELETE -> 73+ MESSAGE_PIN -> 74+ MESSAGE_UNPIN -> 75+ INTEGRATION_CREATE -> 80+ INTEGRATION_UPDATE -> 81+ INTEGRATION_DELETE -> 82 instance FromJSON AuditLogAction where parseJSON = withScientific "AuditLogAction" $ \n -> case toBoundedInteger @Int n of- Just v -> case v of -- no safe toEnum :S- 1 -> pure GUILD_UPDATE+ Just v -> case v of -- no safe toEnum :S+ 1 -> pure GUILD_UPDATE 10 -> pure CHANNEL_CREATE 11 -> pure CHANNEL_UPDATE 12 -> pure CHANNEL_DELETE@@ -221,7 +222,7 @@ 80 -> pure INTEGRATION_CREATE 81 -> pure INTEGRATION_UPDATE 82 -> pure INTEGRATION_DELETE- _ -> fail $ "Invalid AuditLogAction: " <> show n+ _ -> fail $ "Invalid AuditLogAction: " <> show n Nothing -> fail $ "Invalid AuditLogAction: " <> show n instance ToJSON AuditLogAction where
Calamity/Types/Model/Guild/Emoji.hs view
@@ -15,8 +15,7 @@ import Control.DeepSeq (NFData) import Data.Aeson import Data.Generics.Product-import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy as L+import qualified Data.Text as T import Data.Vector.Unboxing (Vector) import GHC.Generics import TextShow@@ -24,7 +23,7 @@ data Emoji' = Emoji' { id :: Snowflake Emoji- , name :: Text+ , name :: T.Text , roles :: AesonVector (Snowflake Role) , user :: Maybe (Snowflake User) , requireColons :: Bool@@ -44,7 +43,7 @@ data Emoji = Emoji { id :: Snowflake Emoji- , name :: Text+ , name :: T.Text , roles :: Vector (Snowflake Role) , user :: Maybe (Snowflake User) , requireColons :: Bool@@ -60,7 +59,7 @@ data instance Partial Emoji = PartialEmoji { id :: Snowflake Emoji- , name :: Text+ , name :: T.Text , animated :: Bool } deriving (Eq, Generic)@@ -74,27 +73,27 @@ instance Show (Partial Emoji) where show PartialEmoji{id, name, animated} =- "<" <> a <> ":" <> L.unpack name <> ":" <> show id <> ">"+ "<" <> a <> ":" <> T.unpack name <> ":" <> show id <> ">" where a = if animated then "a" else "" instance TextShow (Partial Emoji) where showb PartialEmoji{id, name, animated} =- "<" <> a <> ":" <> fromLazyText name <> ":" <> showb id <> ">"+ "<" <> a <> ":" <> fromText name <> ":" <> showb id <> ">" where a = if animated then "a" else "" data RawEmoji- = UnicodeEmoji Text+ = UnicodeEmoji T.Text | CustomEmoji (Partial Emoji) deriving (Eq, Generic) instance Show RawEmoji where- show (UnicodeEmoji v) = L.unpack v+ show (UnicodeEmoji v) = T.unpack v show (CustomEmoji p) = show p instance TextShow RawEmoji where- showb (UnicodeEmoji v) = fromLazyText v+ showb (UnicodeEmoji v) = fromText v showb (CustomEmoji p) = showb p instance ToJSON RawEmoji where@@ -105,7 +104,7 @@ parseJSON = withObject "RawEmoji" $ \v -> do m_id :: Maybe (Snowflake Emoji) <- v .:? "id" anim <- v .:? "animated" .!= False- name :: Text <- v .: "name"+ name :: T.Text <- v .: "name" pure $ case m_id of Just id -> CustomEmoji $ PartialEmoji id name anim
Calamity/Types/Model/Guild/Guild.hs view
@@ -26,7 +26,7 @@ import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as LH import Data.Maybe-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Time import Data.Word import GHC.Generics
Calamity/Types/Model/Guild/Invite.hs view
@@ -1,31 +1,30 @@ -- | Guild invites-module Calamity.Types.Model.Guild.Invite- ( Invite(..) ) where+module Calamity.Types.Model.Guild.Invite (Invite (..)) where -import Calamity.Internal.AesonThings-import Calamity.Types.Model.Channel-import Calamity.Types.Model.Guild.Guild-import Calamity.Types.Model.User-import Calamity.Types.Snowflake+import Calamity.Internal.AesonThings+import Calamity.Types.Model.Channel+import Calamity.Types.Model.Guild.Guild+import Calamity.Types.Model.User+import Calamity.Types.Snowflake -import Data.Aeson-import Data.Text.Lazy ( Text )+import Data.Aeson+import Data.Text (Text) -import GHC.Generics+import GHC.Generics -import TextShow-import qualified TextShow.Generic as TSG+import TextShow+import qualified TextShow.Generic as TSG data Invite = Invite- { code :: Text- , guild :: Maybe (Partial Guild)- , channel :: Maybe (Partial Channel)- , targetUser :: Maybe (Snowflake User)- , targetUserType :: Maybe Int+ { code :: Text+ , guild :: Maybe (Partial Guild)+ , channel :: Maybe (Partial Channel)+ , targetUser :: Maybe (Snowflake User)+ , targetUserType :: Maybe Int , approximatePresenceCount :: Maybe Int- , approximateMemberCount :: Maybe Int+ , approximateMemberCount :: Maybe Int }- deriving ( Eq, Show, Generic )- deriving ( TextShow ) via TSG.FromGeneric Invite- deriving ( ToJSON ) via CalamityJSON Invite- deriving ( FromJSON ) via WithSpecialCases '["targetUser" `ExtractFieldFrom` "id"] Invite+ deriving (Eq, Show, Generic)+ deriving (TextShow) via TSG.FromGeneric Invite+ deriving (ToJSON) via CalamityJSON Invite+ deriving (FromJSON) via WithSpecialCases '["targetUser" `ExtractFieldFrom` "id"] Invite
Calamity/Types/Model/Guild/Member.hs view
@@ -10,7 +10,7 @@ import Calamity.Types.Snowflake import Control.DeepSeq (NFData) import Data.Aeson-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Time import Data.Vector.Unboxing (Vector) import Data.Word (Word64)
Calamity/Types/Model/Guild/Role.hs view
@@ -8,14 +8,14 @@ import Data.Aeson import Data.Colour-import Data.Text.Lazy (Text)+import Data.Text (Text) import GHC.Generics +import Calamity.Internal.OverriddenVia import Control.DeepSeq (NFData (rnf), rwhnf) import TextShow import qualified TextShow.Generic as TSG-import Calamity.Internal.OverriddenVia data Role' = Role' { id :: Snowflake Role
Calamity/Types/Model/Interaction.hs view
@@ -19,7 +19,7 @@ import Data.Aeson import qualified Data.HashMap.Strict as H import Data.Scientific (toBoundedInteger)-import qualified Data.Text.Lazy as L+import qualified Data.Text as T import GHC.Generics import TextShow import qualified TextShow.Generic as TSG@@ -33,7 +33,7 @@ , channelID :: Maybe (Snowflake Channel) , member :: Maybe Member , user :: Maybe User- , token :: L.Text+ , token :: T.Text , version :: Int , message :: Maybe Message }@@ -43,11 +43,11 @@ data ApplicationCommandInteractionData = ApplicationCommandInteractionData { id :: Snowflake () -- no Command type yet- , name :: L.Text+ , name :: T.Text , resolved :: Maybe ApplicationCommandInteractionDataResolved , -- , options :: [ApplicationCommandInteractionDataOptions] -- No commands yet- customID :: L.Text+ customID :: T.Text , componentType :: ComponentType } deriving (Show, Generic)
Calamity/Types/Model/Presence/Activity.hs view
@@ -16,7 +16,7 @@ import Control.DeepSeq (NFData) import Data.Aeson import Data.Scientific-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Time (UTCTime) import Data.Word import GHC.Generics
Calamity/Types/Model/Presence/Presence.hs view
@@ -11,7 +11,7 @@ import Calamity.Types.Snowflake import Control.DeepSeq (NFData) import Data.Aeson-import Data.Text.Lazy (Text)+import Data.Text (Text) import GHC.Generics import TextShow import qualified TextShow.Generic as TSG
Calamity/Types/Model/User.hs view
@@ -9,12 +9,10 @@ import {-# SOURCE #-} Calamity.Types.Model.Guild.Member import Calamity.Types.Partial import Calamity.Types.Snowflake-+import Control.DeepSeq import Data.Aeson-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Word--import Control.DeepSeq import GHC.Generics import TextShow import qualified TextShow.Generic as TSG
Calamity/Types/Model/Voice/VoiceRegion.hs view
@@ -1,26 +1,25 @@ -- | Voice regions-module Calamity.Types.Model.Voice.VoiceRegion- ( VoiceRegion(..) ) where+module Calamity.Types.Model.Voice.VoiceRegion (VoiceRegion (..)) where -import Calamity.Internal.AesonThings-import Calamity.Types.Snowflake+import Calamity.Internal.AesonThings+import Calamity.Types.Snowflake -import Data.Aeson-import Data.Text.Lazy ( Text )+import Data.Aeson+import Data.Text (Text) -import GHC.Generics+import GHC.Generics -import TextShow-import qualified TextShow.Generic as TSG+import TextShow+import qualified TextShow.Generic as TSG data VoiceRegion = VoiceRegion- { id :: Snowflake VoiceRegion- , name :: Text- , vip :: Bool- , optimal :: Bool+ { id :: Snowflake VoiceRegion+ , name :: Text+ , vip :: Bool+ , optimal :: Bool , deprecated :: Bool- , custom :: Bool+ , custom :: Bool }- deriving ( Show, Eq, Generic )- deriving ( TextShow ) via TSG.FromGeneric VoiceRegion- deriving ( ToJSON, FromJSON ) via CalamityJSON VoiceRegion+ deriving (Show, Eq, Generic)+ deriving (TextShow) via TSG.FromGeneric VoiceRegion+ deriving (ToJSON, FromJSON) via CalamityJSON VoiceRegion
Calamity/Types/Model/Voice/VoiceState.hs view
@@ -7,7 +7,7 @@ import Calamity.Types.Snowflake import Data.Aeson-import Data.Text.Lazy (Text)+import Data.Text (Text) import GHC.Generics
Calamity/Types/Tellable.hs view
@@ -1,11 +1,11 @@ -- | Things that are messageable module Calamity.Types.Tellable (- ToMessage (..),- Tellable (..),- TFile (..),- TMention (..),- tell,- reply,+ ToMessage (..),+ Tellable (..),+ TFile (..),+ TMention (..),+ tell,+ reply, ) where import Calamity.Client.Types@@ -20,7 +20,7 @@ import Data.ByteString.Lazy (ByteString) import Data.Default.Class import Data.Monoid-import qualified Data.Text as S+import qualified Data.Text as T import qualified Data.Text.Lazy as L import GHC.Generics@@ -30,16 +30,16 @@ -- | A wrapper type for sending files data TFile- = TFile- S.Text- -- ^ The filename- ByteString- -- ^ The content- deriving (Show, Generic)+ = TFile+ T.Text+ -- ^ The filename+ ByteString+ -- ^ The content+ deriving (Show, Generic) -- | A wrapper type for allowing mentions newtype TMention a = TMention (Snowflake a)- deriving (Show, Generic)+ deriving (Show, Generic) {- | Things that can be used to send a message @@ -50,60 +50,60 @@ @ -} class ToMessage a where- -- | Turn @a@ into a 'CreateMessageOptions' builder- intoMsg :: a -> Endo CreateMessageOptions+ -- | Turn @a@ into a 'CreateMessageOptions' builder+ intoMsg :: a -> Endo CreateMessageOptions -- | Message content, '(<>)' concatenates the content instance ToMessage L.Text where- intoMsg t = Endo (#content %~ (<> Just (L.toStrict t)))+ intoMsg t = Endo (#content %~ (<> Just (L.toStrict t))) -- | Message content, '(<>)' concatenates the content-instance ToMessage S.Text where- intoMsg t = Endo (#content %~ (<> Just t))+instance ToMessage T.Text where+ intoMsg t = Endo (#content %~ (<> Just t)) -- | Message content, '(<>)' concatenates the content instance ToMessage String where- intoMsg t = Endo (#content %~ (<> Just (S.pack t)))+ intoMsg t = Endo (#content %~ (<> Just (T.pack t))) -- | Message embed, '(<>)' merges embeds using '(<>)' instance ToMessage Embed where- intoMsg e = Endo (#embed %~ (<> Just e))+ intoMsg e = Endo (#embed %~ (<> Just e)) -- | Message file, '(<>)' keeps the last added file instance ToMessage TFile where- intoMsg (TFile n f) = Endo (#file %~ getLast . (<> Last (Just (n, f))) . Last)+ intoMsg (TFile n f) = Endo (#file %~ getLast . (<> Last (Just (n, f))) . Last) -- | Allowed mentions, '(<>)' combines allowed mentions instance ToMessage AllowedMentions where- intoMsg m = Endo (#allowedMentions %~ (<> Just m))+ intoMsg m = Endo (#allowedMentions %~ (<> Just m)) -- | Add a 'User' id to the list of allowed user mentions instance ToMessage (TMention User) where- intoMsg (TMention s) = intoMsg (def @AllowedMentions & #users <>~ [s])+ intoMsg (TMention s) = intoMsg (def @AllowedMentions & #users <>~ [s]) -- | Add a 'Member' id to the list of allowed user mentions instance ToMessage (TMention Member) where- intoMsg (TMention s) = intoMsg (def @AllowedMentions & #users <>~ [coerceSnowflake s])+ intoMsg (TMention s) = intoMsg (def @AllowedMentions & #users <>~ [coerceSnowflake s]) -- | Add a 'Role' id to the list of allowed role mentions instance ToMessage (TMention Role) where- intoMsg (TMention s) = intoMsg (def @AllowedMentions & #roles <>~ [s])+ intoMsg (TMention s) = intoMsg (def @AllowedMentions & #roles <>~ [s]) -- | Set a 'MessageReference' as the message to reply to instance ToMessage MessageReference where- intoMsg ref = Endo (#messageReference ?~ ref)+ intoMsg ref = Endo (#messageReference ?~ ref) instance ToMessage (Endo CreateMessageOptions) where- intoMsg = Prelude.id+ intoMsg = Prelude.id instance ToMessage (CreateMessageOptions -> CreateMessageOptions) where- intoMsg = Endo+ intoMsg = Endo instance ToMessage CreateMessageOptions where- intoMsg = Endo . const+ intoMsg = Endo . const class Tellable a where- getChannel :: (BotC r, P.Member (P.Error RestError) r) => a -> P.Sem r (Snowflake Channel)+ getChannel :: (BotC r, P.Member (P.Error RestError) r) => a -> P.Sem r (Snowflake Channel) runToMessage :: ToMessage a => a -> CreateMessageOptions runToMessage = flip appEndo def . intoMsg@@ -123,9 +123,9 @@ -} tell :: forall msg r t. (BotC r, ToMessage msg, Tellable t) => t -> msg -> P.Sem r (Either RestError Message) tell target (runToMessage -> msg) = P.runError $ do- cid <- getChannel target- r <- invoke $ CreateMessage cid msg- P.fromEither r+ cid <- getChannel target+ r <- invoke $ CreateMessage cid msg+ P.fromEither r {- | Create a reply to an existing message in the same channel @@ -142,44 +142,44 @@ -} reply :: forall msg r t. (BotC r, ToMessage msg, HasID Channel t, HasID Message t) => t -> msg -> P.Sem r (Either RestError Message) reply target msg = P.runError $ do- let msg' = runToMessage (intoMsg msg <> intoMsg (MessageReference (Just $ getID @Message target) (Just $ getID @Channel target) Nothing False))- r <- invoke $ CreateMessage (getID @Channel target) msg'- P.fromEither r+ let msg' = runToMessage (intoMsg msg <> intoMsg (MessageReference (Just $ getID @Message target) (Just $ getID @Channel target) Nothing False))+ r <- invoke $ CreateMessage (getID @Channel target) msg'+ P.fromEither r instance Tellable DMChannel where- getChannel = pure . getID+ getChannel = pure . getID instance Tellable (Snowflake Channel) where- getChannel = pure+ getChannel = pure instance Tellable Channel where- getChannel = pure . getID+ getChannel = pure . getID instance Tellable (Snowflake DMChannel) where- getChannel = pure . coerceSnowflake+ getChannel = pure . coerceSnowflake instance Tellable TextChannel where- getChannel = pure . getID+ getChannel = pure . getID instance Tellable (Snowflake TextChannel) where- getChannel = pure . coerceSnowflake+ getChannel = pure . coerceSnowflake instance Tellable Message where- getChannel = pure . getID+ getChannel = pure . getID messageUser :: (BotC r, P.Member (P.Error RestError) r, HasID User a) => a -> P.Sem r (Snowflake Channel) messageUser (getID @User -> uid) = do- c <- invoke $ CreateDM uid- getID <$> P.fromEither c+ c <- invoke $ CreateDM uid+ getID <$> P.fromEither c instance Tellable (Snowflake Member) where- getChannel = messageUser . coerceSnowflake @_ @User+ getChannel = messageUser . coerceSnowflake @_ @User instance Tellable Member where- getChannel = messageUser+ getChannel = messageUser instance Tellable User where- getChannel = messageUser+ getChannel = messageUser instance Tellable (Snowflake User) where- getChannel = messageUser+ getChannel = messageUser
Calamity/Types/Token.hs view
@@ -4,7 +4,7 @@ , formatToken , rawToken ) where -import Data.Text.Lazy+import Data.Text import GHC.Generics
Calamity/Utils/Message.hs view
@@ -41,38 +41,38 @@ import Data.Generics.Product.Fields import Data.Maybe (fromMaybe) import Data.String (IsString, fromString)-import qualified Data.Text.Lazy as L-import TextShow (TextShow (showtl))+import qualified Data.Text as T+import TextShow (TextShow (showt)) zws :: IsString s => s zws = fromString "\x200b" -- | Replaces all occurences of @\`\`\`@ with @\`\<zws\>\`\<zws\>\`@-escapeCodeblocks :: L.Text -> L.Text-escapeCodeblocks = L.replace "```" (L.intercalate zws $ replicate 3 "`")+escapeCodeblocks :: T.Text -> T.Text+escapeCodeblocks = T.replace "```" (T.intercalate zws $ replicate 3 "`") -- | Replaces all occurences of @\`\`@ with @\`\<zws\>\`@-escapeCodelines :: L.Text -> L.Text-escapeCodelines = L.replace "``" (L.intercalate zws $ replicate 2 "`")+escapeCodelines :: T.Text -> T.Text+escapeCodelines = T.replace "``" (T.intercalate zws $ replicate 2 "`") -- | Replaces all occurences of @\*\*@ with @\*\<zws\>\*@-escapeBold :: L.Text -> L.Text-escapeBold = L.replace "**" (L.intercalate zws $ replicate 2 "*")+escapeBold :: T.Text -> T.Text+escapeBold = T.replace "**" (T.intercalate zws $ replicate 2 "*") -- | Replaces all occurences of @\~\~@ with @\~\<zws\>\~@-escapeStrike :: L.Text -> L.Text-escapeStrike = L.replace "~~" (L.intercalate zws $ replicate 2 "~")+escapeStrike :: T.Text -> T.Text+escapeStrike = T.replace "~~" (T.intercalate zws $ replicate 2 "~") -- | Replaces all occurences of @\_\_@ with @\_\<zws\>\_@-escapeUnderline :: L.Text -> L.Text-escapeUnderline = L.replace "__" (L.intercalate zws $ replicate 2 "_")+escapeUnderline :: T.Text -> T.Text+escapeUnderline = T.replace "__" (T.intercalate zws $ replicate 2 "_") -- | Replaces all occurences of @\|\|@ with @\|\<zws\>\|@-escapeSpoilers :: L.Text -> L.Text-escapeSpoilers = L.replace "||" (L.intercalate zws $ replicate 2 "|")+escapeSpoilers :: T.Text -> T.Text+escapeSpoilers = T.replace "||" (T.intercalate zws $ replicate 2 "|") -- | Escape all discord formatting-escapeFormatting :: L.Text -> L.Text+escapeFormatting :: T.Text -> T.Text escapeFormatting = foldl' (.) Prelude.id [escapeCodelines, escapeCodeblocks, escapeBold, escapeStrike, escapeUnderline, escapeSpoilers, escapeFormatting] {- | Formats a lang and content into a codeblock@@ -84,10 +84,10 @@ -} codeblock :: -- | language- L.Text ->+ T.Text -> -- | content- L.Text ->- L.Text+ T.Text ->+ T.Text codeblock lang = codeblock' (Just lang) {- | Formats an optional lang and content into a codeblock@@ -96,10 +96,10 @@ -} codeblock' :: -- | language- Maybe L.Text ->+ Maybe T.Text -> -- | content- L.Text ->- L.Text+ T.Text ->+ T.Text codeblock' lang content = "```" <> fromMaybe "" lang <> "\n" <> escapeCodeblocks content@@ -111,60 +111,60 @@ Any code lines in the content are escaped -}-codeline :: L.Text -> L.Text+codeline :: T.Text -> T.Text codeline content = "``" <> escapeCodelines content <> "``" {- | Formats some text into its bolded form Any existing bolded text is escaped -}-bold :: L.Text -> L.Text+bold :: T.Text -> T.Text bold content = "**" <> escapeBold content <> "**" {- | Formats some text into its striked form Any existing striked text is escaped -}-strike :: L.Text -> L.Text+strike :: T.Text -> T.Text strike content = "~~" <> escapeStrike content <> "~~" {- | Formats some text into its underlined form Any existing underlined text is escaped -}-underline :: L.Text -> L.Text+underline :: T.Text -> T.Text underline content = "__" <> escapeUnderline content <> "__" -- | Quotes a section of text-quote :: L.Text -> L.Text+quote :: T.Text -> T.Text quote = ("> " <>) -- | Quotes all remaining text-quoteAll :: L.Text -> L.Text+quoteAll :: T.Text -> T.Text quoteAll = (">> " <>) {- | Formats some text into its spoilered form Any existing spoilers are escaped -}-spoiler :: L.Text -> L.Text+spoiler :: T.Text -> T.Text spoiler content = "||" <> escapeSpoilers content <> "||" -fmtEmoji :: Emoji -> L.Text-fmtEmoji Emoji{id, name, animated} = "<" <> ifanim <> ":" <> name <> ":" <> showtl id <> ">"+fmtEmoji :: Emoji -> T.Text+fmtEmoji Emoji{id, name, animated} = "<" <> ifanim <> ":" <> name <> ":" <> showt id <> ">" where ifanim = if animated then "a" else "" -- | Format a 'User' or 'Member' into the format of @username#discriminator@-displayUser :: (HasField' "username" a L.Text, HasField' "discriminator" a L.Text) => a -> L.Text-displayUser u = (u ^. field' @"username") <> "#" <> (u ^. field' @"discriminator")+displayUser :: (HasField' "username" a T.Text, HasField' "discriminator" a T.Text) => a -> T.Text+displayUser u = u ^. field' @"username" <> "#" <> u ^. field' @"discriminator" -mentionSnowflake :: L.Text -> Snowflake a -> L.Text-mentionSnowflake tag s = "<" <> tag <> showtl s <> ">"+mentionSnowflake :: T.Text -> Snowflake a -> T.Text+mentionSnowflake tag s = "<" <> tag <> showt s <> ">" -- | Things that can be mentioned class Mentionable a where- mention :: a -> L.Text+ mention :: a -> T.Text instance Mentionable (Snowflake User) where mention = mentionSnowflake "@"
ChangeLog.md view
@@ -1,5 +1,13 @@ # Changelog for Calamity +## 0.2.0.0+++ Remove all usages of lazy Text (except from typeclass instances) ++ Fix a bug that caused http request decoding to never select the `()` instance+ for decoding the response (which meant endpoints that had empty responses+ would always fail to parse).++ Bumped the minimum version of aeson to 2.0+ ## 0.1.31.0 + We now pass through the `.member` field of message create/update events to the
README.md view
@@ -46,6 +46,7 @@ - [simmsb/calamity-bot](https://github.com/simmsb/calamity-bot): Uses a database, showing modularization of groups/commands. - [MorrowM/pandabot-discord](https://github.com/MorrowM/pandabot-discord): Uses a database, performs member role management, etc. - [MorrowM/calamity-tutorial](https://github.com/MorrowM/calamity-tutorial): A bare minimum bot.+- [koluacik/gundyr](https://github.com/koluacik/gundyr): An admin bot that does role assignment, etc. (Feel free to contact me via the discord server, or email me via ben@bensimms.moe if you've written a bot using calamity, or don't want your@@ -100,7 +101,7 @@ import Control.Lens import Control.Monad -import qualified Data.Text.Lazy as L+import qualified Data.Text as T import qualified Di import qualified DiPolysemy as DiP@@ -131,21 +132,21 @@ handleFailByLogging m = do r <- P.runFail m case r of- Left e -> DiP.error $ L.pack e+ Left e -> DiP.error $ T.pack e _ -> pure () -info, debug :: BotC r => L.Text -> P.Sem r ()+info, debug :: BotC r => T.Text -> P.Sem r () info = DiP.info debug = DiP.info -tellt :: (BotC r, Tellable t) => t -> L.Text -> P.Sem r (Either RestError Message)-tellt t m = tell t $ L.toStrict m+tellt :: (BotC r, Tellable t) => t -> T.Text -> P.Sem r (Either RestError Message)+tellt t m = tell t $ T.toStrict m -data MyCustomEvt = MyCustomEvt L.Text Message+data MyCustomEvt = MyCustomEvt T.Text Message main :: IO () main = do- token <- L.pack <$> getEnv "BOT_TOKEN"+ token <- T.pack <$> getEnv "BOT_TOKEN" Di.new $ \di -> void . P.runFinal . P.embedToFinal . DiP.runDiToIO di . runCounterAtomic . runCacheInMemory . runMetricsNoop . useConstantPrefix "!" . useFullContext@@ -153,24 +154,24 @@ addCommands $ do helpCommand command @'[User] "utest" $ \ctx u -> do- void $ tellt ctx $ "got user: " <> showtl u+ void $ tellt ctx $ "got user: " <> showt u command @'[Named "u" User, Named "u1" User] "utest2" $ \ctx u u1 -> do- void $ tellt ctx $ "got user: " <> showtl u <> "\nand: " <> showtl u1- command @'[L.Text, Snowflake User] "test" $ \ctx something aUser -> do- info $ "something = " <> showtl something <> ", aUser = " <> showtl aUser+ void $ tellt ctx $ "got user: " <> showt u <> "\nand: " <> showt u1+ command @'[T.Text, Snowflake User] "test" $ \ctx something aUser -> do+ info $ "something = " <> showt something <> ", aUser = " <> showt aUser command @'[] "hello" $ \ctx -> do void $ tellt ctx "heya" group "testgroup" $ do- command @'[[L.Text]] "test" $ \ctx l -> do- void $ tellt ctx ("you sent: " <> showtl l)+ command @'[[T.Text]] "test" $ \ctx l -> do+ void $ tellt ctx ("you sent: " <> showt l) command @'[] "count" $ \ctx -> do val <- getCounter- void $ tellt ctx ("The value is: " <> showtl val)+ void $ tellt ctx ("The value is: " <> showt val) group "say" $ do- command @'[KleenePlusConcat L.Text] "this" $ \ctx msg -> do+ command @'[KleenePlusConcat T.Text] "this" $ \ctx msg -> do void $ tellt ctx msg command @'[Snowflake Emoji] "etest" $ \ctx e -> do- void $ tellt ctx $ "got emoji: " <> showtl e+ void $ tellt ctx $ "got emoji: " <> showt e command @'[] "explode" $ \ctx -> do Just x <- pure Nothing debug "unreachable!"@@ -179,7 +180,7 @@ stopBot command @'[] "fire-evt" $ \ctx -> do fire . customEvt $ MyCustomEvt "aha" (ctx ^. #message)- command @'[L.Text] "wait-for" $ \ctx s -> do+ command @'[T.Text] "wait-for" $ \ctx s -> do void $ tellt ctx ("waiting for !" <> s) waitUntil @'MessageCreateEvt (\msg -> msg ^. #content == ("!" <> s)) void $ tellt ctx ("got !" <> s)@@ -194,9 +195,9 @@ info "edited" _ -> pure () react @('CustomEvt (CtxCommandError FullContext)) \(CtxCommandError ctx e) -> do- info $ "Command failed with reason: " <> showtl e+ info $ "Command failed with reason: " <> showt e case e of- ParseError n r -> void . tellt ctx $ "Failed to parse parameter: `" <> L.fromStrict n <> "`, with reason: ```\n" <> r <> "```"+ ParseError n r -> void . tellt ctx $ "Failed to parse parameter: `" <> T.fromStrict n <> "`, with reason: ```\n" <> r <> "```" react @('CustomEvt MyCustomEvt) $ \(MyCustomEvt s m) -> void $ tellt m ("Somebody told me to tell you about: " <> s) ```
calamity.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: calamity-version: 0.1.31.0+version: 0.2.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> category: Network, Web@@ -18,7 +18,7 @@ license-file: LICENSE build-type: Simple tested-with:- GHC == 8.10.4+ GHC == 8.10.7 extra-source-files: README.md ChangeLog.md@@ -182,12 +182,12 @@ QuasiQuotes ghc-options: -fplugin=Polysemy.Plugin -funbox-strict-fields -Wall -fno-warn-name-shadowing build-depends:- PyF >=0.9.0.2 && <0.10- , aeson >=1.4 && <2+ PyF ==0.10.*+ , aeson ==2.0.* , async >=2.2 && <3 , base >=4.13 && <5 , bytestring >=0.10 && <0.12- , calamity-commands >=0.1.3 && <0.2+ , calamity-commands ==0.2.* , colour >=2.3.5 && <2.4 , concurrent-extra ==0.7.* , connection >=0.2.6 && <0.4@@ -207,21 +207,21 @@ , http-client >=0.5 && <0.8 , http-date >=0.0.8 && <0.1 , http-types ==0.12.*- , lens >=4.18 && <6- , lens-aeson >=1.1 && <2+ , lens >=5.1 && <6+ , lens-aeson >=1.1.2 && <2 , 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.1 && <3.10+ , req >=3.9.2 && <3.10 , 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+ , text >=1.2 && <2.1 , text-show >=3.8 && <4 , time >=1.8 && <1.13 , tls >=1.4 && <2