calamity 0.1.12.0 → 0.1.13.0

raw patch · 5 files changed

+90/−236 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• calamity.cabal +2/−3
• src/Calamity/Client/Client.hs +46/−47
• src/Calamity/Client/Types.hs +35/−71
• src/Calamity/Internal/GenericCurry.hs +0/−115

@@ -1,5 +1,12 @@ # Changelog for Calamity +## 0.1.13.0++*2020-06-06*++* Changed event handlers to take tuples instead of being higher arity when there+  is more than one parameter to the callback.+ ## 0.1.12.0  *2020-06-06*

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: dc8569a5fcc9d4c838ce504e002cc38a1016ff3089378cbf8437b12f4f6c4e60+-- hash: 81cfbc5822a563275b09910155612968095794467d65ba95f1eaa54d90312085  name:           calamity-version:        0.1.12.0+version:        0.1.13.0 synopsis:       A library for writing discord bots description:    Please see the README on GitHub at <https://github.com/nitros12/calamity#readme> category:       Network, Web@@ -75,7 +75,6 @@       Calamity.Internal.AesonThings       Calamity.Internal.BoundedStore       Calamity.Internal.ConstructorName-      Calamity.Internal.GenericCurry       Calamity.Internal.IntColour       Calamity.Internal.LocalWriter       Calamity.Internal.RunIntoIO

@@ -22,7 +22,6 @@ import           Calamity.Gateway.Intents import           Calamity.HTTP.Internal.Ratelimit import           Calamity.Internal.ConstructorName-import           Calamity.Internal.GenericCurry import           Calamity.Internal.RunIntoIO import qualified Calamity.Internal.SnowflakeMap    as SM import           Calamity.Internal.Updateable@@ -149,15 +148,15 @@ -- This function is pretty bad for giving nasty type errors, -- since if something doesn't match then 'EHType' might not get substituted, -- which will result in errors about parameter counts mismatching.-react :: forall (s :: EventType) r t eh ehIO.-      (BotC r, ReactConstraints r s eh ehIO t)-      => EHType s (P.Sem r) ()+react :: forall (s :: EventType) r.+      (BotC r, ReactConstraints s)+      => (EHType s -> (P.Sem r) ())       -> P.Sem r (P.Sem r ()) react handler = do-  handler' <- bindSemToIO $ uncurryG handler+  handler' <- bindSemToIO handler   ehidC <- P.asks (^. #ehidCounter)   id' <- P.embed $ atomicModifyIORef ehidC (\i -> (succ i, i))-  let handlers = makeEventHandlers (Proxy @s) id' (const () <.> curryG handler')+  let handlers = makeEventHandlers (Proxy @s) id' (const () <.> handler')   P.atomicModify (handlers <>)   pure $ removeHandler @s id' @@ -215,7 +214,7 @@ -- And for @s ~ \''MessageUpdateEvt'@: -- -- @--- 'waitUntil' :: ('Message' -> 'Message' -> 'Bool') -> 'P.Sem' r ('Message', 'Message')+-- 'waitUntil' :: (('Message', 'Message') -> 'Bool') -> 'P.Sem' r ('Message', 'Message') -- @ -- -- ==== Examples@@ -227,20 +226,20 @@ --        print $ msg ^. #content -- @ waitUntil-  :: forall (s :: EventType) r t eh check.-  ( BotC r, WaitUntilConstraints r s eh check t)-  => check-  -> P.Sem r t+  :: forall (s :: EventType) r.+  ( BotC r, ReactConstraints s)+  => (EHType s -> Bool)+  -> P.Sem r (EHType s) waitUntil f = do   result <- P.embed newEmptyMVar-  remove <- react @s (curryG $ checker result)+  remove <- react @s (checker result)   res <- P.embed $ takeMVar result   remove   pure res   where-    checker :: MVar t -> t -> P.Sem r ()+    checker :: MVar (EHType s) -> EHType s -> P.Sem r ()     checker result args = do-      when (uncurryG f args) $ do+      when (f args) $ do         P.embed $ putMVar result args  -- | Wait until an event satisfying a condition happens, then returns it's@@ -255,7 +254,7 @@ -- And for @s ~ \''MessageUpdateEvt'@: -- -- @--- 'waitUntilM' :: ('Message' -> 'Message' -> 'P.Sem' r 'Bool') -> 'P.Sem' r ('Message', 'Message')+-- 'waitUntilM' :: (('Message', 'Message') -> 'P.Sem' r 'Bool') -> 'P.Sem' r ('Message', 'Message') -- @ -- -- ==== Examples@@ -267,20 +266,20 @@ --        print $ msg ^. #content -- @ waitUntilM-  :: forall (s :: EventType) r t eh ehB.-  ( BotC r, WaitUntilMConstraints r s eh ehB t)-  => ehB-  -> P.Sem r t+  :: forall (s :: EventType) r.+  ( BotC r, ReactConstraints s)+  => (EHType s -> P.Sem r Bool)+  -> P.Sem r (EHType s) waitUntilM f = do   result <- P.embed newEmptyMVar-  remove <- react @s (curryG $ checker result)+  remove <- react @s (checker result)   res <- P.embed $ takeMVar result   remove   pure res   where-    checker :: MVar t -> t -> P.Sem r ()+    checker :: MVar (EHType s) -> EHType s -> P.Sem r ()     checker result args = do-      res <- uncurryG f args+      res <- f args       when res $ do         P.embed $ putMVar result args @@ -382,7 +381,7 @@   Just oldChan <- DMChannel' <<$>> getDM (getID chan)   updateCache evt   Just newChan <- DMChannel' <<$>> getDM (getID chan)-  pure $ map (\f -> f oldChan newChan) (getEventHandlers @'ChannelUpdateEvt eh)+  pure $ map ($ (oldChan, newChan)) (getEventHandlers @'ChannelUpdateEvt eh)  handleEvent' eh evt@(ChannelUpdate (GuildChannel' chan)) = do   Just oldGuild <- getGuild (getID chan)@@ -390,18 +389,18 @@   updateCache evt   Just newGuild <- getGuild (getID chan)   Just newChan <- pure $ GuildChannel' <$> newGuild ^. #channels . at (getID chan)-  pure $ map (\f -> f oldChan newChan) (getEventHandlers @'ChannelUpdateEvt eh)+  pure $ map ($ (oldChan, newChan)) (getEventHandlers @'ChannelUpdateEvt eh)  handleEvent' eh evt@(ChannelDelete (GuildChannel' chan)) = do   Just oldGuild <- getGuild (getID chan)   Just oldChan <- pure $ GuildChannel' <$> oldGuild ^. #channels . at (getID chan)   updateCache evt-  pure $ map (\f -> f oldChan) (getEventHandlers @'ChannelDeleteEvt eh)+  pure $ map ($ oldChan) (getEventHandlers @'ChannelDeleteEvt eh)  handleEvent' eh evt@(ChannelDelete (DMChannel' chan)) = do   Just oldChan <- DMChannel' <<$>> getDM (getID chan)   updateCache evt-  pure $ map (\f -> f oldChan) (getEventHandlers @'ChannelDeleteEvt eh)+  pure $ map ($ oldChan) (getEventHandlers @'ChannelDeleteEvt eh)  -- handleEvent' eh evt@(ChannelPinsUpdate ChannelPinsUpdateData { channelID, lastPinTimestamp }) = do --   chan <- (GuildChannel' <$> os ^? #channels . at (coerceSnowflake channelID) . _Just)@@ -412,37 +411,37 @@   isNew <- not <$> isUnavailableGuild (getID guild)   updateCache evt   Just guild <- getGuild (getID guild)-  pure $ map (\f -> f guild (if isNew then GuildCreateNew else GuildCreateAvailable))+  pure $ map ($ (guild, (if isNew then GuildCreateNew else GuildCreateAvailable)))     (getEventHandlers @'GuildCreateEvt eh)  handleEvent' eh evt@(GuildUpdate guild) = do   Just oldGuild <- getGuild (getID guild)   updateCache evt   Just newGuild <- getGuild (getID guild)-  pure $ map (\f -> f oldGuild newGuild) (getEventHandlers @'GuildUpdateEvt eh)+  pure $ map ($ (oldGuild, newGuild)) (getEventHandlers @'GuildUpdateEvt eh)  -- NOTE: Guild will be deleted in the new cache if unavailable was false handleEvent' eh evt@(GuildDelete UnavailableGuild { id, unavailable }) = do   Just oldGuild <- getGuild id   updateCache evt-  pure $ map (\f -> f oldGuild (if unavailable then GuildDeleteUnavailable else GuildDeleteRemoved))+  pure $ map ($ (oldGuild, (if unavailable then GuildDeleteUnavailable else GuildDeleteRemoved)))     (getEventHandlers @'GuildDeleteEvt eh)  handleEvent' eh evt@(GuildBanAdd BanData { guildID, user }) = do   Just guild <- getGuild guildID   updateCache evt-  pure $ map (\f -> f guild user) (getEventHandlers @'GuildBanAddEvt eh)+  pure $ map ($ (guild, user)) (getEventHandlers @'GuildBanAddEvt eh)  handleEvent' eh evt@(GuildBanRemove BanData { guildID, user }) = do   Just guild <- getGuild guildID   updateCache evt-  pure $ map (\f -> f guild user) (getEventHandlers @'GuildBanRemoveEvt eh)+  pure $ map ($ (guild, user)) (getEventHandlers @'GuildBanRemoveEvt eh)  -- NOTE: we fire this event using the guild data with old emojis handleEvent' eh evt@(GuildEmojisUpdate GuildEmojisUpdateData { guildID, emojis }) = do   Just guild <- getGuild guildID   updateCache evt-  pure $ map (\f -> f guild emojis) (getEventHandlers @'GuildEmojisUpdateEvt eh)+  pure $ map ($ (guild, emojis)) (getEventHandlers @'GuildEmojisUpdateEvt eh)  handleEvent' eh evt@(GuildIntegrationsUpdate GuildIntegrationsUpdateData { guildID }) = do   updateCache evt@@ -467,19 +466,19 @@   updateCache evt   Just newGuild <- getGuild guildID   Just newMember <- pure $ newGuild ^. #members . at (getID user)-  pure $ map (\f -> f oldMember newMember) (getEventHandlers @'GuildMemberUpdateEvt eh)+  pure $ map ($ (oldMember, newMember)) (getEventHandlers @'GuildMemberUpdateEvt eh)  handleEvent' eh evt@(GuildMembersChunk GuildMembersChunkData { members, guildID }) = do   updateCache evt   Just guild <- getGuild guildID   let members' = guild ^.. #members . foldMap (at . getID) members . _Just-  pure $ map (\f -> f guild members') (getEventHandlers @'GuildMembersChunkEvt eh)+  pure $ map ($ (guild, members')) (getEventHandlers @'GuildMembersChunkEvt eh)  handleEvent' eh evt@(GuildRoleCreate GuildRoleData { guildID, role }) = do   updateCache evt   Just guild <- getGuild guildID   Just role' <- pure $ guild ^. #roles . at (getID role)-  pure $ map (\f -> f guild role') (getEventHandlers @'GuildRoleCreateEvt eh)+  pure $ map ($ (guild, role')) (getEventHandlers @'GuildRoleCreateEvt eh)  handleEvent' eh evt@(GuildRoleUpdate GuildRoleData { guildID, role }) = do   Just oldGuild <- getGuild guildID@@ -487,19 +486,19 @@   updateCache evt   Just newGuild <- getGuild guildID   Just newRole <- pure $ newGuild ^. #roles . at (getID role)-  pure $ map (\f -> f newGuild oldRole newRole) (getEventHandlers @'GuildRoleUpdateEvt eh)+  pure $ map ($ (newGuild, oldRole, newRole)) (getEventHandlers @'GuildRoleUpdateEvt eh)  handleEvent' eh evt@(GuildRoleDelete GuildRoleDeleteData { guildID, roleID }) = do   Just guild <- getGuild guildID   Just role <- pure $ guild ^. #roles . at roleID   updateCache evt-  pure $ map (\f -> f guild role) (getEventHandlers @'GuildRoleDeleteEvt eh)+  pure $ map ($ (guild, role)) (getEventHandlers @'GuildRoleDeleteEvt eh)  handleEvent' eh (InviteCreate d) = do-  pure $ map (\f -> f d) (getEventHandlers @'InviteCreateEvt eh)+  pure $ map ($ d) (getEventHandlers @'InviteCreateEvt eh)  handleEvent' eh (InviteDelete d) = do-  pure $ map (\f -> f d) (getEventHandlers @'InviteDeleteEvt eh)+  pure $ map ($ d) (getEventHandlers @'InviteDeleteEvt eh)  handleEvent' eh evt@(MessageCreate msg) = do   updateCache evt@@ -509,7 +508,7 @@   Just oldMsg <- getMessage (getID msg)   updateCache evt   Just newMsg <- getMessage (getID msg)-  pure $ map (\f -> f oldMsg newMsg) (getEventHandlers @'MessageUpdateEvt eh)+  pure $ map ($ (oldMsg, newMsg)) (getEventHandlers @'MessageUpdateEvt eh)  handleEvent' eh evt@(MessageDelete MessageDeleteData { id }) = do   Just oldMsg <- getMessage id@@ -524,12 +523,12 @@ handleEvent' eh evt@(MessageReactionAdd reaction) = do   updateCache evt   Just msg <- getMessage (getID reaction)-  pure $ map (\f -> f msg reaction) (getEventHandlers @'MessageReactionAddEvt eh)+  pure $ map ($ (msg, reaction)) (getEventHandlers @'MessageReactionAddEvt eh)  handleEvent' eh evt@(MessageReactionRemove reaction) = do   Just msg <- getMessage (getID reaction)   updateCache evt-  pure $ map (\f -> f msg reaction) (getEventHandlers @'MessageReactionRemoveEvt eh)+  pure $ map ($ (msg, reaction)) (getEventHandlers @'MessageReactionRemoveEvt eh)  handleEvent' eh evt@(MessageReactionRemoveAll MessageReactionRemoveAllData { messageID }) = do   Just msg <- getMessage messageID@@ -543,25 +542,25 @@   Just newGuild <- getGuild guildID   Just newMember <- pure $ newGuild ^. #members . at (coerceSnowflake userID)   let userUpdates = if oldMember ^. #user /= newMember ^. #user-                    then map (\f -> f (oldMember ^. #user) (newMember ^. #user)) (getEventHandlers @'UserUpdateEvt eh)+                    then map ($ ((oldMember ^. #user), (newMember ^. #user))) (getEventHandlers @'UserUpdateEvt eh)                     else mempty-  pure $ userUpdates <> map (\f -> f oldMember newMember) (getEventHandlers @'GuildMemberUpdateEvt eh)+  pure $ userUpdates <> map ($ (oldMember, newMember)) (getEventHandlers @'GuildMemberUpdateEvt eh)  handleEvent' eh (TypingStart TypingStartData { channelID, guildID, userID, timestamp }) =   case guildID of     Just gid -> do       Just guild <- getGuild gid       Just chan <- pure $ GuildChannel' <$> guild ^. #channels . at (coerceSnowflake channelID)-      pure $ map (\f -> f chan userID timestamp) (getEventHandlers @'TypingStartEvt eh)+      pure $ map ($ (chan, userID, timestamp)) (getEventHandlers @'TypingStartEvt eh)     Nothing -> do       Just chan <- DMChannel' <<$>> getDM (coerceSnowflake channelID)-      pure $ map (\f -> f chan userID timestamp) (getEventHandlers @'TypingStartEvt eh)+      pure $ map ($ (chan, userID, timestamp)) (getEventHandlers @'TypingStartEvt eh)  handleEvent' eh evt@(UserUpdate _) = do   Just oldUser <- getBotUser   updateCache evt   Just newUser <- getBotUser-  pure $ map (\f -> f oldUser newUser) (getEventHandlers @'UserUpdateEvt eh)+  pure $ map ($ (oldUser, newUser)) (getEventHandlers @'UserUpdateEvt eh)  handleEvent' _ e = fail $ "Unhandled event: " <> show e 

@@ -9,8 +9,6 @@     , BotC     , SetupEff     , ReactConstraints-    , WaitUntilConstraints-    , WaitUntilMConstraints     , EventHandlers(..)     , InsertEventHandler(..)     , RemoveEventHandler(..)@@ -21,7 +19,6 @@ import           Calamity.Gateway.DispatchEvents ( CalamityEvent(..), InviteCreateData, InviteDeleteData, ReadyData ) import           Calamity.Gateway.Types          ( ControlMessage ) import           Calamity.HTTP.Internal.Types-import           Calamity.Internal.GenericCurry import           Calamity.Metrics.Eff import           Calamity.Types.LogEff import           Calamity.Types.Model.Channel@@ -79,44 +76,11 @@  -- | Some constraints that 'Calamity.Client.Client.react' needs to work. Don't -- worry about these since they are satisfied for any type @s@ can be-type ReactConstraints r s eh ehIO t =-  ( InsertEventHandler s-  , RemoveEventHandler s-  , eh ~ EHType s (P.Sem r) ()-  , ehIO ~ EHType s IO ()-  , Uncurry eh-  , Uncurried eh ~ (t -> P.Sem r ())-  , Curry (t -> IO ())-  , ehIO ~ Curried (t -> IO ()))---- | Some constraints that 'Calamity.Client.Client.waitUntil' needs to work. Don't--- worry about these since they are satisfied for any type @s@ can be-type WaitUntilConstraints r s eh check t =+type ReactConstraints s =   ( InsertEventHandler s   , RemoveEventHandler s-  , Uncurry eh-  , eh ~ EHType s (P.Sem r) ()-  , eh ~ Curried (t -> P.Sem r ())-  , Uncurry check-  , Uncurried check ~ (t -> Bool)-  , Curry (t -> IO ())-  , Curried (t -> IO ()) ~ EHType s IO ()   ) --- | Some constraints that 'Calamity.Client.Client.waitUntilM' needs to work. Don't--- worry about these since they are satisfied for any type @s@ can be-type WaitUntilMConstraints r s eh ehB t =-  ( InsertEventHandler s-  , RemoveEventHandler s-  , Uncurry eh-  , eh ~ EHType s (P.Sem r) ()-  , eh ~ Curried (t -> P.Sem r ())-  , Uncurry ehB-  , Uncurried ehB ~ (t -> P.Sem r Bool)-  , Curry (t -> IO ())-  , Curried (t -> IO ()) ~ EHType s IO ()-  )- newtype StartupError = StartupError String   deriving ( Show ) @@ -169,40 +133,40 @@  -- | A type family to decide what the parameters for an event handler should be -- determined by the type of event it is handling.-type family EHType (d :: EventType) m r where-  EHType 'ReadyEvt                    m r = ReadyData                                   -> m r-  EHType 'ChannelCreateEvt            m r = Channel                                     -> m r-  EHType 'ChannelUpdateEvt            m r = Channel   -> Channel                        -> m r-  EHType 'ChannelDeleteEvt            m r = Channel                                     -> m r-  EHType 'ChannelpinsUpdateEvt        m r = Channel   -> Maybe UTCTime                  -> m r-  EHType 'GuildCreateEvt              m r = Guild     -> GuildCreateStatus              -> m r-  EHType 'GuildUpdateEvt              m r = Guild     -> Guild                          -> m r-  EHType 'GuildDeleteEvt              m r = Guild     -> GuildDeleteStatus              -> m r-  EHType 'GuildBanAddEvt              m r = Guild     -> User                           -> m r-  EHType 'GuildBanRemoveEvt           m r = Guild     -> User                           -> m r-  EHType 'GuildEmojisUpdateEvt        m r = Guild     -> [Emoji]                        -> m r-  EHType 'GuildIntegrationsUpdateEvt  m r = Guild                                       -> m r-  EHType 'GuildMemberAddEvt           m r = Member                                      -> m r-  EHType 'GuildMemberRemoveEvt        m r = Member                                      -> m r-  EHType 'GuildMemberUpdateEvt        m r = Member    -> Member                         -> m r-  EHType 'GuildMembersChunkEvt        m r = Guild     -> [Member]                       -> m r-  EHType 'GuildRoleCreateEvt          m r = Guild     -> Role                           -> m r-  EHType 'GuildRoleUpdateEvt          m r = Guild     -> Role          -> Role          -> m r-  EHType 'GuildRoleDeleteEvt          m r = Guild     -> Role                           -> m r-  EHType 'InviteCreateEvt             m r = InviteCreateData                            -> m r-  EHType 'InviteDeleteEvt             m r = InviteDeleteData                            -> m r-  EHType 'MessageCreateEvt            m r = Message                                     -> m r-  EHType 'MessageUpdateEvt            m r = Message   -> Message                        -> m r-  EHType 'MessageDeleteEvt            m r = Message                                     -> m r-  EHType 'MessageDeleteBulkEvt        m r = [Message]                                   -> m r-  EHType 'MessageReactionAddEvt       m r = Message   -> Reaction                       -> m r-  EHType 'MessageReactionRemoveEvt    m r = Message   -> Reaction                       -> m r-  EHType 'MessageReactionRemoveAllEvt m r = Message                                     -> m r-  EHType 'TypingStartEvt              m r = Channel  -> Snowflake User -> UnixTimestamp -> m r-  EHType 'UserUpdateEvt               m r = User      -> User                           -> m r-  EHType ('CustomEvt s a)             m r = a                                           -> m r+type family EHType (d :: EventType) where+  EHType 'ReadyEvt                    = ReadyData+  EHType 'ChannelCreateEvt            = Channel+  EHType 'ChannelUpdateEvt            = (Channel, Channel)+  EHType 'ChannelDeleteEvt            = Channel+  EHType 'ChannelpinsUpdateEvt        = (Channel, Maybe UTCTime)+  EHType 'GuildCreateEvt              = (Guild, GuildCreateStatus)+  EHType 'GuildUpdateEvt              = (Guild, Guild)+  EHType 'GuildDeleteEvt              = (Guild, GuildDeleteStatus)+  EHType 'GuildBanAddEvt              = (Guild, User)+  EHType 'GuildBanRemoveEvt           = (Guild, User)+  EHType 'GuildEmojisUpdateEvt        = (Guild, [Emoji])+  EHType 'GuildIntegrationsUpdateEvt  = Guild+  EHType 'GuildMemberAddEvt           = Member+  EHType 'GuildMemberRemoveEvt        = Member+  EHType 'GuildMemberUpdateEvt        = (Member, Member)+  EHType 'GuildMembersChunkEvt        = (Guild, [Member])+  EHType 'GuildRoleCreateEvt          = (Guild, Role)+  EHType 'GuildRoleUpdateEvt          = (Guild, Role, Role)+  EHType 'GuildRoleDeleteEvt          = (Guild, Role)+  EHType 'InviteCreateEvt             = InviteCreateData+  EHType 'InviteDeleteEvt             = InviteDeleteData+  EHType 'MessageCreateEvt            = Message+  EHType 'MessageUpdateEvt            = (Message, Message)+  EHType 'MessageDeleteEvt            = Message+  EHType 'MessageDeleteBulkEvt        = [Message]+  EHType 'MessageReactionAddEvt       = (Message, Reaction)+  EHType 'MessageReactionRemoveEvt    = (Message, Reaction)+  EHType 'MessageReactionRemoveAllEvt = Message+  EHType 'TypingStartEvt              = (Channel, Snowflake User, UnixTimestamp)+  EHType 'UserUpdateEvt               = (User, User)+  EHType ('CustomEvt s a)             = a -type StoredEHType t = EHType t IO ()+type StoredEHType t = EHType t -> IO ()  newtype EventHandlers = EventHandlers (TypeRepMap EventHandler) @@ -290,7 +254,7 @@ intoDynFn :: forall a. Typeable a => (a -> IO ()) -> (Dynamic -> IO ()) intoDynFn fn = \d -> fn $ fromDynamicJust d -instance (Typeable a, Typeable s, Typeable (StoredEHType ('CustomEvt s a)), EHType ('CustomEvt s a) IO () ~ (a -> IO ()))+instance (Typeable a, Typeable s, Typeable (StoredEHType ('CustomEvt s a)), (EHType ('CustomEvt s a) -> IO ()) ~ (a -> IO ()))   => InsertEventHandler' 'True ('CustomEvt s a) where   makeEventHandlers' _ _ id' handler = EventHandlers . TM.one $ EH @('CustomEvt Void Dynamic)     (LH.singleton (typeRep $ Proxy @s) (LH.singleton (typeRep $ Proxy @a) [EventHandlerWithID id' (intoDynFn handler)]))

@@ -1,115 +0,0 @@--- | Generic arity curry/ uncurry-module Calamity.Internal.GenericCurry-    ( Curry(..)-    , Uncurry(..) ) where--import           Data.Typeable--import           GHC.TypeNats--class Curry t where-  type Curried t-  type Parameters t--  curryG :: t -> Curried t--type family CurryInstanceSelector t :: Nat where-  CurryInstanceSelector (a -> b -> c -> d -> e -> f -> r) = 6-  CurryInstanceSelector (a -> b -> c -> d -> e -> r) = 5-  CurryInstanceSelector (a -> b -> c -> d -> r) = 4-  CurryInstanceSelector (a -> b -> c -> r) = 3-  CurryInstanceSelector (a -> b -> r) = 2-  CurryInstanceSelector (a -> r) = 1--class Curry' (flag :: Nat) t where-  type Curried' (flag :: Nat) t-  type Parameters' (flag :: Nat) t--  curryG' :: Proxy flag -> t -> Curried' flag t--instance (CurryInstanceSelector t ~ flag, Curry' flag t) => Curry t where-  type Curried t = Curried' (CurryInstanceSelector t) t-  type Parameters t = Parameters' (CurryInstanceSelector t) t--  curryG = curryG' (Proxy @flag)--instance Curry' 6 ((a, b, c, d, e, f) -> r) where-  type Curried' 6 ((a, b, c, d, e, f) -> r) = a -> b -> c -> d -> e -> f -> r-  type Parameters' 6 ((a, b, c, d, e, f) -> r) = (a, b, c, d, e, f)--  curryG' _ fn a b c d e f = fn (a, b, c, d, e, f)--instance Curry' 5 ((a, b, c, d, e) -> r) where-  type Curried' 5 ((a, b, c, d, e) -> r) = a -> b -> c -> d -> e -> r-  type Parameters' 5 ((a, b, c, d, e) -> r) = (a, b, c, d, e)--  curryG' _ fn a b c d e = fn (a, b, c, d, e)--instance Curry' 4 ((a, b, c, d) -> r) where-  type Curried' 4 ((a, b, c, d) -> r) = a -> b -> c -> d -> r-  type Parameters' 4 ((a, b, c, d) -> r) = (a, b, c, d)--  curryG' _ fn a b c d = fn (a, b, c, d)--instance Curry' 3 ((a, b, c) -> r) where-  type Curried' 3 ((a, b, c) -> r) = a -> b -> c -> r-  type Parameters' 3 ((a, b, c) -> r) = (a, b, c)--  curryG' _ fn a b c = fn (a, b, c)--instance Curry' 2 ((a, b) -> r) where-  type Curried' 2 ((a, b) -> r) = a -> b -> r-  type Parameters' 2 ((a, b) -> r) = (a, b)--  curryG' _ fn a b = fn (a, b)--instance Curry' 1 (a -> r) where-  type Curried' 1 (a -> r) = a -> r-  type Parameters' 1 (a -> r) = a--  curryG' _ fn = fn--class Uncurry t where-  type Uncurried t--  uncurryG :: t -> Uncurried t--class Uncurry' (flag :: Nat) t where-  type Uncurried' (flag :: Nat) t--  uncurryG' :: Proxy flag -> t -> Uncurried' flag t--instance (CurryInstanceSelector t ~ flag, Uncurry' flag t) => Uncurry t where-  type Uncurried t = Uncurried' (CurryInstanceSelector t) t--  uncurryG = uncurryG' (Proxy @flag)--instance Uncurry' 6 (a -> b -> c -> d -> e -> f -> r) where-  type Uncurried' 6 (a -> b -> c -> d -> e -> f -> r) = (a, b, c, d, e, f) -> r--  uncurryG' _ fn (a, b, c, d, e, f) = fn a b c d e f--instance Uncurry' 5 (a -> b -> c -> d -> e -> r) where-  type Uncurried' 5 (a -> b -> c -> d -> e -> r) = (a, b, c, d, e) -> r--  uncurryG' _ f (a, b, c, d, e) = f a b c d e--instance Uncurry' 4 (a -> b -> c -> d -> r) where-  type Uncurried' 4 (a -> b -> c -> d -> r) = (a, b, c, d) -> r--  uncurryG' _ f (a, b, c, d) = f a b c d--instance Uncurry' 3 (a -> b -> c -> r) where-  type Uncurried' 3 (a -> b -> c -> r) = (a, b, c) -> r--  uncurryG' _ f (a, b, c) = f a b c--instance Uncurry' 2 (a -> b -> r) where-  type Uncurried' 2 (a -> b -> r) = (a, b) -> r--  uncurryG' _ f (a, b) = f a b--instance Uncurry' 1 (a -> r) where-  type Uncurried' 1 (a -> r) = a -> r--  uncurryG' _ f = f