calamity 0.1.17.1 → 0.1.18.0

raw patch · 19 files changed

+181/−122 lines, 19 filesdep +unboxing-vectorPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: unboxing-vector

API changes (from Hackage documentation)

Files

• ChangeLog.md +26/−4
• cabal.project +1/−1
• calamity.cabal +5/−4
• src/Calamity/Client/Client.hs +42/−16
• src/Calamity/Client/Types.hs +39/−0
• src/Calamity/Commands/Parser.hs +3/−2
• src/Calamity/Gateway/DispatchEvents.hs +1/−1
• src/Calamity/HTTP/Channel.hs +9/−4
• src/Calamity/HTTP/Emoji.hs +0/−1
• src/Calamity/Internal/AesonThings.hs +1/−0
• src/Calamity/Internal/Utils.hs +12/−4
• src/Calamity/Types/Model/Channel/DM.hs +1/−1
• src/Calamity/Types/Model/Channel/Group.hs +1/−1
• src/Calamity/Types/Model/Channel/Message.hs +1/−1
• src/Calamity/Types/Model/Channel/UpdatedMessage.hs +1/−1
• src/Calamity/Types/Model/Guild/Emoji.hs +34/−8
• src/Calamity/Types/Model/Guild/Member.hs +1/−1
• src/Calamity/Types/Snowflake.hs +2/−71
• src/Calamity/Utils/Permissions.hs +1/−1

@@ -1,5 +1,27 @@ # Changelog for Calamity +## 0.1.18.0++* Add raw message events: `RawMessageUpdateEvt`, `RawMessageDeleteEvt`,+  `RawMessageDeleteBulkEvt`, `RawMessageReactionAddEvt`,+  `RawMessageReactionRemoveEvt`, `RawMessageReactionRemoveAllEvt`.+  +* Fixed bulk message deletes firing a message delete per deleted message,+  instead of a bulk message delete event (I'm not sure how I did that).+  +* Add `animated` field to `Partial Emoji`s.++* Make show instances for `Partial Emoji` and `RawEmoji` show to their discord+  representation.+  +## 0.1.17.2++*2020-07-04*++* Drop GHC-8.6.5, it doesn't like strictdata++* Use unboxing-vector instead of doing stuff ourselves+ ## 0.1.17.1  *2020-06-29*@@ -22,7 +44,7 @@ * Change how commands should be manually invoked from code, instead of firing a   `"invoke-command"` custom event, now the `handleCommands` function should be   used, which returns information about if the command succeeded.-  + * Added `fetchHandler` for retrieving the command handler inside a command DSL.  ## 0.1.15.0@@ -62,7 +84,7 @@  * The `DecodeError` variant of the `RestError` type has been renamed to   `InternalClientError` as all issues in the rest client now end up here.-  + * We're now using `discord.com` instead of `discordapp.com`  ## 0.1.14.4@@ -152,7 +174,7 @@ * Renamed `Calamity.Commands.Parser.KleeneConcat` to   `Calamity.Commands.Parser.KleeneStarConcat` and added   `Calamity.Commands.Parser.KleenePlusConcat`-  + * Added `Calamity.Types.Upgradeable`  ## 0.1.9.2@@ -177,7 +199,7 @@  * Added commands, located in `Calamity.Commands`, along with a DSL for declaring   commands nicely.-  + * Renamed `waitUntil` to `waitUntilM`, and introduced a variant with a pure   check function that takes the original name of `waitUntil`. 

@@ -1,6 +1,6 @@ -- Generated by stackage-to-hackage -with-compiler: ghc-8.8.3+with-compiler: ghc  packages:     ./

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 4cd6c5a80a55753413c0b839551d9d76dac6c32465e782b04be30aa1a16abf24+-- hash: eb69f9ccf663e6f7de402507416d61ec69ba3c89e2706f2a6db544aa7056696e  name:           calamity-version:        0.1.17.1+version:        0.1.18.0 synopsis:       A library for writing discord bots in haskell description:    Please see the README on GitHub at <https://github.com/nitros12/calamity#readme> category:       Network, Web@@ -18,7 +18,7 @@ copyright:      2020 Ben Simms license:        MIT license-file:   LICENSE-tested-with:    GHC == 8.6.5, GHC == 8.8.3+tested-with:    GHC == 8.8.3 build-type:     Simple extra-source-files:     README.md@@ -135,7 +135,7 @@   hs-source-dirs:       src   default-extensions: StrictData AllowAmbiguousTypes BlockArguments NoMonomorphismRestriction BangPatterns BinaryLiterals UndecidableInstances ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs DerivingVia DerivingStrategies GeneralizedNewtypeDeriving StandaloneDeriving DeriveAnyClass InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings OverloadedLabels PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables TupleSections TypeFamilies TypeSynonymInstances ViewPatterns DuplicateRecordFields TypeOperators TypeApplications RoleAnnotations-  ghc-options: -fwrite-ide-info -hiedir=.hie -fplugin=Polysemy.Plugin -funbox-strict-fields -Wall -fno-warn-name-shadowing+  ghc-options: -fplugin=Polysemy.Plugin -funbox-strict-fields -Wall -fno-warn-name-shadowing   build-depends:       aeson >=1.4 && <2     , async >=2.2 && <3@@ -177,6 +177,7 @@     , time >=1.8 && <1.11     , typerep-map >=0.3 && <0.4     , unagi-chan >=0.4 && <0.5+    , unboxing-vector >=0.1 && <0.2     , unordered-containers >=0.2 && <0.3     , vector >=0.12 && <0.13     , websockets >=0.12 && <0.13

@@ -50,7 +50,6 @@ import           Data.Proxy import qualified Data.Text                         as S import           Data.Time.Clock.POSIX-import           Data.Traversable import           Data.Typeable  import qualified DiPolysemy                        as Di@@ -147,7 +146,7 @@ -- Reacting to a custom event: -- -- @--- 'react' @(\''CustomEvt' "my-event" ('Data.Text.Text', 'Message')) $ \(s, m) ->+-- 'react' @(\''CustomEvt' "my-event" ('Data.Text.Text', 'Message')) $ \\(s, m) -> --    'void' $ 'Calamity.Types.Tellable.tell' @'Data.Text.Text' m ("Somebody told me to tell you about: " '<>' s) -- @ --@@ -230,7 +229,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.Lazy.isInfixOf' "hi" $ m ^. #content) --        print $ msg ^. #content -- @ waitUntil@@ -269,7 +268,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.Lazy.isInfixOf' "hi" $ m ^. #content)) --        print $ msg ^. #content -- @ waitUntilM@@ -511,35 +510,62 @@   pure $ map ($ msg) (getEventHandlers @'MessageCreateEvt eh)  handleEvent' eh evt@(MessageUpdate msg) = do-  Just oldMsg <- getMessage (getID msg)+  oldMsg <- getMessage (getID msg)   updateCache evt-  Just newMsg <- getMessage (getID msg)-  pure $ map ($ (oldMsg, newMsg)) (getEventHandlers @'MessageUpdateEvt eh)+  newMsg <- getMessage (getID msg)+  let rawActions = map ($ msg) (getEventHandlers @'RawMessageUpdateEvt eh)+  let actions = case (oldMsg, newMsg) of+                  (Just oldMsg', Just newMsg') ->+                    map ($ (oldMsg', newMsg')) (getEventHandlers @'MessageUpdateEvt eh)+                  _ -> []+  pure $ rawActions <> actions  handleEvent' eh evt@(MessageDelete MessageDeleteData { id }) = do-  Just oldMsg <- getMessage id+  oldMsg <- getMessage id   updateCache evt-  pure $ map ($ oldMsg) (getEventHandlers @'MessageDeleteEvt eh)+  let rawActions = map ($ id) (getEventHandlers @'RawMessageDeleteEvt eh)+  let actions = case oldMsg of+        Just oldMsg' ->+          map ($ oldMsg') (getEventHandlers @'MessageDeleteEvt eh)+        _ -> []+  pure $ rawActions <> actions  handleEvent' eh evt@(MessageDeleteBulk MessageDeleteBulkData { ids }) = do   messages <- catMaybes <$> traverse getMessage ids   updateCache evt-  join <$> for messages (\msg -> pure $ map ($ msg) (getEventHandlers @'MessageDeleteEvt eh))+  let rawActions = map ($ ids) (getEventHandlers @'RawMessageDeleteBulkEvt eh)+  let actions = map ($ messages) (getEventHandlers @'MessageDeleteBulkEvt eh)+  pure $ rawActions <> actions  handleEvent' eh evt@(MessageReactionAdd reaction) = do   updateCache evt-  Just msg <- getMessage (getID reaction)-  pure $ map ($ (msg, reaction)) (getEventHandlers @'MessageReactionAddEvt eh)+  msg <- getMessage (getID reaction)+  let rawActions = map ($ reaction) (getEventHandlers @'RawMessageReactionAddEvt eh)+  let actions = case msg of+        Just msg' ->+          map ($ (msg', reaction)) (getEventHandlers @'MessageReactionAddEvt eh)+        _ -> []+  pure $ rawActions <> actions  handleEvent' eh evt@(MessageReactionRemove reaction) = do-  Just msg <- getMessage (getID reaction)+  msg <- getMessage (getID reaction)   updateCache evt-  pure $ map ($ (msg, reaction)) (getEventHandlers @'MessageReactionRemoveEvt eh)+  let rawActions = map ($ reaction) (getEventHandlers @'RawMessageReactionRemoveEvt eh)+  let actions = case msg of+        Just msg' ->+          map ($ (msg', reaction)) (getEventHandlers @'MessageReactionRemoveEvt eh)+        _ -> []+  pure $ rawActions <> actions  handleEvent' eh evt@(MessageReactionRemoveAll MessageReactionRemoveAllData { messageID }) = do-  Just msg <- getMessage messageID+  msg <- getMessage messageID   updateCache evt-  pure $ map ($ msg) (getEventHandlers @'MessageReactionRemoveAllEvt eh)+  let rawActions = map ($ messageID) (getEventHandlers @'RawMessageReactionRemoveAllEvt eh)+  let actions = case msg of+        Just msg' ->+          map ($ msg') (getEventHandlers @'MessageReactionRemoveAllEvt eh)+        _ -> []+  pure $ rawActions <> actions  handleEvent' eh evt@(PresenceUpdate PresenceUpdateData { userID, presence = Presence { guildID } }) = do   Just oldGuild <- getGuild guildID

@@ -22,6 +22,7 @@ import           Calamity.Metrics.Eff import           Calamity.Types.LogEff import           Calamity.Types.Model.Channel+import           Calamity.Types.Model.Channel.UpdatedMessage import           Calamity.Types.Model.Guild import           Calamity.Types.Model.User import           Calamity.Types.Token@@ -112,11 +113,43 @@   | InviteDeleteEvt   | MessageCreateEvt   | MessageUpdateEvt+  -- ^ Fired when a cached message is updated, use 'RawMessageUpdateEvt' to see+  -- updates of uncached messages+  | RawMessageUpdateEvt+  -- ^ Fired when a message is updated   | MessageDeleteEvt+  -- ^ Fired when a cached message is deleted, use 'RawMessageDeleteEvt' to see+  -- deletes of uncached messages.+  --+  -- Does not include messages deleted through bulk deletes, use+  -- 'MessageDeleteBulkEvt' for those+  | RawMessageDeleteEvt+  -- ^ Fired when a message is deleted.+  --+  -- Does not include messages deleted through bulk deletes, use+  -- 'RawMessageDeleteBulkEvt' for those   | MessageDeleteBulkEvt+  -- ^ Fired when messages are bulk deleted. Only includes cached messages, use+  -- 'RawMessageDeleteBulkEvt' to see deletes of uncached messages.+  | RawMessageDeleteBulkEvt+  -- ^ Fired when messages are bulk deleted.   | MessageReactionAddEvt+  -- ^ Fired when a reaction is added to a cached message, use+  -- 'RawMessageReactionAddEvt' to see reactions on uncached messages.+  | RawMessageReactionAddEvt+  -- ^ Fired when a reaction is added to a message.   | MessageReactionRemoveEvt+  -- ^ Fired when a reaction is removed from a cached message, use+  -- 'RawMessageReactionRemoveEvt' to see reactions on uncached messages.+  | RawMessageReactionRemoveEvt+  -- ^ Fired when a reaction is removed from a message.   | MessageReactionRemoveAllEvt+  -- ^ Fired when all reactions are removed from a cached message, use+  -- 'RawMessageReactionRemoveEvt' to see reactions on uncached messages.+  --+  -- The message passed will contain the removed events.+  | RawMessageReactionRemoveAllEvt+  -- ^ Fired when all reactions are removed from a message.   | TypingStartEvt   | UserUpdateEvt   | forall s a. CustomEvt s a@@ -165,6 +198,12 @@   EHType 'MessageReactionAddEvt       = (Message, Reaction)   EHType 'MessageReactionRemoveEvt    = (Message, Reaction)   EHType 'MessageReactionRemoveAllEvt = Message+  EHType 'RawMessageUpdateEvt            = UpdatedMessage+  EHType 'RawMessageDeleteEvt            = Snowflake Message+  EHType 'RawMessageDeleteBulkEvt        = [Snowflake Message]+  EHType 'RawMessageReactionAddEvt       = Reaction+  EHType 'RawMessageReactionRemoveEvt    = Reaction+  EHType 'RawMessageReactionRemoveAllEvt = Snowflake Message   EHType 'TypingStartEvt              = (Channel, Snowflake User, UnixTimestamp)   EHType 'UserUpdateEvt               = (User, User)   EHType ('CustomEvt s a)             = a

@@ -21,6 +21,7 @@ import           Data.Char                     ( isSpace ) import           Data.Kind import           Data.List.NonEmpty            ( NonEmpty(..) )+import           Data.Maybe                    ( isJust ) import           Data.Semigroup import qualified Data.Text                     as S import qualified Data.Text.Lazy                as L@@ -312,11 +313,11 @@  partialEmoji :: MonadParsec e L.Text m => m (Partial Emoji) partialEmoji = do-  void (chunk "<" *> optional (chunk "a"))+  animated <- isJust <$> (chunk "<" *> optional (chunk "a"))   name <-  between (chunk ":") (chunk ":") (takeWhileP (Just "Emoji name") $ not . (== ':'))   id <- snowflake   void $ chunk ">"-  pure (PartialEmoji id name)+  pure (PartialEmoji id name animated)  emoji :: MonadParsec e L.Text m => m (Snowflake a) emoji = ping' (optional (chunk "a") *> between (chunk ":") (chunk ":") (void $ takeWhileP Nothing $ not . (== ':')))

@@ -22,7 +22,7 @@ import           Data.Text.Lazy                              ( Text ) import           Data.Time import           Data.Typeable-import           Data.Vector.Unboxed                         ( Vector )+import           Data.Vector.Unboxing                        ( Vector )  import           GHC.Generics 

@@ -27,6 +27,7 @@ import           Data.Generics.Product.Subtype  ( upcast ) import           Data.Maybe import qualified Data.Text                      as S+import qualified Data.Text.Encoding as S import           Data.Text                      ( Text )  import           GHC.Generics@@ -37,6 +38,7 @@ import           Network.Mime  import           TextShow+import Network.HTTP.Types (urlEncode)  data CreateMessageOptions = CreateMessageOptions   { content         :: Maybe Text@@ -167,6 +169,9 @@ baseRoute id = mkRouteBuilder // S "channels" // ID @Channel   & giveID id +encodeEmoji :: RawEmoji -> S.Text+encodeEmoji = S.decodeUtf8 . urlEncode True . S.encodeUtf8 . showt+ instance Request (ChannelRequest a) where   type Result (ChannelRequest a) = a @@ -184,20 +189,20 @@     & giveID mid     & buildRoute   route (CreateReaction (getID -> cid) (getID @Message -> mid) emoji) =-    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (showt emoji) // S "@me"+    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (encodeEmoji emoji) // S "@me"     & giveID mid     & buildRoute   route (DeleteOwnReaction (getID -> cid) (getID @Message -> mid) emoji) =-    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (showt emoji) // S "@me"+    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (encodeEmoji emoji) // S "@me"     & giveID mid     & buildRoute   route (DeleteUserReaction (getID -> cid) (getID @Message -> mid) emoji (getID @User -> uid)) =-    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (showt emoji) // ID @User+    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (encodeEmoji emoji) // ID @User     & giveID mid     & giveID uid     & buildRoute   route (GetReactions (getID -> cid) (getID @Message -> mid) emoji _) =-    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (showt emoji)+    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (encodeEmoji emoji)     & giveID mid     & buildRoute   route (DeleteAllReactions (getID -> cid) (getID @Message -> mid)) =

@@ -17,7 +17,6 @@  import           GHC.Generics -import           Network.Wreq.Lens import           Network.Wreq.Session  

@@ -137,3 +137,4 @@ jsonOptionsKeepNothing = defaultOptions { sumEncoding        = UntaggedValue                                         , fieldLabelModifier = camelTo2 '_' . filter (/= '_')                                         , omitNothingFields  = False }+

@@ -27,8 +27,9 @@ import           Data.Semigroup        ( Last(..) ) import           Data.Text.Lazy import           Data.Time-import qualified Data.Vector.Unboxed   as VU-import           Data.Vector.Unboxed   ( Vector )+import qualified Data.Vector.Unboxing  as VU+import           Data.Vector.Unboxing  ( Vector )+import           Data.Aeson  import qualified DiPolysemy            as Di @@ -93,7 +94,7 @@ instance TextShow UTCTime where   showb = fromString . show -instance (TextShow a, VU.Unbox a) => TextShow (Vector a) where+instance (TextShow a, VU.Unboxable a) => TextShow (Vector a) where   showb = showbList . VU.toList  instance (Show k, Show v) => TextShow (LH.HashMap k v) where@@ -106,4 +107,11 @@   showb = fromString . show  instance Default (M.Map k v) where-  def = M.empty+    def = M.empty++instance (FromJSON a, VU.Unboxable a) => FromJSON (VU.Vector a) where+  parseJSON = (VU.fromList <$>) . parseJSON++instance (ToJSON a, VU.Unboxable a) => ToJSON (VU.Vector a) where+  toJSON = toJSON . VU.toList+  toEncoding = toEncoding . VU.toList

@@ -11,7 +11,7 @@  import           Data.Aeson import           Data.Time-import           Data.Vector.Unboxed                  ( Vector )+import           Data.Vector.Unboxing                 ( Vector )  import           GHC.Generics 

@@ -12,7 +12,7 @@ import           Data.Aeson import           Data.Text.Lazy                       ( Text ) import           Data.Time-import           Data.Vector.Unboxed                  ( Vector )+import           Data.Vector.Unboxing                 ( Vector )  import           GHC.Generics 

@@ -15,7 +15,7 @@ import           Data.Scientific import           Data.Text.Lazy                   ( Text ) import           Data.Time-import qualified Data.Vector.Unboxed              as UV+import qualified Data.Vector.Unboxing             as UV  import           GHC.Generics 

@@ -13,7 +13,7 @@ import           Data.Aeson import           Data.Text.Lazy                   ( Text ) import           Data.Time-import qualified Data.Vector.Unboxed              as UV+import qualified Data.Vector.Unboxing             as UV  import           GHC.Generics 

@@ -2,7 +2,8 @@ module Calamity.Types.Model.Guild.Emoji     ( Emoji(..)     , Partial(PartialEmoji)-    , RawEmoji(..) ) where+    , RawEmoji(..)+    , emojiAsRawEmoji ) where  import           Calamity.Internal.AesonThings import           Calamity.Internal.Utils         ()@@ -11,13 +12,15 @@ import           Calamity.Types.Snowflake  import           Data.Aeson+import qualified Data.Text.Lazy                  as L import           Data.Text.Lazy                  ( Text )-import           Data.Vector.Unboxed             ( Vector )+import           Data.Vector.Unboxing            ( Vector )  import           GHC.Generics  import           TextShow import qualified TextShow.Generic                as TSG+import Data.Generics.Product  data Emoji = Emoji   { id            :: Snowflake Emoji@@ -34,21 +37,43 @@   deriving ( FromJSON ) via WithSpecialCases '["user" `ExtractFieldFrom` "id"] Emoji   deriving ( HasID Emoji ) via HasIDField "id" Emoji +emojiAsRawEmoji :: Emoji -> RawEmoji+emojiAsRawEmoji = CustomEmoji . upcast+ data instance Partial Emoji = PartialEmoji   { id   :: Snowflake Emoji   , name :: Text+  , animated :: Bool   }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric (Partial Emoji)-  deriving ( ToJSON, FromJSON ) via CalamityJSON (Partial Emoji)+  deriving ( Eq, Generic )+  deriving ( ToJSON ) via CalamityJSON (Partial Emoji)+  deriving ( FromJSON ) via WithSpecialCases+      '["animated" `IfNoneThen` DefaultToFalse] (Partial Emoji)   deriving ( HasID Emoji ) via HasIDField "id" (Partial Emoji) +instance Show (Partial Emoji) where+  show PartialEmoji { id, name, animated } =+    "<" <> a <> ":" <> L.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 <> ">"+    where a = if animated then "a" else ""+ data RawEmoji   = UnicodeEmoji Text   | CustomEmoji (Partial Emoji)-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric RawEmoji+  deriving ( Eq, Generic ) +instance Show RawEmoji where+  show (UnicodeEmoji v) = L.unpack v+  show (CustomEmoji p) = show p++instance TextShow RawEmoji where+  showb (UnicodeEmoji v) = fromLazyText v+  showb (CustomEmoji p) = showb p+ instance ToJSON RawEmoji where   toJSON (CustomEmoji e) = object ["emoji" .= e]   toJSON (UnicodeEmoji s) = object ["emoji" .= object ["name" .= s]]@@ -56,8 +81,9 @@ instance FromJSON RawEmoji where   parseJSON = withObject "RawEmoji" $ \v -> do     m_id :: Maybe (Snowflake Emoji) <- v .:? "id"+    anim <- v .:? "animated" .!= False     name :: Text <- v .: "name"      pure $ case m_id of-      Just id -> CustomEmoji $ PartialEmoji id name+      Just id -> CustomEmoji $ PartialEmoji id name anim       Nothing -> UnicodeEmoji name

@@ -13,7 +13,7 @@ import           Data.Aeson import           Data.Text.Lazy                   ( Text ) import           Data.Time-import           Data.Vector.Unboxed              ( Vector )+import           Data.Vector.Unboxing             ( Vector )  import           GHC.Generics 

@@ -10,7 +10,6 @@  import           Control.DeepSeq import           Control.Lens-import           Control.Monad  import           Data.Aeson import           Data.Data@@ -18,9 +17,7 @@ import           Data.Hashable import           Data.Kind import           Data.Text.Read-import qualified Data.Vector.Generic.Base     as V-import qualified Data.Vector.Generic.Mutable  as MV-import qualified Data.Vector.Unboxed          as U+import qualified Data.Vector.Unboxing         as U import           Data.Word  import           GHC.Generics@@ -34,7 +31,7 @@   }   deriving ( Generic, Eq, Ord, Data )   deriving ( Show, TextShow ) via Word64-  deriving newtype ( NFData, ToJSONKey, Hashable )+  deriving newtype ( NFData, ToJSONKey, Hashable, U.Unboxable )  instance ToJSON (Snowflake t) where   toJSON (Snowflake s) = String . showt $ s@@ -74,69 +71,3 @@  instance HasID a (Snowflake a) where   getID = id--newtype instance U.MVector s (Snowflake t) = MV_Snowflake (U.MVector s Word64)--newtype instance U.Vector (Snowflake t) = V_Snowflake (U.Vector Word64)--instance MV.MVector U.MVector (Snowflake t) where-  {-# INLINE basicLength #-}-  {-# INLINE basicUnsafeSlice #-}-  {-# INLINE basicOverlaps #-}-  {-# INLINE basicUnsafeNew #-}-  {-# INLINE basicInitialize #-}-  {-# INLINE basicUnsafeReplicate #-}-  {-# INLINE basicUnsafeRead #-}-  {-# INLINE basicUnsafeWrite #-}-  {-# INLINE basicClear #-}-  {-# INLINE basicSet #-}-  {-# INLINE basicUnsafeCopy #-}-  {-# INLINE basicUnsafeGrow #-}-  basicLength (MV_Snowflake v) = MV.basicLength v--  basicUnsafeSlice i n (MV_Snowflake v) = MV_Snowflake $ MV.basicUnsafeSlice i n v--  basicOverlaps (MV_Snowflake v1) (MV_Snowflake v2) = MV.basicOverlaps v1 v2--  basicUnsafeNew n = MV_Snowflake `liftM` MV.basicUnsafeNew n--  basicInitialize (MV_Snowflake v) = MV.basicInitialize v--  basicUnsafeReplicate n x = MV_Snowflake `liftM` MV.basicUnsafeReplicate n (fromSnowflake x)--  basicUnsafeRead (MV_Snowflake v) i = Snowflake `liftM` MV.basicUnsafeRead v i--  basicUnsafeWrite (MV_Snowflake v) i x = MV.basicUnsafeWrite v i (fromSnowflake x)--  basicClear (MV_Snowflake v) = MV.basicClear v--  basicSet (MV_Snowflake v) x = MV.basicSet v (fromSnowflake x)--  basicUnsafeCopy (MV_Snowflake v1) (MV_Snowflake v2) = MV.basicUnsafeCopy v1 v2--  basicUnsafeMove (MV_Snowflake v1) (MV_Snowflake v2) = MV.basicUnsafeMove v1 v2--  basicUnsafeGrow (MV_Snowflake v) n = MV_Snowflake `liftM` MV.basicUnsafeGrow v n--instance V.Vector U.Vector (Snowflake t) where-  {-# INLINE basicUnsafeFreeze #-}-  {-# INLINE basicUnsafeThaw #-}-  {-# INLINE basicLength #-}-  {-# INLINE basicUnsafeSlice #-}-  {-# INLINE basicUnsafeIndexM #-}-  {-# INLINE elemseq #-}-  basicUnsafeFreeze (MV_Snowflake v) = V_Snowflake `liftM` V.basicUnsafeFreeze v--  basicUnsafeThaw (V_Snowflake v) = MV_Snowflake `liftM` V.basicUnsafeThaw v--  basicLength (V_Snowflake v) = V.basicLength v--  basicUnsafeSlice i n (V_Snowflake v) = V_Snowflake $ V.basicUnsafeSlice i n v--  basicUnsafeIndexM (V_Snowflake v) i = Snowflake `liftM` V.basicUnsafeIndexM v i--  basicUnsafeCopy (MV_Snowflake mv) (V_Snowflake v) = V.basicUnsafeCopy mv v--  elemseq _ = seq--instance U.Unbox (Snowflake t)

@@ -18,7 +18,7 @@ import           Control.Lens  import           Data.Flags-import qualified Data.Vector.Unboxed                    as V+import qualified Data.Vector.Unboxing                   as V  import qualified Polysemy                               as P import Data.Foldable (Foldable(foldl'))