{-# LANGUAGE TemplateHaskell #-}

-- | Types for the client
module Calamity.Client.Types (
  Client (..),
  StartupError (..),
  EventType (..),
  GuildCreateStatus (..),
  GuildDeleteStatus (..),
  EHType,
  BotC,
  SetupEff,
  ReactConstraints,
  EventHandlers (..),
  InsertEventHandler (..),
  RemoveEventHandler (..),
  getEventHandlers,
  getCustomEventHandlers,
) where

import Calamity.Cache.Eff
import Calamity.Gateway.DispatchEvents (CalamityEvent (..), InviteCreateData, InviteDeleteData, ReactionEvtData, ReadyData)
import Calamity.Gateway.Types (ControlMessage)
import Calamity.HTTP.Internal.Ratelimit
import Calamity.HTTP.Internal.Types
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.Interaction (Interaction)
import Calamity.Types.Model.User
import Calamity.Types.Model.Voice
import Calamity.Types.Snowflake
import Calamity.Types.Token
import Calamity.Types.TokenEff
import Control.Concurrent.Async
import Control.Concurrent.Chan.Unagi
import Control.Concurrent.MVar
import Control.Concurrent.STM.TVar
import Data.Default.Class
import Data.Dynamic
import Data.IORef
import Data.Kind (Type)
import Data.Maybe
import Data.Time
import Data.TypeRepMap (TypeRepMap, WrapTypeable (..))
import Data.TypeRepMap qualified as TM
import Data.Typeable
import Data.Void (Void)
import Df1 qualified
import Di.Core qualified as DC
import GHC.Exts (fromList)
import Optics.TH
import Polysemy qualified as P
import Polysemy.Async qualified as P
import Polysemy.AtomicState qualified as P
import Polysemy.Reader qualified as P

data Client = Client
  { Client -> TVar [(InChan ControlMessage, Async (Maybe ()))]
shards :: TVar [(InChan ControlMessage, Async (Maybe ()))]
  , Client -> MVar Int
numShards :: MVar Int
  , Client -> Token
token :: Token
  , Client -> RateLimitState
rlState :: RateLimitState
  , Client -> InChan CalamityEvent
eventsIn :: InChan CalamityEvent
  , Client -> OutChan CalamityEvent
eventsOut :: OutChan CalamityEvent
  , Client -> IORef Integer
ehidCounter :: IORef Integer
  , Client -> Maybe (Di Level Path Message)
initialDi :: Maybe (DC.Di Df1.Level Df1.Path Df1.Message)
  }

-- | Constraints required by the bot client
type BotC r =
  ( P.Members
      '[ LogEff
       , MetricEff
       , CacheEff
       , RatelimitEff
       , TokenEff
       , P.Reader Client
       , P.AtomicState EventHandlers
       , P.Embed IO
       , P.Final IO
       , P.Async
       ]
      r
  )

-- | A concrete effect stack used inside the bot
type SetupEff r = (RatelimitEff ': TokenEff ': P.Reader Client ': P.AtomicState EventHandlers ': P.Async ': r)

{- | 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 s =
  ( InsertEventHandler s
  , RemoveEventHandler s
  )

newtype StartupError = StartupError String
  deriving stock (Int -> StartupError -> ShowS
[StartupError] -> ShowS
StartupError -> String
(Int -> StartupError -> ShowS)
-> (StartupError -> String)
-> ([StartupError] -> ShowS)
-> Show StartupError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StartupError -> ShowS
showsPrec :: Int -> StartupError -> ShowS
$cshow :: StartupError -> String
show :: StartupError -> String
$cshowList :: [StartupError] -> ShowS
showList :: [StartupError] -> ShowS
Show)

-- | A Data Kind used to fire custom events
data EventType
  = ReadyEvt
  | ChannelCreateEvt
  | ChannelUpdateEvt
  | ChannelDeleteEvt
  | ChannelpinsUpdateEvt
  | GuildCreateEvt
  | GuildUpdateEvt
  | GuildDeleteEvt
  | GuildBanAddEvt
  | GuildBanRemoveEvt
  | GuildEmojisUpdateEvt
  | GuildIntegrationsUpdateEvt
  | GuildMemberAddEvt
  | GuildMemberRemoveEvt
  | GuildMemberUpdateEvt
  | GuildMembersChunkEvt
  | GuildRoleCreateEvt
  | GuildRoleUpdateEvt
  | GuildRoleDeleteEvt
  | InviteCreateEvt
  | InviteDeleteEvt
  | MessageCreateEvt
  | -- | Fired when a cached message is updated, use 'RawMessageUpdateEvt' to see
    -- updates of uncached messages
    MessageUpdateEvt
  | -- | Fired when a message is updated
    RawMessageUpdateEvt
  | -- | 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
    MessageDeleteEvt
  | -- | Fired when a message is deleted.
    --
    -- Does not include messages deleted through bulk deletes, use
    -- 'RawMessageDeleteBulkEvt' for those
    RawMessageDeleteEvt
  | -- | Fired when messages are bulk deleted. Only includes cached messages, use
    -- 'RawMessageDeleteBulkEvt' to see deletes of uncached messages.
    MessageDeleteBulkEvt
  | -- | Fired when messages are bulk deleted.
    RawMessageDeleteBulkEvt
  | -- | Fired when a reaction is added to a cached message, use
    -- 'RawMessageReactionAddEvt' to see reactions on uncached messages.
    MessageReactionAddEvt
  | -- | Fired when a reaction is added to a message.
    RawMessageReactionAddEvt
  | -- | Fired when a reaction is removed from a cached message, use
    -- 'RawMessageReactionRemoveEvt' to see reactions on uncached messages.
    MessageReactionRemoveEvt
  | -- | Fired when a reaction is removed from a message.
    RawMessageReactionRemoveEvt
  | -- | 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.
    MessageReactionRemoveAllEvt
  | -- | Fired when all reactions are removed from a message.
    RawMessageReactionRemoveAllEvt
  | TypingStartEvt
  | UserUpdateEvt
  | -- | Sent when someone joins/leaves/moves voice channels
    VoiceStateUpdateEvt
  | -- | Fired when the bot receives an interaction
    InteractionEvt
  | -- | A custom event, @a@ is the data sent to the handler and should probably
    -- be a newtype to disambiguate events
    forall (a :: Type). CustomEvt a

data GuildCreateStatus
  = -- | The guild was just joined
    GuildCreateNew
  | -- | The guild is becoming available
    GuildCreateAvailable
  deriving (Int -> GuildCreateStatus -> ShowS
[GuildCreateStatus] -> ShowS
GuildCreateStatus -> String
(Int -> GuildCreateStatus -> ShowS)
-> (GuildCreateStatus -> String)
-> ([GuildCreateStatus] -> ShowS)
-> Show GuildCreateStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuildCreateStatus -> ShowS
showsPrec :: Int -> GuildCreateStatus -> ShowS
$cshow :: GuildCreateStatus -> String
show :: GuildCreateStatus -> String
$cshowList :: [GuildCreateStatus] -> ShowS
showList :: [GuildCreateStatus] -> ShowS
Show)

data GuildDeleteStatus
  = -- | The guild became unavailable
    GuildDeleteUnavailable
  | -- | The bot was removed from the guild
    GuildDeleteRemoved
  deriving (Int -> GuildDeleteStatus -> ShowS
[GuildDeleteStatus] -> ShowS
GuildDeleteStatus -> String
(Int -> GuildDeleteStatus -> ShowS)
-> (GuildDeleteStatus -> String)
-> ([GuildDeleteStatus] -> ShowS)
-> Show GuildDeleteStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuildDeleteStatus -> ShowS
showsPrec :: Int -> GuildDeleteStatus -> ShowS
$cshow :: GuildDeleteStatus -> String
show :: GuildDeleteStatus -> String
$cshowList :: [GuildDeleteStatus] -> ShowS
showList :: [GuildDeleteStatus] -> ShowS
Show)

{- | 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) 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 = (Guild, Member)
  EHType 'GuildMemberRemoveEvt = (Guild, Member)
  EHType 'GuildMemberUpdateEvt = (Guild, 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, Maybe User, Maybe Member)
  EHType 'MessageUpdateEvt = (Message, Message, Maybe User, Maybe Member)
  EHType 'MessageDeleteEvt = Message
  EHType 'MessageDeleteBulkEvt = [Message]
  EHType 'MessageReactionAddEvt = (Message, User, Channel, RawEmoji)
  EHType 'MessageReactionRemoveEvt = (Message, User, Channel, RawEmoji)
  EHType 'MessageReactionRemoveAllEvt = Message
  EHType 'RawMessageUpdateEvt = (UpdatedMessage, Maybe User, Maybe Member)
  EHType 'RawMessageDeleteEvt = Snowflake Message
  EHType 'RawMessageDeleteBulkEvt = [Snowflake Message]
  EHType 'RawMessageReactionAddEvt = ReactionEvtData
  EHType 'RawMessageReactionRemoveEvt = ReactionEvtData
  EHType 'RawMessageReactionRemoveAllEvt = Snowflake Message
  EHType 'TypingStartEvt = (Channel, Snowflake User, UTCTime)
  EHType 'UserUpdateEvt = (User, User)
  EHType 'VoiceStateUpdateEvt = (Maybe VoiceState, VoiceState)
  EHType 'InteractionEvt = Interaction
  EHType ('CustomEvt a) = a

type StoredEHType t = EHType t -> IO ()

newtype EventHandlers = EventHandlers (TypeRepMap EventHandler)

data EventHandlerWithID (a :: Type) = EventHandlerWithID
  { forall a. EventHandlerWithID a -> Integer
ehID :: Integer
  , forall a. EventHandlerWithID a -> a
eh :: a
  }

newtype CustomEHTypeStorage (a :: Type) = CustomEHTypeStorage
  { forall a.
CustomEHTypeStorage a -> [EventHandlerWithID (a -> IO ())]
unwrapCustomEHTypeStorage :: [EventHandlerWithID (a -> IO ())]
  }
  deriving newtype (Semigroup (CustomEHTypeStorage a)
CustomEHTypeStorage a
Semigroup (CustomEHTypeStorage a)
-> CustomEHTypeStorage a
-> (CustomEHTypeStorage a
    -> CustomEHTypeStorage a -> CustomEHTypeStorage a)
-> ([CustomEHTypeStorage a] -> CustomEHTypeStorage a)
-> Monoid (CustomEHTypeStorage a)
[CustomEHTypeStorage a] -> CustomEHTypeStorage a
CustomEHTypeStorage a
-> CustomEHTypeStorage a -> CustomEHTypeStorage a
forall {a}. Semigroup (CustomEHTypeStorage a)
forall a. CustomEHTypeStorage a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [CustomEHTypeStorage a] -> CustomEHTypeStorage a
forall a.
CustomEHTypeStorage a
-> CustomEHTypeStorage a -> CustomEHTypeStorage a
$cmempty :: forall a. CustomEHTypeStorage a
mempty :: CustomEHTypeStorage a
$cmappend :: forall a.
CustomEHTypeStorage a
-> CustomEHTypeStorage a -> CustomEHTypeStorage a
mappend :: CustomEHTypeStorage a
-> CustomEHTypeStorage a -> CustomEHTypeStorage a
$cmconcat :: forall a. [CustomEHTypeStorage a] -> CustomEHTypeStorage a
mconcat :: [CustomEHTypeStorage a] -> CustomEHTypeStorage a
Monoid, NonEmpty (CustomEHTypeStorage a) -> CustomEHTypeStorage a
CustomEHTypeStorage a
-> CustomEHTypeStorage a -> CustomEHTypeStorage a
(CustomEHTypeStorage a
 -> CustomEHTypeStorage a -> CustomEHTypeStorage a)
-> (NonEmpty (CustomEHTypeStorage a) -> CustomEHTypeStorage a)
-> (forall b.
    Integral b =>
    b -> CustomEHTypeStorage a -> CustomEHTypeStorage a)
-> Semigroup (CustomEHTypeStorage a)
forall b.
Integral b =>
b -> CustomEHTypeStorage a -> CustomEHTypeStorage a
forall a. NonEmpty (CustomEHTypeStorage a) -> CustomEHTypeStorage a
forall a.
CustomEHTypeStorage a
-> CustomEHTypeStorage a -> CustomEHTypeStorage a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b.
Integral b =>
b -> CustomEHTypeStorage a -> CustomEHTypeStorage a
$c<> :: forall a.
CustomEHTypeStorage a
-> CustomEHTypeStorage a -> CustomEHTypeStorage a
<> :: CustomEHTypeStorage a
-> CustomEHTypeStorage a -> CustomEHTypeStorage a
$csconcat :: forall a. NonEmpty (CustomEHTypeStorage a) -> CustomEHTypeStorage a
sconcat :: NonEmpty (CustomEHTypeStorage a) -> CustomEHTypeStorage a
$cstimes :: forall a b.
Integral b =>
b -> CustomEHTypeStorage a -> CustomEHTypeStorage a
stimes :: forall b.
Integral b =>
b -> CustomEHTypeStorage a -> CustomEHTypeStorage a
Semigroup)

type family EHStorageType (t :: EventType) where
  EHStorageType ('CustomEvt _) = TypeRepMap CustomEHTypeStorage
  EHStorageType t = [EventHandlerWithID (StoredEHType t)]

newtype EventHandler (t :: EventType) = EH
  { forall (t :: EventType).
EventHandler t
-> (Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
   EHStorageType t
unwrapEventHandler :: (Semigroup (EHStorageType t), Monoid (EHStorageType t)) => EHStorageType t
  }

instance Semigroup (EventHandler t) where
  EH (Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
EHStorageType t
a <> :: EventHandler t -> EventHandler t -> EventHandler t
<> EH (Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
EHStorageType t
b = ((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH (((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
  EHStorageType t)
 -> EventHandler t)
-> ((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
    EHStorageType t)
-> EventHandler t
forall a b. (a -> b) -> a -> b
$ EHStorageType t
(Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
EHStorageType t
a EHStorageType t -> EHStorageType t -> EHStorageType t
forall a. Semigroup a => a -> a -> a
<> EHStorageType t
(Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
EHStorageType t
b

instance Monoid (EventHandler t) where
  mempty :: EventHandler t
mempty = ((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH EHStorageType t
(Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
EHStorageType t
forall a. Monoid a => a
mempty

instance Default EventHandlers where
  def :: EventHandlers
def =
    TypeRepMap EventHandler -> EventHandlers
EventHandlers (TypeRepMap EventHandler -> EventHandlers)
-> TypeRepMap EventHandler -> EventHandlers
forall a b. (a -> b) -> a -> b
$
      [Item (TypeRepMap EventHandler)] -> TypeRepMap EventHandler
forall l. IsList l => [Item l] -> l
fromList
        [ EventHandler 'ReadyEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'ReadyEvt -> WrapTypeable EventHandler)
-> EventHandler 'ReadyEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'ReadyEvt []
        , EventHandler 'ChannelCreateEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'ChannelCreateEvt -> WrapTypeable EventHandler)
-> EventHandler 'ChannelCreateEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'ChannelCreateEvt []
        , EventHandler 'ChannelUpdateEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'ChannelUpdateEvt -> WrapTypeable EventHandler)
-> EventHandler 'ChannelUpdateEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'ChannelUpdateEvt []
        , EventHandler 'ChannelDeleteEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'ChannelDeleteEvt -> WrapTypeable EventHandler)
-> EventHandler 'ChannelDeleteEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'ChannelDeleteEvt []
        , EventHandler 'ChannelpinsUpdateEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'ChannelpinsUpdateEvt -> WrapTypeable EventHandler)
-> EventHandler 'ChannelpinsUpdateEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'ChannelpinsUpdateEvt []
        , EventHandler 'GuildCreateEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildCreateEvt -> WrapTypeable EventHandler)
-> EventHandler 'GuildCreateEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildCreateEvt []
        , EventHandler 'GuildUpdateEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildUpdateEvt -> WrapTypeable EventHandler)
-> EventHandler 'GuildUpdateEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildUpdateEvt []
        , EventHandler 'GuildDeleteEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildDeleteEvt -> WrapTypeable EventHandler)
-> EventHandler 'GuildDeleteEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildDeleteEvt []
        , EventHandler 'GuildBanAddEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildBanAddEvt -> WrapTypeable EventHandler)
-> EventHandler 'GuildBanAddEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildBanAddEvt []
        , EventHandler 'GuildBanRemoveEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildBanRemoveEvt -> WrapTypeable EventHandler)
-> EventHandler 'GuildBanRemoveEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildBanRemoveEvt []
        , EventHandler 'GuildEmojisUpdateEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildEmojisUpdateEvt -> WrapTypeable EventHandler)
-> EventHandler 'GuildEmojisUpdateEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildEmojisUpdateEvt []
        , EventHandler 'GuildIntegrationsUpdateEvt
-> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildIntegrationsUpdateEvt
 -> WrapTypeable EventHandler)
-> EventHandler 'GuildIntegrationsUpdateEvt
-> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildIntegrationsUpdateEvt []
        , EventHandler 'GuildMemberAddEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildMemberAddEvt -> WrapTypeable EventHandler)
-> EventHandler 'GuildMemberAddEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildMemberAddEvt []
        , EventHandler 'GuildMemberRemoveEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildMemberRemoveEvt -> WrapTypeable EventHandler)
-> EventHandler 'GuildMemberRemoveEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildMemberRemoveEvt []
        , EventHandler 'GuildMemberUpdateEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildMemberUpdateEvt -> WrapTypeable EventHandler)
-> EventHandler 'GuildMemberUpdateEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildMemberUpdateEvt []
        , EventHandler 'GuildMembersChunkEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildMembersChunkEvt -> WrapTypeable EventHandler)
-> EventHandler 'GuildMembersChunkEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildMembersChunkEvt []
        , EventHandler 'GuildRoleCreateEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildRoleCreateEvt -> WrapTypeable EventHandler)
-> EventHandler 'GuildRoleCreateEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildRoleCreateEvt []
        , EventHandler 'GuildRoleUpdateEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildRoleUpdateEvt -> WrapTypeable EventHandler)
-> EventHandler 'GuildRoleUpdateEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildRoleUpdateEvt []
        , EventHandler 'GuildRoleDeleteEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildRoleDeleteEvt -> WrapTypeable EventHandler)
-> EventHandler 'GuildRoleDeleteEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildRoleDeleteEvt []
        , EventHandler 'MessageCreateEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageCreateEvt -> WrapTypeable EventHandler)
-> EventHandler 'MessageCreateEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageCreateEvt []
        , EventHandler 'MessageUpdateEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageUpdateEvt -> WrapTypeable EventHandler)
-> EventHandler 'MessageUpdateEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageUpdateEvt []
        , EventHandler 'MessageDeleteEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageDeleteEvt -> WrapTypeable EventHandler)
-> EventHandler 'MessageDeleteEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageDeleteEvt []
        , EventHandler 'MessageDeleteBulkEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageDeleteBulkEvt -> WrapTypeable EventHandler)
-> EventHandler 'MessageDeleteBulkEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageDeleteBulkEvt []
        , EventHandler 'MessageReactionAddEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageReactionAddEvt -> WrapTypeable EventHandler)
-> EventHandler 'MessageReactionAddEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageReactionAddEvt []
        , EventHandler 'MessageReactionRemoveEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageReactionRemoveEvt
 -> WrapTypeable EventHandler)
-> EventHandler 'MessageReactionRemoveEvt
-> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageReactionRemoveEvt []
        , EventHandler 'MessageReactionRemoveAllEvt
-> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageReactionRemoveAllEvt
 -> WrapTypeable EventHandler)
-> EventHandler 'MessageReactionRemoveAllEvt
-> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageReactionRemoveAllEvt []
        , EventHandler 'TypingStartEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'TypingStartEvt -> WrapTypeable EventHandler)
-> EventHandler 'TypingStartEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'TypingStartEvt []
        , EventHandler 'UserUpdateEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'UserUpdateEvt -> WrapTypeable EventHandler)
-> EventHandler 'UserUpdateEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'UserUpdateEvt []
        , EventHandler 'InteractionEvt -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'InteractionEvt -> WrapTypeable EventHandler)
-> EventHandler 'InteractionEvt -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'InteractionEvt []
        , EventHandler ('CustomEvt Void) -> WrapTypeable EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler ('CustomEvt Void) -> WrapTypeable EventHandler)
-> EventHandler ('CustomEvt Void) -> WrapTypeable EventHandler
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @('CustomEvt Void) TypeRepMap CustomEHTypeStorage
EHStorageType ('CustomEvt Void)
(Semigroup (EHStorageType ('CustomEvt Void)),
 Monoid (EHStorageType ('CustomEvt Void))) =>
EHStorageType ('CustomEvt Void)
forall {k} (f :: k -> *). TypeRepMap f
TM.empty
        ]

instance Semigroup EventHandlers where
  (EventHandlers TypeRepMap EventHandler
a) <> :: EventHandlers -> EventHandlers -> EventHandlers
<> (EventHandlers TypeRepMap EventHandler
b) = TypeRepMap EventHandler -> EventHandlers
EventHandlers (TypeRepMap EventHandler -> EventHandlers)
-> TypeRepMap EventHandler -> EventHandlers
forall a b. (a -> b) -> a -> b
$ (forall (x :: EventType).
 Typeable x =>
 EventHandler x -> EventHandler x -> EventHandler x)
-> TypeRepMap EventHandler
-> TypeRepMap EventHandler
-> TypeRepMap EventHandler
forall {k} (f :: k -> *).
(forall (x :: k). Typeable x => f x -> f x -> f x)
-> TypeRepMap f -> TypeRepMap f -> TypeRepMap f
TM.unionWith EventHandler x -> EventHandler x -> EventHandler x
forall a. Semigroup a => a -> a -> a
forall (x :: EventType).
Typeable x =>
EventHandler x -> EventHandler x -> EventHandler x
(<>) TypeRepMap EventHandler
a TypeRepMap EventHandler
b

instance Monoid EventHandlers where
  mempty :: EventHandlers
mempty = EventHandlers
forall a. Default a => a
def

-- not sure what to think of this

type family EHInstanceSelector (d :: EventType) :: Bool where
  EHInstanceSelector ('CustomEvt _) = 'True
  EHInstanceSelector _ = 'False

{- | A helper typeclass that is used to decide how to register regular
 events, and custom events which require storing in a map at runtime.
-}
class InsertEventHandler (a :: EventType) where
  makeEventHandlers :: Proxy a -> Integer -> StoredEHType a -> EventHandlers

instance (EHInstanceSelector a ~ flag, InsertEventHandler' flag a) => InsertEventHandler a where
  makeEventHandlers :: Proxy a -> Integer -> StoredEHType a -> EventHandlers
makeEventHandlers = Proxy flag -> Proxy a -> Integer -> StoredEHType a -> EventHandlers
forall (flag :: Bool) (a :: EventType).
InsertEventHandler' flag a =>
Proxy flag -> Proxy a -> Integer -> StoredEHType a -> EventHandlers
makeEventHandlers' (forall (t :: Bool). Proxy t
forall {k} (t :: k). Proxy t
Proxy @flag)

class InsertEventHandler' (flag :: Bool) a where
  makeEventHandlers' :: Proxy flag -> Proxy a -> Integer -> StoredEHType a -> EventHandlers

instance forall (x :: Type). (Typeable (EHType ('CustomEvt x))) => InsertEventHandler' 'True ('CustomEvt x) where
  makeEventHandlers' :: Proxy 'True
-> Proxy ('CustomEvt x)
-> Integer
-> StoredEHType ('CustomEvt x)
-> EventHandlers
makeEventHandlers' Proxy 'True
_ Proxy ('CustomEvt x)
_ Integer
id' StoredEHType ('CustomEvt x)
handler =
    TypeRepMap EventHandler -> EventHandlers
EventHandlers (TypeRepMap EventHandler -> EventHandlers)
-> (EventHandler ('CustomEvt Void) -> TypeRepMap EventHandler)
-> EventHandler ('CustomEvt Void)
-> EventHandlers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventHandler ('CustomEvt Void) -> TypeRepMap EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> TypeRepMap f
TM.one (EventHandler ('CustomEvt Void) -> EventHandlers)
-> EventHandler ('CustomEvt Void) -> EventHandlers
forall a b. (a -> b) -> a -> b
$
      forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @('CustomEvt Void)
        (forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> TypeRepMap f
forall a (f :: * -> *). Typeable a => f a -> TypeRepMap f
TM.one @x (CustomEHTypeStorage x -> TypeRepMap CustomEHTypeStorage)
-> CustomEHTypeStorage x -> TypeRepMap CustomEHTypeStorage
forall a b. (a -> b) -> a -> b
$ [EventHandlerWithID (x -> IO ())] -> CustomEHTypeStorage x
forall a.
[EventHandlerWithID (a -> IO ())] -> CustomEHTypeStorage a
CustomEHTypeStorage [Integer -> (x -> IO ()) -> EventHandlerWithID (x -> IO ())
forall a. Integer -> a -> EventHandlerWithID a
EventHandlerWithID Integer
id' x -> IO ()
StoredEHType ('CustomEvt x)
handler])

instance (Typeable s, EHStorageType s ~ [EventHandlerWithID (StoredEHType s)], Typeable (StoredEHType s)) => InsertEventHandler' 'False s where
  makeEventHandlers' :: Proxy 'False
-> Proxy s -> Integer -> StoredEHType s -> EventHandlers
makeEventHandlers' Proxy 'False
_ Proxy s
_ Integer
id' StoredEHType s
handler = TypeRepMap EventHandler -> EventHandlers
EventHandlers (TypeRepMap EventHandler -> EventHandlers)
-> (EventHandler s -> TypeRepMap EventHandler)
-> EventHandler s
-> EventHandlers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventHandler s -> TypeRepMap EventHandler
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
f a -> TypeRepMap f
TM.one (EventHandler s -> EventHandlers)
-> EventHandler s -> EventHandlers
forall a b. (a -> b) -> a -> b
$ forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @s [Integer -> StoredEHType s -> EventHandlerWithID (StoredEHType s)
forall a. Integer -> a -> EventHandlerWithID a
EventHandlerWithID Integer
id' StoredEHType s
handler]

class GetEventHandlers a where
  getEventHandlers :: EventHandlers -> [StoredEHType a]

instance (EHInstanceSelector a ~ flag, GetEventHandlers' flag a) => GetEventHandlers a where
  getEventHandlers :: EventHandlers -> [StoredEHType a]
getEventHandlers = Proxy a -> Proxy flag -> EventHandlers -> [StoredEHType a]
forall (flag :: Bool) (a :: EventType).
GetEventHandlers' flag a =>
Proxy a -> Proxy flag -> EventHandlers -> [StoredEHType a]
getEventHandlers' (forall {k} (t :: k). Proxy t
forall (t :: EventType). Proxy t
Proxy @a) (forall (t :: Bool). Proxy t
forall {k} (t :: k). Proxy t
Proxy @flag)

class GetEventHandlers' (flag :: Bool) a where
  getEventHandlers' :: Proxy a -> Proxy flag -> EventHandlers -> [StoredEHType a]

instance GetEventHandlers' 'True ('CustomEvt a) where
  getEventHandlers' :: Proxy ('CustomEvt a)
-> Proxy 'True -> EventHandlers -> [StoredEHType ('CustomEvt a)]
getEventHandlers' Proxy ('CustomEvt a)
_ Proxy 'True
_ EventHandlers
_ = String -> [StoredEHType ('CustomEvt a)]
forall a. HasCallStack => String -> a
error String
"use getCustomEventHandlers instead"

instance (Typeable s, Typeable (StoredEHType s), EHStorageType s ~ [EventHandlerWithID (StoredEHType s)]) => GetEventHandlers' 'False s where
  getEventHandlers' :: Proxy s -> Proxy 'False -> EventHandlers -> [StoredEHType s]
getEventHandlers' Proxy s
_ Proxy 'False
_ (EventHandlers TypeRepMap EventHandler
handlers) =
    let theseHandlers :: EHStorageType s
theseHandlers = forall (t :: EventType).
EventHandler t
-> (Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
   EHStorageType t
unwrapEventHandler @s (EventHandler s
 -> (Semigroup (EHStorageType s), Monoid (EHStorageType s)) =>
    EHStorageType s)
-> EventHandler s
-> (Semigroup (EHStorageType s), Monoid (EHStorageType s)) =>
   EHStorageType s
forall a b. (a -> b) -> a -> b
$ EventHandler s -> Maybe (EventHandler s) -> EventHandler s
forall a. a -> Maybe a -> a
fromMaybe EventHandler s
forall a. Monoid a => a
mempty (TypeRepMap EventHandler -> Maybe (EventHandler s)
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
TypeRepMap f -> Maybe (f a)
TM.lookup TypeRepMap EventHandler
handlers :: Maybe (EventHandler s))
     in (EventHandlerWithID (StoredEHType s) -> StoredEHType s)
-> [EventHandlerWithID (StoredEHType s)] -> [StoredEHType s]
forall a b. (a -> b) -> [a] -> [b]
map EventHandlerWithID (StoredEHType s) -> StoredEHType s
forall a. EventHandlerWithID a -> a
eh [EventHandlerWithID (StoredEHType s)]
EHStorageType s
theseHandlers

class RemoveEventHandler a where
  removeEventHandler :: Proxy a -> Integer -> EventHandlers -> EventHandlers

instance (EHInstanceSelector a ~ flag, RemoveEventHandler' flag a) => RemoveEventHandler a where
  removeEventHandler :: Proxy a -> Integer -> EventHandlers -> EventHandlers
removeEventHandler = Proxy flag -> Proxy a -> Integer -> EventHandlers -> EventHandlers
forall {k} (flag :: Bool) (a :: k).
RemoveEventHandler' flag a =>
Proxy flag -> Proxy a -> Integer -> EventHandlers -> EventHandlers
removeEventHandler' (forall (t :: Bool). Proxy t
forall {k} (t :: k). Proxy t
Proxy @flag)

class RemoveEventHandler' (flag :: Bool) a where
  removeEventHandler' :: Proxy flag -> Proxy a -> Integer -> EventHandlers -> EventHandlers

instance forall (a :: Type). (Typeable a) => RemoveEventHandler' 'True ('CustomEvt a) where
  removeEventHandler' :: Proxy 'True
-> Proxy ('CustomEvt a)
-> Integer
-> EventHandlers
-> EventHandlers
removeEventHandler' Proxy 'True
_ Proxy ('CustomEvt a)
_ Integer
id' (EventHandlers TypeRepMap EventHandler
handlers) =
    TypeRepMap EventHandler -> EventHandlers
EventHandlers (TypeRepMap EventHandler -> EventHandlers)
-> TypeRepMap EventHandler -> EventHandlers
forall a b. (a -> b) -> a -> b
$
      forall {k} (a :: k) (f :: k -> *).
Typeable a =>
(f a -> f a) -> TypeRepMap f -> TypeRepMap f
forall (a :: EventType) (f :: EventType -> *).
Typeable a =>
(f a -> f a) -> TypeRepMap f -> TypeRepMap f
TM.adjust @('CustomEvt Void)
        ( \(EH (Semigroup (EHStorageType ('CustomEvt Void)),
 Monoid (EHStorageType ('CustomEvt Void))) =>
EHStorageType ('CustomEvt Void)
ehs) ->
            ((Semigroup (EHStorageType ('CustomEvt Void)),
  Monoid (EHStorageType ('CustomEvt Void))) =>
 EHStorageType ('CustomEvt Void))
-> EventHandler ('CustomEvt Void)
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH
              ( forall {k} (a :: k) (f :: k -> *).
Typeable a =>
(f a -> f a) -> TypeRepMap f -> TypeRepMap f
forall a (f :: * -> *).
Typeable a =>
(f a -> f a) -> TypeRepMap f -> TypeRepMap f
TM.adjust @a
                  ([EventHandlerWithID (a -> IO ())] -> CustomEHTypeStorage a
forall a.
[EventHandlerWithID (a -> IO ())] -> CustomEHTypeStorage a
CustomEHTypeStorage ([EventHandlerWithID (a -> IO ())] -> CustomEHTypeStorage a)
-> (CustomEHTypeStorage a -> [EventHandlerWithID (a -> IO ())])
-> CustomEHTypeStorage a
-> CustomEHTypeStorage a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventHandlerWithID (a -> IO ()) -> Bool)
-> [EventHandlerWithID (a -> IO ())]
-> [EventHandlerWithID (a -> IO ())]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
id') (Integer -> Bool)
-> (EventHandlerWithID (a -> IO ()) -> Integer)
-> EventHandlerWithID (a -> IO ())
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventHandlerWithID (a -> IO ()) -> Integer
forall a. EventHandlerWithID a -> Integer
ehID) ([EventHandlerWithID (a -> IO ())]
 -> [EventHandlerWithID (a -> IO ())])
-> (CustomEHTypeStorage a -> [EventHandlerWithID (a -> IO ())])
-> CustomEHTypeStorage a
-> [EventHandlerWithID (a -> IO ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomEHTypeStorage a -> [EventHandlerWithID (a -> IO ())]
forall a.
CustomEHTypeStorage a -> [EventHandlerWithID (a -> IO ())]
unwrapCustomEHTypeStorage)
                  TypeRepMap CustomEHTypeStorage
EHStorageType ('CustomEvt Void)
(Semigroup (EHStorageType ('CustomEvt Void)),
 Monoid (EHStorageType ('CustomEvt Void))) =>
EHStorageType ('CustomEvt Void)
ehs
              )
        )
        TypeRepMap EventHandler
handlers

instance
  (Typeable s, Typeable (StoredEHType s), EHStorageType s ~ [EventHandlerWithID (StoredEHType s)]) =>
  RemoveEventHandler' 'False s
  where
  removeEventHandler' :: Proxy 'False
-> Proxy s -> Integer -> EventHandlers -> EventHandlers
removeEventHandler' Proxy 'False
_ Proxy s
_ Integer
id' (EventHandlers TypeRepMap EventHandler
handlers) =
    TypeRepMap EventHandler -> EventHandlers
EventHandlers (TypeRepMap EventHandler -> EventHandlers)
-> TypeRepMap EventHandler -> EventHandlers
forall a b. (a -> b) -> a -> b
$
      forall {k} (a :: k) (f :: k -> *).
Typeable a =>
(f a -> f a) -> TypeRepMap f -> TypeRepMap f
forall (a :: EventType) (f :: EventType -> *).
Typeable a =>
(f a -> f a) -> TypeRepMap f -> TypeRepMap f
TM.adjust @s
        (\(EH (Semigroup (EHStorageType s), Monoid (EHStorageType s)) =>
EHStorageType s
ehs) -> ((Semigroup (EHStorageType s), Monoid (EHStorageType s)) =>
 EHStorageType s)
-> EventHandler s
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH (((Semigroup (EHStorageType s), Monoid (EHStorageType s)) =>
  EHStorageType s)
 -> EventHandler s)
-> ((Semigroup (EHStorageType s), Monoid (EHStorageType s)) =>
    EHStorageType s)
-> EventHandler s
forall a b. (a -> b) -> a -> b
$ (EventHandlerWithID (StoredEHType s) -> Bool)
-> [EventHandlerWithID (StoredEHType s)]
-> [EventHandlerWithID (StoredEHType s)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
id') (Integer -> Bool)
-> (EventHandlerWithID (StoredEHType s) -> Integer)
-> EventHandlerWithID (StoredEHType s)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventHandlerWithID (StoredEHType s) -> Integer
forall a. EventHandlerWithID a -> Integer
ehID) [EventHandlerWithID (StoredEHType s)]
EHStorageType s
(Semigroup (EHStorageType s), Monoid (EHStorageType s)) =>
EHStorageType s
ehs)
        TypeRepMap EventHandler
handlers

getCustomEventHandlers :: forall a. Typeable a => EventHandlers -> [a -> IO ()]
getCustomEventHandlers :: forall a. Typeable a => EventHandlers -> [a -> IO ()]
getCustomEventHandlers (EventHandlers TypeRepMap EventHandler
handlers) =
  let handlerMap :: EHStorageType ('CustomEvt Void)
handlerMap =
        forall (t :: EventType).
EventHandler t
-> (Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
   EHStorageType t
unwrapEventHandler @('CustomEvt Void) (EventHandler ('CustomEvt Void)
 -> (Semigroup (EHStorageType ('CustomEvt Void)),
     Monoid (EHStorageType ('CustomEvt Void))) =>
    EHStorageType ('CustomEvt Void))
-> EventHandler ('CustomEvt Void)
-> (Semigroup (EHStorageType ('CustomEvt Void)),
    Monoid (EHStorageType ('CustomEvt Void))) =>
   EHStorageType ('CustomEvt Void)
forall a b. (a -> b) -> a -> b
$
          EventHandler ('CustomEvt Void)
-> Maybe (EventHandler ('CustomEvt Void))
-> EventHandler ('CustomEvt Void)
forall a. a -> Maybe a -> a
fromMaybe EventHandler ('CustomEvt Void)
forall a. Monoid a => a
mempty (TypeRepMap EventHandler -> Maybe (EventHandler ('CustomEvt Void))
forall {k} (a :: k) (f :: k -> *).
Typeable a =>
TypeRepMap f -> Maybe (f a)
TM.lookup TypeRepMap EventHandler
handlers :: Maybe (EventHandler ('CustomEvt Void)))
   in [a -> IO ()]
-> (CustomEHTypeStorage a -> [a -> IO ()])
-> Maybe (CustomEHTypeStorage a)
-> [a -> IO ()]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a -> IO ()]
forall a. Monoid a => a
mempty ((EventHandlerWithID (a -> IO ()) -> a -> IO ())
-> [EventHandlerWithID (a -> IO ())] -> [a -> IO ()]
forall a b. (a -> b) -> [a] -> [b]
map EventHandlerWithID (a -> IO ()) -> a -> IO ()
forall a. EventHandlerWithID a -> a
eh ([EventHandlerWithID (a -> IO ())] -> [a -> IO ()])
-> (CustomEHTypeStorage a -> [EventHandlerWithID (a -> IO ())])
-> CustomEHTypeStorage a
-> [a -> IO ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomEHTypeStorage a -> [EventHandlerWithID (a -> IO ())]
forall a.
CustomEHTypeStorage a -> [EventHandlerWithID (a -> IO ())]
unwrapCustomEHTypeStorage) (Maybe (CustomEHTypeStorage a) -> [a -> IO ()])
-> Maybe (CustomEHTypeStorage a) -> [a -> IO ()]
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k) (f :: k -> *).
Typeable a =>
TypeRepMap f -> Maybe (f a)
forall a (f :: * -> *). Typeable a => TypeRepMap f -> Maybe (f a)
TM.lookup @a TypeRepMap CustomEHTypeStorage
EHStorageType ('CustomEvt Void)
handlerMap

$(makeFieldLabelsNoPrefix ''Client)