calamity 0.1.28.5 → 0.1.29.0

raw patch · 7 files changed

+109/−60 lines, 7 filesdep ~basedep ~df1dep ~lensPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, df1, lens, polysemy, polysemy-plugin

API changes (from Hackage documentation)

Files

• Calamity/Client/Client.hs +2/−1
• Calamity/Client/Types.hs +29/−29
• Calamity/HTTP/Internal/Request.hs +1/−1
• Calamity/Utils/Permissions.hs +8/−5
• ChangeLog.md +8/−0
• README.md +54/−17
• calamity.cabal +7/−7

@@ -486,7 +486,8 @@ handleEvent' eh evt@(GuildMembersChunk GuildMembersChunkData { members, guildID }) = do   updateCache evt   Just guild <- getGuild guildID-  let members' = guild ^.. #members . foldMap (at . getID) members . _Just+  let memberIDs = map (getID @Member) members+  let members' = catMaybes $ map (\mid -> guild ^. #members . at mid) memberIDs   pure $ map ($ (guild, members')) (getEventHandlers @'GuildMembersChunkEvt eh)  handleEvent' eh evt@(GuildRoleCreate GuildRoleData { guildID, role }) = do

@@ -256,35 +256,35 @@   def =     EventHandlers $       fromList-        [ WrapTypeable $ EH @ 'ReadyEvt []-        , WrapTypeable $ EH @ 'ChannelCreateEvt []-        , WrapTypeable $ EH @ 'ChannelUpdateEvt []-        , WrapTypeable $ EH @ 'ChannelDeleteEvt []-        , WrapTypeable $ EH @ 'ChannelpinsUpdateEvt []-        , WrapTypeable $ EH @ 'GuildCreateEvt []-        , WrapTypeable $ EH @ 'GuildUpdateEvt []-        , WrapTypeable $ EH @ 'GuildDeleteEvt []-        , WrapTypeable $ EH @ 'GuildBanAddEvt []-        , WrapTypeable $ EH @ 'GuildBanRemoveEvt []-        , WrapTypeable $ EH @ 'GuildEmojisUpdateEvt []-        , WrapTypeable $ EH @ 'GuildIntegrationsUpdateEvt []-        , WrapTypeable $ EH @ 'GuildMemberAddEvt []-        , WrapTypeable $ EH @ 'GuildMemberRemoveEvt []-        , WrapTypeable $ EH @ 'GuildMemberUpdateEvt []-        , WrapTypeable $ EH @ 'GuildMembersChunkEvt []-        , WrapTypeable $ EH @ 'GuildRoleCreateEvt []-        , WrapTypeable $ EH @ 'GuildRoleUpdateEvt []-        , WrapTypeable $ EH @ 'GuildRoleDeleteEvt []-        , WrapTypeable $ EH @ 'MessageCreateEvt []-        , WrapTypeable $ EH @ 'MessageUpdateEvt []-        , WrapTypeable $ EH @ 'MessageDeleteEvt []-        , WrapTypeable $ EH @ 'MessageDeleteBulkEvt []-        , WrapTypeable $ EH @ 'MessageReactionAddEvt []-        , WrapTypeable $ EH @ 'MessageReactionRemoveEvt []-        , WrapTypeable $ EH @ 'MessageReactionRemoveAllEvt []-        , WrapTypeable $ EH @ 'TypingStartEvt []-        , WrapTypeable $ EH @ 'UserUpdateEvt []-        , WrapTypeable $ EH @( 'CustomEvt Void Dynamic) LH.empty+        [ WrapTypeable $ EH @'ReadyEvt []+        , WrapTypeable $ EH @'ChannelCreateEvt []+        , WrapTypeable $ EH @'ChannelUpdateEvt []+        , WrapTypeable $ EH @'ChannelDeleteEvt []+        , WrapTypeable $ EH @'ChannelpinsUpdateEvt []+        , WrapTypeable $ EH @'GuildCreateEvt []+        , WrapTypeable $ EH @'GuildUpdateEvt []+        , WrapTypeable $ EH @'GuildDeleteEvt []+        , WrapTypeable $ EH @'GuildBanAddEvt []+        , WrapTypeable $ EH @'GuildBanRemoveEvt []+        , WrapTypeable $ EH @'GuildEmojisUpdateEvt []+        , WrapTypeable $ EH @'GuildIntegrationsUpdateEvt []+        , WrapTypeable $ EH @'GuildMemberAddEvt []+        , WrapTypeable $ EH @'GuildMemberRemoveEvt []+        , WrapTypeable $ EH @'GuildMemberUpdateEvt []+        , WrapTypeable $ EH @'GuildMembersChunkEvt []+        , WrapTypeable $ EH @'GuildRoleCreateEvt []+        , WrapTypeable $ EH @'GuildRoleUpdateEvt []+        , WrapTypeable $ EH @'GuildRoleDeleteEvt []+        , WrapTypeable $ EH @'MessageCreateEvt []+        , WrapTypeable $ EH @'MessageUpdateEvt []+        , WrapTypeable $ EH @'MessageDeleteEvt []+        , WrapTypeable $ EH @'MessageDeleteBulkEvt []+        , WrapTypeable $ EH @'MessageReactionAddEvt []+        , WrapTypeable $ EH @'MessageReactionRemoveEvt []+        , WrapTypeable $ EH @'MessageReactionRemoveAllEvt []+        , WrapTypeable $ EH @'TypingStartEvt []+        , WrapTypeable $ EH @'UserUpdateEvt []+        , WrapTypeable $ EH @('CustomEvt Void Dynamic) LH.empty         ]  instance Semigroup EventHandlers where

@@ -88,7 +88,7 @@   let r = action a (route' ^. #path) (requestOptions token')       act = runReq reqConfig r -  resp <- attr "route" (renderUrl $ route' ^. #path) $ doRequest rlState' route' act+  resp <- push "calamity" . attr "route" (renderUrl $ route' ^. #path) $ doRequest rlState' route' act    void $ modifyGauge (subtract 1) inFlightRequests 

@@ -17,8 +17,10 @@  import           Control.Lens +import           Data.Maybe (catMaybes) import           Data.Flags import qualified Data.Vector.Unboxing                   as V+import           Data.Generics.Product.Fields  import qualified Polysemy                               as P import Data.Foldable (Foldable(foldl'))@@ -29,7 +31,8 @@   | (g ^. #ownerID == getID m) = allFlags   | otherwise = let everyoneRole  = g ^. #roles . at (coerceSnowflake $ getID @Guild g)                     permsEveryone = maybe noFlags (^. #permissions) everyoneRole-                    rolePerms     = g ^.. #roles . foldMap ix (V.toList $ m ^. #roles) . #permissions+                    roleIDs       = V.toList $ m ^. #roles+                    rolePerms     = catMaybes $ map (\rid -> g ^? #roles . ix rid . #permissions) roleIDs                     perms         = foldl' andFlags noFlags (permsEveryone:rolePerms)                 in if perms .<=. administrator                    then allFlags@@ -40,16 +43,16 @@ applyOverwrites c m p   | p .<=. administrator = allFlags   | otherwise =-    let everyoneOverwrite = c ^. #permissionOverwrites . at (coerceSnowflake $ getID @Guild c)+    let everyoneOverwrite = c ^. field' @"permissionOverwrites" . at (coerceSnowflake $ getID @Guild c)         everyoneAllow     = maybe noFlags (^. #allow) everyoneOverwrite         everyoneDeny      = maybe noFlags (^. #deny) everyoneOverwrite         p'                = p .-. everyoneDeny .+. everyoneAllow-        roleOverwrites    = c ^.. #permissionOverwrites . foldMap ix-          (map (coerceSnowflake @_ @Overwrite) . V.toList $ m ^. #roles)+        roleOverwriteIDs  = map (coerceSnowflake @_ @Overwrite) . V.toList $ m ^. #roles+        roleOverwrites    = catMaybes $ map (\oid -> c ^? field' @"permissionOverwrites" . ix oid) roleOverwriteIDs         roleAllow         = foldl' andFlags noFlags (roleOverwrites ^.. traverse . #allow)         roleDeny          = foldl' andFlags noFlags (roleOverwrites ^.. traverse . #deny)         p''               = p' .-. roleDeny .+. roleAllow-        memberOverwrite   = c ^. #permissionOverwrites . at (coerceSnowflake @_ @Overwrite $ getID @Member m)+        memberOverwrite   = c ^. field' @"permissionOverwrites" . at (coerceSnowflake @_ @Overwrite $ getID @Member m)         memberAllow       = maybe noFlags (^. #allow) memberOverwrite         memberDeny        = maybe noFlags (^. #deny) memberOverwrite         p'''              = p'' .-. memberDeny .+. memberAllow

@@ -1,5 +1,13 @@ # Changelog for Calamity +## 0.1.29.0+++ The minimum version of `base` has been upped to `4.13` as the library fails to+  build on ghc-8.6++ The minimum version of `polysemy` has been upped to 1.5++ The upper bound of `lens` has been bumped to 6++ The library now compiles with ghc-9+ ## 0.1.28.5  + Use the correct HTTP method for `ModifyChannel`

@@ -35,13 +35,42 @@  You can find documentation on hackage at: https://hackage.haskell.org/package/calamity +There's also a good blog post that covers the fundamentals of writing a bot with+the library, you can read it here:+https://morrowm.github.io/posts/2021-04-29-calamity.html+ # Examples -Some example projects can be found at:+Here's a list of projects that use calamity: <!-- - [simmsb/calamity-example](https://github.com/simmsb/calamity-example): An extended example of the snippet below, shows use of metrics. -->-- [simmsb/calamity-bot](https://github.com/simmsb/calamity-bot): Uses a database, showing modularisation of groups/commands.+- [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. +(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+project listed here)+ ``` haskell+#!/usr/bin/env cabal+{- cabal:+  build-depends:+     base >= 4.13 && < 5+     , calamity >= 0.1.28+     , text >= 1.2 && < 2+     , lens >= 4.18 && < 5+     , di-polysemy ^>= 0.2+     , di >= 1.3 && < 2+     , df1 >= 0.3 && < 0.5+     , di-core ^>= 1.0.4+     , polysemy ^>= 1.5+     , polysemy-plugin ^>= 0.3+     , stm ^>= 2.5+     , text-show ^>= 3.9+-}++{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}+ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}@@ -61,7 +90,7 @@ import           Calamity import           Calamity.Cache.InMemory import           Calamity.Commands-import qualified Calamity.Commands.Context                  as CommandContext+import qualified Calamity.Commands.Context   as CommandContext import           Calamity.Metrics.Noop  import           Control.Concurrent@@ -69,8 +98,7 @@ import           Control.Lens import           Control.Monad -import           Data.Text.Lazy              ( Text, fromStrict )-import           Data.Text.Strict.Lens+import qualified Data.Text.Lazy as L  import qualified Di import qualified DiPolysemy                  as DiP@@ -83,6 +111,8 @@  import           Prelude                     hiding ( error ) +import           System.Environment          (getEnv)+ import           TextShow  data Counter m a where@@ -99,19 +129,19 @@ handleFailByLogging m = do   r <- P.runFail m   case r of-    Left e -> DiP.error (e ^. packed)+    Left e -> DiP.error $ L.pack e     _      -> pure () -info, debug :: BotC r => Text -> P.Sem r ()+info, debug :: BotC r => L.Text -> P.Sem r () info = DiP.info debug = DiP.info -tellt :: (BotC r, Tellable t) => t -> Text -> P.Sem r (Either RestError Message)+tellt :: (BotC r, Tellable t) => t -> L.Text -> P.Sem r (Either RestError Message) tellt t m = tell t $ L.toStrict m  main :: IO () main = do-  token <- view packed <$> getEnv "BOT_TOKEN"+  token <- L.pack <$> getEnv "BOT_TOKEN"   Di.new $ \di ->     void . P.runFinal . P.embedToFinal . DiP.runDiToIO di . runCounterAtomic . runCacheInMemory . runMetricsNoop . useConstantPrefix "!"       $ runBotIO (BotToken token) defaultIntents $ do@@ -122,7 +152,7 @@         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 = " <> showt something <> ", aUser = " <> showt aUser+          info $ "something = " <> showtl something <> ", aUser = " <> showtl aUser         command @'[] "hello" $ \ctx -> do           void $ tellt ctx "heya"         group "testgroup" $ do@@ -155,11 +185,11 @@           info "sleeping"           P.embed $ threadDelay (5 * 1000 * 1000)           info "slept"-          void . invoke $ EditMessage (msg ^. #channelID) msg' (Just "lol") Nothing+          void . invoke $ EditMessage (msg ^. #channelID) msg' (editMessageContent $ Just "lol")           info "edited"         _ -> pure ()       react @('CustomEvt "command-error" (CommandContext.Context, CommandError)) $ \(ctx, e) -> do-        info $ "Command failed with reason: " <> showt e+        info $ "Command failed with reason: " <> showtl e         case e of           ParseError n r -> void . tellt ctx $ "Failed to parse parameter: `" <> L.fromStrict n <> "`, with reason: ```\n" <> r <> "```"       react @('CustomEvt "my-event" (L.Text, Message)) $ \(s, m) ->@@ -172,13 +202,20 @@ can do something along the lines of:  ``` haskell+import qualified Di+import qualified Df1+import qualified Di.Core+import qualified DiPolysemy++filterDi :: Di.Core.Di l Di.Path m -> Di.Core.Di l Di.Path m+filterDi = Di.Core.filter (\_ p _ -> Df1.Push "calamity" `notElem` p)+ Di.new $ \di -> -- ...   . runDiToIO di-  -- disable logs emitted inside calamity-  . DiPolysemy.local (Di.Core.filter (\_ _ _ -> False))-  . runBotIO -- ...-  -- re-enable logs emitted inside your bot's code-  . DiPolysemy.local (const di)+  -- disable logs emitted by calamity+  . DiPolysemy.local filterDi+  . runBotIO+  -- ... ``` 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: e75edd6f528871c8867bbd8aa43ae458a8b7c3f45bb7b7b64456611f988244a3+-- hash: 89740b43cb19ef8c4833319daf4096283256327512903f70f9f82463297c7d07  name:           calamity-version:        0.1.28.5+version:        0.1.29.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@@ -138,7 +138,7 @@   build-depends:       aeson >=1.4 && <2     , async >=2.2 && <3-    , base >=4.12 && <5+    , base >=4.13 && <5     , bytestring >=0.10 && <0.12     , colour >=2.3.5 && <2.4     , concurrent-extra >=0.7 && <0.8@@ -148,7 +148,7 @@     , data-flags >=0.0.3 && <0.1     , deepseq >=1.4.4.0 && <2     , deque >=0.4 && <0.5-    , df1 >=0.3 && <0.5+    , df1 >=0.4 && <0.5     , di-core >=1.0.4 && <1.1     , di-polysemy >=0.2 && <0.3     , exceptions >=0.10 && <0.11@@ -160,13 +160,13 @@     , http-client >=0.5 && <0.8     , http-date >=0.0.8 && <0.1     , http-types >=0.12 && <0.13-    , lens >=4.18 && <5+    , lens >=4.18 && <6     , lens-aeson >=1.1 && <2     , megaparsec >=8 && <10     , mime-types >=0.1 && <0.2     , mtl >=2.2 && <3-    , polysemy >=1.3 && <2-    , polysemy-plugin >=0.2 && <0.4+    , polysemy >=1.5 && <2+    , polysemy-plugin >=0.3 && <0.4     , reflection >=2.1 && <3     , req >=3.1 && <3.10     , safe-exceptions >=0.1 && <2