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

import           Calamity.Cache.Eff
import           Calamity.Gateway.DispatchEvents ( CalamityEvent(..), 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
import           Calamity.Types.Model.Guild
import           Calamity.Types.Model.User
import           Calamity.Types.Token
import           Calamity.Types.UnixTimestamp

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 qualified Data.HashMap.Lazy               as LH
import           Data.IORef
import           Data.Maybe
import           Data.Time
import qualified Data.TypeRepMap                 as TM
import           Data.TypeRepMap                 ( TypeRepMap, WrapTypeable(..) )
import           Data.Typeable
import           Data.Void

import           GHC.Exts                        ( fromList )
import           GHC.Generics

import qualified Polysemy                        as P
import qualified Polysemy.Async                  as P
import qualified Polysemy.AtomicState            as P
import qualified Polysemy.Reader                 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
  }
  deriving ( (forall x. Client -> Rep Client x)
-> (forall x. Rep Client x -> Client) -> Generic Client
forall x. Rep Client x -> Client
forall x. Client -> Rep Client x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Client x -> Client
$cfrom :: forall x. Client -> Rep Client x
Generic )

type BotC r =
  ( P.Members '[LogEff, MetricEff, CacheEff, P.Reader Client,
  P.AtomicState EventHandlers, P.Embed IO, P.Final IO, P.Async] r
  , Typeable r)

-- | A concrete effect stack used inside the bot
type SetupEff r = (LogEff ': 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 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 =
  ( 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 ( 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
showList :: [StartupError] -> ShowS
$cshowList :: [StartupError] -> ShowS
show :: StartupError -> String
$cshow :: StartupError -> String
showsPrec :: Int -> StartupError -> ShowS
$cshowsPrec :: Int -> 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
  | MessageCreateEvt
  | MessageUpdateEvt
  | MessageDeleteEvt
  | MessageDeleteBulkEvt
  | MessageReactionAddEvt
  | MessageReactionRemoveEvt
  | MessageReactionRemoveAllEvt
  | TypingStartEvt
  | UserUpdateEvt
  | forall s a. CustomEvt s a
  -- ^ A custom event, @s@ is the name and @a@ is the data sent to the handler

-- | 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     -> Bool                           -> m r
  EHType 'GuildUpdateEvt              m r = Guild     -> Guild                          -> m r
  EHType 'GuildDeleteEvt              m r = Guild     -> Bool                           -> 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 '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   -> Maybe Member  -> UnixTimestamp -> m r
  EHType 'UserUpdateEvt               m r = User      -> User                           -> m r
  EHType ('CustomEvt s a)             m r = a                                           -> m r

type StoredEHType t = EHType t IO ()

newtype EventHandlers = EventHandlers (TypeRepMap EventHandler)

data EventHandlerWithID a = EventHandlerWithID
  { EventHandlerWithID a -> Integer
ehID :: Integer
  , EventHandlerWithID a -> a
eh   :: a
  }

type family EHStorageType (t :: EventType) where
  EHStorageType ('CustomEvt s a) = LH.HashMap TypeRep (LH.HashMap TypeRep [EventHandlerWithID (StoredEHType ('CustomEvt s a))])
  EHStorageType t                = [EventHandlerWithID (StoredEHType t)]

newtype EventHandler (t :: EventType) = EH
  { 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 a :: (Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
EHStorageType t
a <> :: EventHandler t -> EventHandler t -> EventHandler t
<> EH b :: (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 (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 -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'ReadyEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'ReadyEvt -> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'ReadyEvt),
  Monoid (EHStorageType 'ReadyEvt)) =>
 EHStorageType 'ReadyEvt)
-> EventHandler 'ReadyEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'ReadyEvt []
                                 , EventHandler 'ChannelCreateEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'ChannelCreateEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'ChannelCreateEvt -> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'ChannelCreateEvt),
  Monoid (EHStorageType 'ChannelCreateEvt)) =>
 EHStorageType 'ChannelCreateEvt)
-> EventHandler 'ChannelCreateEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'ChannelCreateEvt []
                                 , EventHandler 'ChannelUpdateEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'ChannelUpdateEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'ChannelUpdateEvt -> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'ChannelUpdateEvt),
  Monoid (EHStorageType 'ChannelUpdateEvt)) =>
 EHStorageType 'ChannelUpdateEvt)
-> EventHandler 'ChannelUpdateEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'ChannelUpdateEvt []
                                 , EventHandler 'ChannelDeleteEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'ChannelDeleteEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'ChannelDeleteEvt -> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'ChannelDeleteEvt),
  Monoid (EHStorageType 'ChannelDeleteEvt)) =>
 EHStorageType 'ChannelDeleteEvt)
-> EventHandler 'ChannelDeleteEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'ChannelDeleteEvt []
                                 , EventHandler 'ChannelpinsUpdateEvt
-> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'ChannelpinsUpdateEvt
 -> Item (TypeRepMap EventHandler))
-> EventHandler 'ChannelpinsUpdateEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'ChannelpinsUpdateEvt),
  Monoid (EHStorageType 'ChannelpinsUpdateEvt)) =>
 EHStorageType 'ChannelpinsUpdateEvt)
-> EventHandler 'ChannelpinsUpdateEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'ChannelpinsUpdateEvt []
                                 , EventHandler 'GuildCreateEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildCreateEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildCreateEvt -> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildCreateEvt),
  Monoid (EHStorageType 'GuildCreateEvt)) =>
 EHStorageType 'GuildCreateEvt)
-> EventHandler 'GuildCreateEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildCreateEvt []
                                 , EventHandler 'GuildUpdateEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildUpdateEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildUpdateEvt -> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildUpdateEvt),
  Monoid (EHStorageType 'GuildUpdateEvt)) =>
 EHStorageType 'GuildUpdateEvt)
-> EventHandler 'GuildUpdateEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildUpdateEvt []
                                 , EventHandler 'GuildDeleteEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildDeleteEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildDeleteEvt -> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildDeleteEvt),
  Monoid (EHStorageType 'GuildDeleteEvt)) =>
 EHStorageType 'GuildDeleteEvt)
-> EventHandler 'GuildDeleteEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildDeleteEvt []
                                 , EventHandler 'GuildBanAddEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildBanAddEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildBanAddEvt -> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildBanAddEvt),
  Monoid (EHStorageType 'GuildBanAddEvt)) =>
 EHStorageType 'GuildBanAddEvt)
-> EventHandler 'GuildBanAddEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildBanAddEvt []
                                 , EventHandler 'GuildBanRemoveEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildBanRemoveEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildBanRemoveEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildBanRemoveEvt),
  Monoid (EHStorageType 'GuildBanRemoveEvt)) =>
 EHStorageType 'GuildBanRemoveEvt)
-> EventHandler 'GuildBanRemoveEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildBanRemoveEvt []
                                 , EventHandler 'GuildEmojisUpdateEvt
-> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildEmojisUpdateEvt
 -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildEmojisUpdateEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildEmojisUpdateEvt),
  Monoid (EHStorageType 'GuildEmojisUpdateEvt)) =>
 EHStorageType 'GuildEmojisUpdateEvt)
-> EventHandler 'GuildEmojisUpdateEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildEmojisUpdateEvt []
                                 , EventHandler 'GuildIntegrationsUpdateEvt
-> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildIntegrationsUpdateEvt
 -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildIntegrationsUpdateEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildIntegrationsUpdateEvt),
  Monoid (EHStorageType 'GuildIntegrationsUpdateEvt)) =>
 EHStorageType 'GuildIntegrationsUpdateEvt)
-> EventHandler 'GuildIntegrationsUpdateEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildIntegrationsUpdateEvt []
                                 , EventHandler 'GuildMemberAddEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildMemberAddEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildMemberAddEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildMemberAddEvt),
  Monoid (EHStorageType 'GuildMemberAddEvt)) =>
 EHStorageType 'GuildMemberAddEvt)
-> EventHandler 'GuildMemberAddEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildMemberAddEvt []
                                 , EventHandler 'GuildMemberRemoveEvt
-> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildMemberRemoveEvt
 -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildMemberRemoveEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildMemberRemoveEvt),
  Monoid (EHStorageType 'GuildMemberRemoveEvt)) =>
 EHStorageType 'GuildMemberRemoveEvt)
-> EventHandler 'GuildMemberRemoveEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildMemberRemoveEvt []
                                 , EventHandler 'GuildMemberUpdateEvt
-> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildMemberUpdateEvt
 -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildMemberUpdateEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildMemberUpdateEvt),
  Monoid (EHStorageType 'GuildMemberUpdateEvt)) =>
 EHStorageType 'GuildMemberUpdateEvt)
-> EventHandler 'GuildMemberUpdateEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildMemberUpdateEvt []
                                 , EventHandler 'GuildMembersChunkEvt
-> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildMembersChunkEvt
 -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildMembersChunkEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildMembersChunkEvt),
  Monoid (EHStorageType 'GuildMembersChunkEvt)) =>
 EHStorageType 'GuildMembersChunkEvt)
-> EventHandler 'GuildMembersChunkEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildMembersChunkEvt []
                                 , EventHandler 'GuildRoleCreateEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildRoleCreateEvt
 -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildRoleCreateEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildRoleCreateEvt),
  Monoid (EHStorageType 'GuildRoleCreateEvt)) =>
 EHStorageType 'GuildRoleCreateEvt)
-> EventHandler 'GuildRoleCreateEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildRoleCreateEvt []
                                 , EventHandler 'GuildRoleUpdateEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildRoleUpdateEvt
 -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildRoleUpdateEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildRoleUpdateEvt),
  Monoid (EHStorageType 'GuildRoleUpdateEvt)) =>
 EHStorageType 'GuildRoleUpdateEvt)
-> EventHandler 'GuildRoleUpdateEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildRoleUpdateEvt []
                                 , EventHandler 'GuildRoleDeleteEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'GuildRoleDeleteEvt
 -> Item (TypeRepMap EventHandler))
-> EventHandler 'GuildRoleDeleteEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'GuildRoleDeleteEvt),
  Monoid (EHStorageType 'GuildRoleDeleteEvt)) =>
 EHStorageType 'GuildRoleDeleteEvt)
-> EventHandler 'GuildRoleDeleteEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'GuildRoleDeleteEvt []
                                 , EventHandler 'MessageCreateEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageCreateEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'MessageCreateEvt -> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'MessageCreateEvt),
  Monoid (EHStorageType 'MessageCreateEvt)) =>
 EHStorageType 'MessageCreateEvt)
-> EventHandler 'MessageCreateEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageCreateEvt []
                                 , EventHandler 'MessageUpdateEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageUpdateEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'MessageUpdateEvt -> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'MessageUpdateEvt),
  Monoid (EHStorageType 'MessageUpdateEvt)) =>
 EHStorageType 'MessageUpdateEvt)
-> EventHandler 'MessageUpdateEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageUpdateEvt []
                                 , EventHandler 'MessageDeleteEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageDeleteEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'MessageDeleteEvt -> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'MessageDeleteEvt),
  Monoid (EHStorageType 'MessageDeleteEvt)) =>
 EHStorageType 'MessageDeleteEvt)
-> EventHandler 'MessageDeleteEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageDeleteEvt []
                                 , EventHandler 'MessageDeleteBulkEvt
-> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageDeleteBulkEvt
 -> Item (TypeRepMap EventHandler))
-> EventHandler 'MessageDeleteBulkEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'MessageDeleteBulkEvt),
  Monoid (EHStorageType 'MessageDeleteBulkEvt)) =>
 EHStorageType 'MessageDeleteBulkEvt)
-> EventHandler 'MessageDeleteBulkEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageDeleteBulkEvt []
                                 , EventHandler 'MessageReactionAddEvt
-> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageReactionAddEvt
 -> Item (TypeRepMap EventHandler))
-> EventHandler 'MessageReactionAddEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'MessageReactionAddEvt),
  Monoid (EHStorageType 'MessageReactionAddEvt)) =>
 EHStorageType 'MessageReactionAddEvt)
-> EventHandler 'MessageReactionAddEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageReactionAddEvt []
                                 , EventHandler 'MessageReactionRemoveEvt
-> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageReactionRemoveEvt
 -> Item (TypeRepMap EventHandler))
-> EventHandler 'MessageReactionRemoveEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'MessageReactionRemoveEvt),
  Monoid (EHStorageType 'MessageReactionRemoveEvt)) =>
 EHStorageType 'MessageReactionRemoveEvt)
-> EventHandler 'MessageReactionRemoveEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageReactionRemoveEvt []
                                 , EventHandler 'MessageReactionRemoveAllEvt
-> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'MessageReactionRemoveAllEvt
 -> Item (TypeRepMap EventHandler))
-> EventHandler 'MessageReactionRemoveAllEvt
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'MessageReactionRemoveAllEvt),
  Monoid (EHStorageType 'MessageReactionRemoveAllEvt)) =>
 EHStorageType 'MessageReactionRemoveAllEvt)
-> EventHandler 'MessageReactionRemoveAllEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'MessageReactionRemoveAllEvt []
                                 , EventHandler 'TypingStartEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'TypingStartEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'TypingStartEvt -> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'TypingStartEvt),
  Monoid (EHStorageType 'TypingStartEvt)) =>
 EHStorageType 'TypingStartEvt)
-> EventHandler 'TypingStartEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'TypingStartEvt []
                                 , EventHandler 'UserUpdateEvt -> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler 'UserUpdateEvt -> Item (TypeRepMap EventHandler))
-> EventHandler 'UserUpdateEvt -> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType 'UserUpdateEvt),
  Monoid (EHStorageType 'UserUpdateEvt)) =>
 EHStorageType 'UserUpdateEvt)
-> EventHandler 'UserUpdateEvt
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @'UserUpdateEvt []
                                 , EventHandler ('CustomEvt Void Dynamic)
-> Item (TypeRepMap EventHandler)
forall k (a :: k) (f :: k -> *).
Typeable a =>
f a -> WrapTypeable f
WrapTypeable (EventHandler ('CustomEvt Void Dynamic)
 -> Item (TypeRepMap EventHandler))
-> EventHandler ('CustomEvt Void Dynamic)
-> Item (TypeRepMap EventHandler)
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType ('CustomEvt Void Dynamic)),
  Monoid (EHStorageType ('CustomEvt Void Dynamic))) =>
 EHStorageType ('CustomEvt Void Dynamic))
-> EventHandler ('CustomEvt Void Dynamic)
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @('CustomEvt Void Dynamic) (Semigroup (EHStorageType ('CustomEvt Void Dynamic)),
 Monoid (EHStorageType ('CustomEvt Void Dynamic))) =>
EHStorageType ('CustomEvt Void Dynamic)
forall k v. HashMap k v
LH.empty
                                 ]

instance Semigroup EventHandlers where
  (EventHandlers a :: TypeRepMap EventHandler
a) <> :: EventHandlers -> EventHandlers -> EventHandlers
<> (EventHandlers b :: 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 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


fromDynamicJust :: forall a. Typeable a => Dynamic -> a
fromDynamicJust :: Dynamic -> a
fromDynamicJust d :: Dynamic
d = case Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
d of
  Just x :: a
x -> a
x
  Nothing -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "Extracting dynamic failed, wanted: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> (Proxy a -> TypeRep) -> Proxy a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> String) -> Proxy a -> String
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ", got: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Dynamic -> TypeRep
dynTypeRep Dynamic
d)


-- | 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 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' (Proxy flag
forall k (t :: k). Proxy t
Proxy @flag)

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

intoDynFn :: forall a. Typeable a => (a -> IO ()) -> (Dynamic -> IO ())
intoDynFn :: (a -> IO ()) -> Dynamic -> IO ()
intoDynFn fn :: a -> IO ()
fn = \d :: Dynamic
d -> a -> IO ()
fn (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$ Dynamic -> a
forall a. Typeable a => Dynamic -> a
fromDynamicJust Dynamic
d

instance (Typeable a, Typeable s, Typeable (StoredEHType ('CustomEvt s a)), EHType ('CustomEvt s a) IO () ~ (a -> IO ()))
  => InsertEventHandler' 'True ('CustomEvt s a) where
  makeEventHandlers' :: Proxy 'True
-> Proxy ('CustomEvt s a)
-> Integer
-> StoredEHType ('CustomEvt s a)
-> EventHandlers
makeEventHandlers' _ _ id' :: Integer
id' handler :: StoredEHType ('CustomEvt s a)
handler = TypeRepMap EventHandler -> EventHandlers
EventHandlers (TypeRepMap EventHandler -> EventHandlers)
-> (EventHandler ('CustomEvt Void Dynamic)
    -> TypeRepMap EventHandler)
-> EventHandler ('CustomEvt Void Dynamic)
-> EventHandlers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventHandler ('CustomEvt Void Dynamic) -> TypeRepMap EventHandler
forall k (a :: k) (f :: k -> *). Typeable a => f a -> TypeRepMap f
TM.one (EventHandler ('CustomEvt Void Dynamic) -> EventHandlers)
-> EventHandler ('CustomEvt Void Dynamic) -> EventHandlers
forall a b. (a -> b) -> a -> b
$ ((Semigroup (EHStorageType ('CustomEvt Void Dynamic)),
  Monoid (EHStorageType ('CustomEvt Void Dynamic))) =>
 EHStorageType ('CustomEvt Void Dynamic))
-> EventHandler ('CustomEvt Void Dynamic)
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH @('CustomEvt Void Dynamic)
    (TypeRep
-> HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())]
-> HashMap
     TypeRep (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())])
forall k v. Hashable k => k -> v -> HashMap k v
LH.singleton (Proxy s -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy s -> TypeRep) -> Proxy s -> TypeRep
forall a b. (a -> b) -> a -> b
$ Proxy s
forall k (t :: k). Proxy t
Proxy @s) (TypeRep
-> [EventHandlerWithID (Dynamic -> IO ())]
-> HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())]
forall k v. Hashable k => k -> v -> HashMap k v
LH.singleton (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a) [Integer
-> (Dynamic -> IO ()) -> EventHandlerWithID (Dynamic -> IO ())
forall a. Integer -> a -> EventHandlerWithID a
EventHandlerWithID Integer
id' ((a -> IO ()) -> Dynamic -> IO ()
forall a. Typeable a => (a -> IO ()) -> Dynamic -> IO ()
intoDynFn StoredEHType ('CustomEvt s a)
a -> IO ()
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' _ _ id' :: Integer
id' handler :: 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
$ ((Semigroup (EHStorageType s), Monoid (EHStorageType s)) =>
 EHStorageType s)
-> EventHandler s
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' (Proxy a
forall k (t :: k). Proxy t
Proxy @a) (Proxy flag
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 s a) where
  getEventHandlers' :: Proxy ('CustomEvt s a)
-> Proxy 'True -> EventHandlers -> [StoredEHType ('CustomEvt s a)]
getEventHandlers' _ _ _ = String -> [StoredEHType ('CustomEvt s a)]
forall a. HasCallStack => String -> a
error "use getCustomEventHandlers instead"
    -- let handlerMap = unwrapEventHandler @('CustomEvt Void Dynamic) $ fromJust
    --       (TM.lookup handlers :: Maybe (EventHandler ('CustomEvt Void Dynamic)))
    -- in concat $ LH.lookup (typeRep $ Proxy @s) handlerMap >>= LH.lookup (typeRep $ Proxy @a) <&> map eh

instance (Typeable s, Typeable (StoredEHType s), EHStorageType s ~ [EventHandlerWithID (StoredEHType s)]) => GetEventHandlers' 'False s where
  getEventHandlers' :: Proxy s -> Proxy 'False -> EventHandlers -> [StoredEHType s]
getEventHandlers' _ _ (EventHandlers handlers :: TypeRepMap EventHandler
handlers) =
    let theseHandlers :: EHStorageType s
theseHandlers = EventHandler s
-> (Semigroup (EHStorageType s), Monoid (EHStorageType s)) =>
   EHStorageType s
forall (t :: EventType).
EventHandler t
-> (Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
   EHStorageType t
unwrapEventHandler @s (EventHandler s -> EHStorageType s)
-> EventHandler s -> EHStorageType s
forall a b. (a -> b) -> a -> b
$ Maybe (EventHandler s) -> EventHandler s
forall a. HasCallStack => Maybe a -> a
fromJust (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' (Proxy flag
forall k (t :: k). Proxy t
Proxy @flag)

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

instance (Typeable s, Typeable a) => RemoveEventHandler' 'True ('CustomEvt s a) where
  removeEventHandler' :: Proxy 'True
-> Proxy ('CustomEvt s a)
-> Integer
-> EventHandlers
-> EventHandlers
removeEventHandler' _ _ id' :: Integer
id' (EventHandlers handlers :: TypeRepMap EventHandler
handlers) = TypeRepMap EventHandler -> EventHandlers
EventHandlers (TypeRepMap EventHandler -> EventHandlers)
-> TypeRepMap EventHandler -> EventHandlers
forall a b. (a -> b) -> a -> b
$ (EventHandler ('CustomEvt Void Dynamic)
 -> EventHandler ('CustomEvt Void Dynamic))
-> TypeRepMap EventHandler -> TypeRepMap EventHandler
forall k (a :: k) (f :: k -> *).
Typeable a =>
(f a -> f a) -> TypeRepMap f -> TypeRepMap f
TM.adjust @('CustomEvt Void Dynamic)
    (\(EH ehs :: (Semigroup (EHStorageType ('CustomEvt Void Dynamic)),
 Monoid (EHStorageType ('CustomEvt Void Dynamic))) =>
EHStorageType ('CustomEvt Void Dynamic)
ehs) -> ((Semigroup (EHStorageType ('CustomEvt Void Dynamic)),
  Monoid (EHStorageType ('CustomEvt Void Dynamic))) =>
 EHStorageType ('CustomEvt Void Dynamic))
-> EventHandler ('CustomEvt Void Dynamic)
forall (t :: EventType).
((Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
 EHStorageType t)
-> EventHandler t
EH ((HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())]
 -> Maybe (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())]))
-> TypeRep
-> HashMap
     TypeRep (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())])
-> HashMap
     TypeRep (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())])
forall k a.
(Eq k, Hashable k) =>
(a -> Maybe a) -> k -> HashMap k a -> HashMap k a
LH.update (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())]
-> Maybe (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())])
forall a. a -> Maybe a
Just (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())]
 -> Maybe (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())]))
-> (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())]
    -> HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())])
-> HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())]
-> Maybe (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([EventHandlerWithID (Dynamic -> IO ())]
 -> Maybe [EventHandlerWithID (Dynamic -> IO ())])
-> TypeRep
-> HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())]
-> HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())]
forall k a.
(Eq k, Hashable k) =>
(a -> Maybe a) -> k -> HashMap k a -> HashMap k a
LH.update ([EventHandlerWithID (Dynamic -> IO ())]
-> Maybe [EventHandlerWithID (Dynamic -> IO ())]
forall a. a -> Maybe a
Just ([EventHandlerWithID (Dynamic -> IO ())]
 -> Maybe [EventHandlerWithID (Dynamic -> IO ())])
-> ([EventHandlerWithID (Dynamic -> IO ())]
    -> [EventHandlerWithID (Dynamic -> IO ())])
-> [EventHandlerWithID (Dynamic -> IO ())]
-> Maybe [EventHandlerWithID (Dynamic -> IO ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventHandlerWithID (Dynamic -> IO ()) -> Bool)
-> [EventHandlerWithID (Dynamic -> IO ())]
-> [EventHandlerWithID (Dynamic -> IO ())]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
id') (Integer -> Bool)
-> (EventHandlerWithID (Dynamic -> IO ()) -> Integer)
-> EventHandlerWithID (Dynamic -> IO ())
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventHandlerWithID (Dynamic -> IO ()) -> Integer
forall a. EventHandlerWithID a -> Integer
ehID)) (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a))
                      (Proxy s -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy s -> TypeRep) -> Proxy s -> TypeRep
forall a b. (a -> b) -> a -> b
$ Proxy s
forall k (t :: k). Proxy t
Proxy @s) HashMap
  TypeRep (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())])
(Semigroup (EHStorageType ('CustomEvt Void Dynamic)),
 Monoid (EHStorageType ('CustomEvt Void Dynamic))) =>
EHStorageType ('CustomEvt Void Dynamic)
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' _ _ id' :: Integer
id' (EventHandlers handlers :: TypeRepMap EventHandler
handlers) = TypeRepMap EventHandler -> EventHandlers
EventHandlers (TypeRepMap EventHandler -> EventHandlers)
-> TypeRepMap EventHandler -> EventHandlers
forall a b. (a -> b) -> a -> b
$ (EventHandler s -> EventHandler s)
-> TypeRepMap EventHandler -> TypeRepMap EventHandler
forall k (a :: k) (f :: k -> *).
Typeable a =>
(f a -> f a) -> TypeRepMap f -> TypeRepMap f
TM.adjust @s
    (\(EH ehs :: (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)]
(Semigroup (EHStorageType s), Monoid (EHStorageType s)) =>
EHStorageType s
ehs) TypeRepMap EventHandler
handlers


getCustomEventHandlers :: TypeRep -> TypeRep -> EventHandlers -> [Dynamic -> IO ()]
getCustomEventHandlers :: TypeRep -> TypeRep -> EventHandlers -> [Dynamic -> IO ()]
getCustomEventHandlers s :: TypeRep
s a :: TypeRep
a (EventHandlers handlers :: TypeRepMap EventHandler
handlers) =
    let handlerMap :: EHStorageType ('CustomEvt Void Dynamic)
handlerMap = EventHandler ('CustomEvt Void Dynamic)
-> (Semigroup (EHStorageType ('CustomEvt Void Dynamic)),
    Monoid (EHStorageType ('CustomEvt Void Dynamic))) =>
   EHStorageType ('CustomEvt Void Dynamic)
forall (t :: EventType).
EventHandler t
-> (Semigroup (EHStorageType t), Monoid (EHStorageType t)) =>
   EHStorageType t
unwrapEventHandler @('CustomEvt Void Dynamic) (EventHandler ('CustomEvt Void Dynamic)
 -> EHStorageType ('CustomEvt Void Dynamic))
-> EventHandler ('CustomEvt Void Dynamic)
-> EHStorageType ('CustomEvt Void Dynamic)
forall a b. (a -> b) -> a -> b
$ Maybe (EventHandler ('CustomEvt Void Dynamic))
-> EventHandler ('CustomEvt Void Dynamic)
forall a. HasCallStack => Maybe a -> a
fromJust
          (TypeRepMap EventHandler
-> Maybe (EventHandler ('CustomEvt Void Dynamic))
forall k (a :: k) (f :: k -> *).
Typeable a =>
TypeRepMap f -> Maybe (f a)
TM.lookup TypeRepMap EventHandler
handlers :: Maybe (EventHandler ('CustomEvt Void Dynamic)))
    in (EventHandlerWithID (Dynamic -> IO ()) -> Dynamic -> IO ())
-> [EventHandlerWithID (Dynamic -> IO ())] -> [Dynamic -> IO ()]
forall a b. (a -> b) -> [a] -> [b]
map EventHandlerWithID (Dynamic -> IO ()) -> Dynamic -> IO ()
forall a. EventHandlerWithID a -> a
eh ([EventHandlerWithID (Dynamic -> IO ())] -> [Dynamic -> IO ()])
-> (Maybe [EventHandlerWithID (Dynamic -> IO ())]
    -> [EventHandlerWithID (Dynamic -> IO ())])
-> Maybe [EventHandlerWithID (Dynamic -> IO ())]
-> [Dynamic -> IO ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [EventHandlerWithID (Dynamic -> IO ())]
-> [EventHandlerWithID (Dynamic -> IO ())]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Maybe [EventHandlerWithID (Dynamic -> IO ())]
 -> [Dynamic -> IO ()])
-> Maybe [EventHandlerWithID (Dynamic -> IO ())]
-> [Dynamic -> IO ()]
forall a b. (a -> b) -> a -> b
$ TypeRep
-> HashMap
     TypeRep (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())])
-> Maybe (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())])
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup TypeRep
s HashMap
  TypeRep (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())])
EHStorageType ('CustomEvt Void Dynamic)
handlerMap Maybe (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())])
-> (HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())]
    -> Maybe [EventHandlerWithID (Dynamic -> IO ())])
-> Maybe [EventHandlerWithID (Dynamic -> IO ())]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeRep
-> HashMap TypeRep [EventHandlerWithID (Dynamic -> IO ())]
-> Maybe [EventHandlerWithID (Dynamic -> IO ())]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup TypeRep
a