diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog for Calamity +## 0.1.21.0 + +- Fix ToJSON instance for `RawEmoji` + ## 0.1.20.1 * Documentation improvements. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,15 +1,11 @@

Calamity

- - - - -

Hackage Gitlab pipeline status License Hackage-Deps + Discord Invite

Calamity is a Haskell library for writing discord bots, it uses @@ -28,6 +24,9 @@ example of using prometheus as the metrics handler can be found [here](https://github.com/nitros12/calamity-example). +* Logging: The [di-polysemy](https://hackage.haskell.org/package/di-polysemy) + library is used to allow the logging effect to be customized, or disabled. + # Docs You can find documentation on hackage at: https://hackage.haskell.org/package/calamity @@ -35,7 +34,7 @@ # Examples Some example projects can be found at: -- [nitros12/calamity-example](https://github.com/nitros12/calamity-example): An extended example of the snippet below, shows use of metrics. + - [nitros12/calamity-bot](https://github.com/nitros12/calamity-bot): Uses a database, showing modularisation of groups/commands. ``` haskell diff --git a/calamity.cabal b/calamity.cabal --- a/calamity.cabal +++ b/calamity.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 55bf5727de4e0d34fab772f8f03176d91db899e03912214153fdfd0bf161eedc +-- hash: 5fa37b5c8ac352c7170a1e67f6f1c722b1e1e041e5f49cd19058014ae1b1caf4 name: calamity -version: 0.1.20.1 +version: 0.1.21.0 synopsis: A library for writing discord bots in haskell description: Please see the README on GitHub at category: Network, Web diff --git a/src/Calamity/Commands/CommandUtils.hs b/src/Calamity/Commands/CommandUtils.hs --- a/src/Calamity/Commands/CommandUtils.hs +++ b/src/Calamity/Commands/CommandUtils.hs @@ -84,8 +84,8 @@ -- 'buildCommand' @\'['Named' "user" ('Snowflake' 'User'), 'Named' "reason" ('KleeneStarConcat' 'S.Text')] -- "ban" 'Nothing' [] ('const' "Ban a user") $ \ctx uid r -> case (ctx 'Control.Lens.^.' #guild) of -- 'Just' guild -> do --- 'void' . 'Calamity.HTTP.invoke' . 'Calamity.HTTP.reason' r $ 'Calamity.HTTP.Guild.CreateGuildBan' guild uid --- 'void' $ 'Calamity.Types.Tellable.tell' ctx ("Banned user `" '<>' 'TextShow.showt' uid '<>' "` with reason: " '<>' r) +-- '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." -- @ buildCommand :: forall ps r. diff --git a/src/Calamity/Commands/Dsl.hs b/src/Calamity/Commands/Dsl.hs --- a/src/Calamity/Commands/Dsl.hs +++ b/src/Calamity/Commands/Dsl.hs @@ -169,7 +169,7 @@ -- 'Calamity.Commands.Parser.Named' "reason" ('Calamity.Commands.Parser.KleeneStarConcat' 'S.Text')] -- "ban" $ \\ctx uid r -> case (ctx 'Control.Lens.^.' #guild) of -- 'Just' guild -> do --- 'Control.Monad.void' . 'Calamity.HTTP.invoke' . 'Calamity.HTTP.reason' r $ 'Calamity.HTTP.Guild.CreateGuildBan' guild uid +-- '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." -- @ @@ -198,7 +198,7 @@ -- 'Calamity.Commands.Parser.Named' "reason" ('Calamity.Commands.Parser.KleeneStarConcat' 'S.Text')] -- "ban" [] $ \\ctx uid r -> case (ctx 'Control.Lens.^.' #guild) of -- 'Just' guild -> do --- 'Control.Monad.void' . 'Calamity.HTTP.invoke' . 'Calamity.HTTP.reason' r $ 'Calamity.HTTP.Guild.CreateGuildBan' guild uid +-- '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." -- @ diff --git a/src/Calamity/Types/Model/Guild/Emoji.hs b/src/Calamity/Types/Model/Guild/Emoji.hs --- a/src/Calamity/Types/Model/Guild/Emoji.hs +++ b/src/Calamity/Types/Model/Guild/Emoji.hs @@ -75,8 +75,8 @@ showb (CustomEmoji p) = showb p instance ToJSON RawEmoji where - toJSON (CustomEmoji e) = object ["emoji" .= e] - toJSON (UnicodeEmoji s) = object ["emoji" .= object ["name" .= s]] + toJSON (CustomEmoji e) = toJSON e + toJSON (UnicodeEmoji s) = object ["name" .= s, "id" .= Nothing @()] instance FromJSON RawEmoji where parseJSON = withObject "RawEmoji" $ \v -> do diff --git a/src/Calamity/Types/Snowflake.hs b/src/Calamity/Types/Snowflake.hs --- a/src/Calamity/Types/Snowflake.hs +++ b/src/Calamity/Types/Snowflake.hs @@ -19,6 +19,7 @@ import Data.Text.Read import qualified Data.Vector.Unboxing as U import Data.Word +import Data.Bits import GHC.Generics @@ -31,7 +32,18 @@ } deriving ( Generic, Eq, Ord, Data ) deriving ( Show, TextShow ) via Word64 - deriving newtype ( NFData, ToJSONKey, Hashable, U.Unboxable ) + deriving newtype ( NFData, ToJSONKey, U.Unboxable ) + +-- I'm pretty sure that Word64's hash just being 'fromIntegral' is a bad idea when +-- attempting to use it in a hashmap, so swizzle the bits a bit to give a good +-- distribution of bits +instance Hashable (Snowflake t) where + hashWithSalt salt (Snowflake a) = + let initial = fromIntegral @_ @Word64 $ hashWithSalt salt a + round1 = ((initial `shiftR` 30) `xor` initial) * 0xbf58476d1ce4e5b9 + round2 = ((round1 `shiftR` 27) `xor` round1) * 0xbf58476d1ce4e5b9 + round3 = ((round2 `shiftR` 31) `xor` round2) + in fromIntegral @_ @Int round3 instance ToJSON (Snowflake t) where toJSON (Snowflake s) = String . showt $ s