calamity 0.1.11.0 → 0.1.11.1

raw patch · 5 files changed

+114/−35 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• calamity.cabal +2/−2
• src/Calamity/Cache/InMemory.hs +56/−16
• src/Calamity/Internal/BoundedStore.hs +6/−2
• src/Calamity/Types/Upgradeable.hs +6/−0
• src/Calamity/Utils/Permissions.hs +44/−15

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 67eb6b9ab5e005763f101fcd1bccf75b1e92dbe2f71a376929854d730fb0ee9a+-- hash: 12a035b3d93c607f12c355b451e20803b1c5e62716eddb253a236cf2467effe3  name:           calamity-version:        0.1.11.0+version:        0.1.11.1 synopsis:       A library for writing discord bots description:    Please see the README on GitHub at <https://github.com/nitros12/calamity#readme> category:       Network, Web

@@ -1,9 +1,11 @@ -- | A 'Cache' handler that operates in memory module Calamity.Cache.InMemory-    ( runCacheInMemory ) where+    ( runCacheInMemory+    , runCacheInMemory'+    , runCacheInMemoryNoMsg ) where  import           Calamity.Cache.Eff-import           Calamity.Internal.BoundedStore+import qualified Calamity.Internal.BoundedStore as BS import qualified Calamity.Internal.SnowflakeMap as SM import           Calamity.Internal.Utils import           Calamity.Types.Model.Channel@@ -14,10 +16,8 @@ import           Control.Lens import           Control.Monad.State.Strict -import qualified Data.HashMap.Lazy as LH--import           Data.Default.Class import           Data.Foldable+import qualified Data.HashMap.Lazy              as LH import qualified Data.HashSet                   as LS import           Data.IORef @@ -26,30 +26,70 @@ import qualified Polysemy                       as P import qualified Polysemy.AtomicState           as P -data Cache = Cache+data Cache f = Cache   { user              :: Maybe User   , guilds            :: SM.SnowflakeMap Guild   , dms               :: SM.SnowflakeMap DMChannel   , guildChannels     :: LH.HashMap (Snowflake GuildChannel) Guild   , users             :: SM.SnowflakeMap User   , unavailableGuilds :: LS.HashSet (Snowflake Guild)-  , messages          :: BoundedStore Message+  , messages          :: f (BS.BoundedStore Message)   }-  deriving ( Generic, Show )+  deriving ( Generic ) -emptyCache :: Cache-emptyCache = Cache Nothing SM.empty SM.empty LH.empty SM.empty LS.empty def+type CacheWithMsg = Cache Identity+type CacheNoMsg = Cache (Const ()) +emptyCache :: CacheWithMsg+emptyCache = Cache Nothing SM.empty SM.empty LH.empty SM.empty LS.empty (Identity $ BS.empty 1000)++emptyCacheNoMsg :: CacheNoMsg+emptyCacheNoMsg = Cache Nothing SM.empty SM.empty LH.empty SM.empty LS.empty (Const ())++emptyCache' :: Int -> CacheWithMsg+emptyCache' msgLimit = Cache Nothing SM.empty SM.empty LH.empty SM.empty LS.empty (Identity $ BS.empty msgLimit)++-- | Run the cache in memory with a default message cache size of 1000 runCacheInMemory :: P.Member (P.Embed IO) r => P.Sem (CacheEff ': r) a -> P.Sem r a runCacheInMemory m = do   var <- P.embed $ newIORef emptyCache   P.runAtomicStateIORef var $ P.reinterpret runCache' m -runCache' :: P.Member (P.AtomicState Cache) r => CacheEff m a -> P.Sem r a+-- | Run the cache in memory with no messages being cached+runCacheInMemoryNoMsg :: P.Member (P.Embed IO) r => P.Sem (CacheEff ': r) a -> P.Sem r a+runCacheInMemoryNoMsg m = do+  var <- P.embed $ newIORef emptyCacheNoMsg+  P.runAtomicStateIORef var $ P.reinterpret runCache' m++-- | Run the cache in memory with a configurable message cache limit+runCacheInMemory' :: P.Member (P.Embed IO) r => Int -> P.Sem (CacheEff ': r) a -> P.Sem r a+runCacheInMemory' msgLimit m = do+  var <- P.embed $ newIORef (emptyCache' msgLimit)+  P.runAtomicStateIORef var $ P.reinterpret runCache' m++runCache' :: (MessageMod (Cache t), P.Member (P.AtomicState (Cache t)) r) => CacheEff m a -> P.Sem r a runCache' act = P.atomicState' ((swap .) . runState $ runCache act) -runCache :: CacheEff m a -> State Cache a+class MessageMod t where+  setMessage' :: Message -> State t ()+  getMessage' :: Snowflake Message -> State t (Maybe Message)+  getMessages' :: State t [Message]+  delMessage' :: Snowflake Message -> State t () +instance MessageMod CacheWithMsg where+  setMessage' m = #messages . _Wrapped %= BS.addItem m+  getMessage' mid = use (#messages . _Wrapped . at mid)+  getMessages' = toList <$> use (#messages . _Wrapped)+  delMessage' mid = #messages . _Wrapped %= sans mid++instance MessageMod CacheNoMsg where+  setMessage' _ = pure ()+  getMessage' _ = pure Nothing+  getMessages' = pure []+  delMessage' _ = pure ()++runCache :: MessageMod (Cache t) => CacheEff m a -> State (Cache t) a+ runCache (SetBotUser u) = #user ?= u runCache GetBotUser     = use #user @@ -79,7 +119,7 @@ runCache GetUnavailableGuilds      = LS.toList <$> use #unavailableGuilds runCache (DelUnavailableGuild gid) = #unavailableGuilds %= sans gid -runCache (SetMessage m)   = #messages %= addItem m-runCache (GetMessage mid) = use (#messages . at mid)-runCache GetMessages      = toList <$> use #messages-runCache (DelMessage mid) = #messages %= sans mid+runCache (SetMessage m)   = setMessage' m+runCache (GetMessage mid) = getMessage' mid+runCache GetMessages      = getMessages'+runCache (DelMessage mid) = delMessage' mid

@@ -1,6 +1,7 @@ -- | A thing for storing the last N things with IDs module Calamity.Internal.BoundedStore-    ( BoundedStore(..)+    ( BoundedStore+    , empty     , addItem     , getItem     , dropItem ) where@@ -33,7 +34,10 @@   foldr f i = foldr f i . H.elems . items  instance Default (BoundedStore a) where-  def = BoundedStore mempty H.empty 1000 0+  def = BoundedStore mempty mempty 1000 0++empty :: Int -> BoundedStore a+empty limit = BoundedStore mempty mempty limit 0  type instance (Index (BoundedStore a)) = Snowflake a 

@@ -20,7 +20,13 @@ import qualified Polysemy.Fail                  as P import qualified Polysemy.NonDet                as P +-- | A typeclass that represents snowflakes that can be upgraded to their+-- complete data, either through the cache or HTTP. class Upgradeable a ids | a -> ids, ids -> a where+  -- | Upgrade a snowflake to it's complete data.+  --+  -- If it existed in the cache then it is returned from there, otherwise we+  -- fetch from HTTP and update the cache on success.   upgrade :: BotC r => ids -> P.Sem r (Maybe a)  maybeToAlt :: Alternative f => Maybe a -> f a

@@ -1,9 +1,9 @@ -- | Permission utilities module Calamity.Utils.Permissions-    ( PermissionsIn(..)-    , PermissionsIn'(..)-    , basePermissions-    , applyOverwrites ) where+    ( basePermissions+    , applyOverwrites+    , PermissionsIn(..)+    , PermissionsIn'(..) ) where  import           Calamity.Client.Types import           Calamity.Types.Model.Channel.Guild@@ -11,6 +11,7 @@ import           Calamity.Types.Model.Guild.Member import           Calamity.Types.Model.Guild.Overwrite import           Calamity.Types.Model.Guild.Permissions+import           Calamity.Types.Model.User import           Calamity.Types.Snowflake import           Calamity.Types.Upgradeable @@ -21,6 +22,7 @@  import qualified Polysemy                               as P +-- | Calculate a 'Member''s 'Permissions' in a 'Guild' basePermissions :: Guild -> Member -> Permissions basePermissions g m   | (g ^. #ownerID == getID m) = allFlags@@ -32,6 +34,7 @@                    then allFlags                    else perms +-- | Apply any 'Overwrite's for a 'GuildChannel' onto some 'Permissions' applyOverwrites :: GuildChannel -> Member -> Permissions -> Permissions applyOverwrites c m p   | p .<=. administrator = allFlags@@ -51,38 +54,64 @@         p'''              = p'' .-. memberDeny .+. memberAllow     in p''' +-- | Things that 'Member's have 'Permissions' in class PermissionsIn a where+  -- | Calculate a 'Member''s 'Permissions' in something   permissionsIn :: a -> Member -> Permissions +-- | A 'Member''s 'Permissions' in a channel are their roles and overwrites instance PermissionsIn (Guild, GuildChannel) where   permissionsIn (g, c) m = applyOverwrites c m $ basePermissions g m +-- | A 'Member''s 'Permissions' in a guild are just their roles instance PermissionsIn Guild where   permissionsIn g m = basePermissions g m +-- | A variant of 'PermissionsIn' that will use the cache/http. class PermissionsIn' a where-  permissionsIn' :: BotC r => a -> Member -> P.Sem r Permissions+  -- | Calculate the permissions of something that has a 'User' id+  --+  -- If permissions could not be calculated because something couldn't be found+  -- in the cache, this will return an empty set of permissions. Use+  -- 'permissionsIn' if you want to handle cases where something might not exist+  -- in cache.+  permissionsIn' :: (BotC r, HasID User u) => a -> u -> P.Sem r Permissions +-- | A 'User''s 'Permissions' in a channel are their roles and overwrites+--+-- This will fetch the guild from the cache or http as needed instance PermissionsIn' GuildChannel where-  permissionsIn' c m = do+  permissionsIn' c (getID @User -> uid) = do+    m <- upgrade (getID @Guild c, coerceSnowflake @_ @Member uid)     g <- upgrade (getID @Guild c)-    case g of-      Just g' -> pure $ permissionsIn (g', c) m-      Nothing -> pure noFlags+    case (m, g) of+      (Just m, Just g') -> pure $ permissionsIn (g', c) m+      _                 -> pure noFlags +-- | A 'Member''s 'Permissions' in a guild are just their roles instance PermissionsIn' Guild where-  permissionsIn' g m = pure $ permissionsIn g m+  permissionsIn' g (getID @User -> uid) = do+    m <- upgrade (getID @Guild g, coerceSnowflake @_ @Member uid)+    case m of+      Just m' -> pure $ permissionsIn g m'+      Nothing -> pure noFlags +-- | A 'Member''s 'Permissions' in a channel are their roles and overwrites+--+-- This will fetch the guild and channel from the cache or http as needed instance PermissionsIn' (Snowflake GuildChannel) where-  permissionsIn' cid m = do+  permissionsIn' cid u = do     c <- upgrade cid     case c of-      Just c' -> permissionsIn' c' m-      Nothing -> pure noFlags+      Just c' -> permissionsIn' c' u+      _       -> pure noFlags +-- | A 'Member''s 'Permissions' in a guild are just their roles+--+-- This will fetch the guild from the cache or http as needed instance PermissionsIn' (Snowflake Guild) where-  permissionsIn' gid m = do+  permissionsIn' gid u = do     g <- upgrade gid     case g of-      Just g' -> permissionsIn' g' m+      Just g' -> permissionsIn' g' u       Nothing -> pure noFlags