{-# OPTIONS_GHC -Wno-name-shadowing #-}

-- | The client
module Calamity.Client.Client (
  react,
  runBotIO,
  runBotIO',
  runBotIO'',
  stopBot,
  sendPresence,
  events,
  fire,
  waitUntil,
  waitUntilM,
  CalamityEvent (Dispatch, ShutDown),
  customEvt,
) where

import Calamity.Cache.Eff
import Calamity.Client.ShardManager
import Calamity.Client.Types
import Calamity.Gateway.DispatchEvents
import Calamity.Gateway.Intents
import Calamity.Gateway.Types
import Calamity.HTTP.Internal.Ratelimit
import Calamity.Internal.ConstructorName
import Calamity.Internal.RunIntoIO
import qualified Calamity.Internal.SnowflakeMap as SM
import Calamity.Internal.UnixTimestamp
import Calamity.Internal.Updateable
import Calamity.Internal.Utils
import Calamity.Metrics.Eff
import Calamity.Types.LogEff
import Calamity.Types.Model.Channel
import Calamity.Types.Model.Guild
import Calamity.Types.Model.Presence (Presence (..))
import Calamity.Types.Model.User
import qualified Calamity.Types.Model.Voice as V
import Calamity.Types.Snowflake
import Calamity.Types.Token
import Calamity.Types.TokenEff
import Control.Concurrent.Chan.Unagi
import Control.Concurrent.MVar
import Control.Concurrent.STM
import Control.Exception (SomeException)
import Control.Monad
import Data.Default.Class
import Data.Dynamic
import Data.Foldable
import Data.IORef
import Data.Maybe
import Data.Proxy
import qualified Data.Text as T
import Data.Time.Clock.POSIX
import qualified Df1
import qualified Di.Core as DC
import qualified DiPolysemy as Di
import Optics
import qualified Polysemy as P
import qualified Polysemy.Async as P
import qualified Polysemy.AtomicState as P
import qualified Polysemy.Error as P
import qualified Polysemy.Fail as P
import qualified Polysemy.Reader as P
import qualified Polysemy.Resource as P
import PyF
import TextShow (TextShow (showt))

timeA :: P.Member (P.Embed IO) r => P.Sem r a -> P.Sem r (Double, a)
timeA :: forall (r :: EffectRow) (a :: OpticKind).
Member (Embed IO) r =>
Sem r a -> Sem r (Double, a)
timeA Sem r a
m = do
  POSIXTime
start <- forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed IO POSIXTime
getPOSIXTime
  a
res <- Sem r a
m
  POSIXTime
end <- forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed IO POSIXTime
getPOSIXTime
  let duration :: Double
duration = forall (a :: OpticKind). Fractional a => Rational -> a
fromRational forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). Real a => a -> Rational
toRational forall (a :: OpticKind) b. (a -> b) -> a -> b
$ POSIXTime
end forall (a :: OpticKind). Num a => a -> a -> a
- POSIXTime
start
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Double
duration, a
res)

newClient :: Token -> Maybe (DC.Di Df1.Level Df1.Path Df1.Message) -> IO Client
newClient :: Token -> Maybe (Di Level Path Message) -> IO Client
newClient Token
token Maybe (Di Level Path Message)
initialDi = do
  TVar [(InChan ControlMessage, Async (Maybe ()))]
shards' <- forall (a :: OpticKind). a -> IO (TVar a)
newTVarIO []
  MVar Int
numShards' <- forall (a :: OpticKind). IO (MVar a)
newEmptyMVar
  RateLimitState
rlState' <- IO RateLimitState
newRateLimitState
  (InChan CalamityEvent
inc, OutChan CalamityEvent
outc) <- forall (a :: OpticKind). IO (InChan a, OutChan a)
newChan
  IORef Integer
ehidCounter <- forall (a :: OpticKind). a -> IO (IORef a)
newIORef Integer
0

  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$
    TVar [(InChan ControlMessage, Async (Maybe ()))]
-> MVar Int
-> Token
-> RateLimitState
-> InChan CalamityEvent
-> OutChan CalamityEvent
-> IORef Integer
-> Maybe (Di Level Path Message)
-> Client
Client
      TVar [(InChan ControlMessage, Async (Maybe ()))]
shards'
      MVar Int
numShards'
      Token
token
      RateLimitState
rlState'
      InChan CalamityEvent
inc
      OutChan CalamityEvent
outc
      IORef Integer
ehidCounter
      Maybe (Di Level Path Message)
initialDi

-- | Create a bot, run your setup action, and then loop until the bot closes.
runBotIO ::
  forall r a.
  (P.Members '[P.Embed IO, P.Final IO, CacheEff, MetricEff, LogEff] r) =>
  Token ->
  -- | The intents the bot should use
  Intents ->
  P.Sem (SetupEff r) a ->
  P.Sem r (Maybe StartupError)
runBotIO :: forall (r :: EffectRow) (a :: OpticKind).
Members '[Embed IO, Final IO, CacheEff, MetricEff, LogEff] r =>
Token
-> Intents -> Sem (SetupEff r) a -> Sem r (Maybe StartupError)
runBotIO Token
token Intents
intents = forall (r :: EffectRow) (a :: OpticKind).
Members '[Embed IO, Final IO, CacheEff, MetricEff, LogEff] r =>
Token
-> Intents
-> Maybe StatusUpdateData
-> Sem (SetupEff r) a
-> Sem r (Maybe StartupError)
runBotIO' Token
token Intents
intents forall (a :: OpticKind). Maybe a
Nothing

resetDi :: BotC r => P.Sem r a -> P.Sem r a
resetDi :: forall (r :: EffectRow) (a :: OpticKind).
BotC r =>
Sem r a -> Sem r a
resetDi Sem r a
m = do
  Maybe (Di Level Path Message)
initialDi <- forall (i :: OpticKind) (j :: OpticKind) (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks (forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "initialDi" a => a
#initialDi)
  forall (level :: OpticKind) (path :: OpticKind) (msg :: OpticKind)
       (r :: EffectRow) (a :: OpticKind).
Member (Di level path msg) r =>
(Di level path msg -> Di level path msg) -> Sem r a -> Sem r a
Di.local (forall (a :: OpticKind). a -> Maybe a -> a
`fromMaybe` Maybe (Di Level Path Message)
initialDi) Sem r a
m

interpretRatelimitViaClient :: P.Member (P.Reader Client) r => P.Sem (RatelimitEff ': r) a -> P.Sem r a
interpretRatelimitViaClient :: forall (r :: EffectRow) (a :: OpticKind).
Member (Reader Client) r =>
Sem (RatelimitEff : r) a -> Sem r a
interpretRatelimitViaClient =
  forall (e :: (OpticKind -> OpticKind) -> OpticKind -> OpticKind)
       (r :: EffectRow) (a :: OpticKind).
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) (x :: OpticKind).
 e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
P.interpret
    ( \case
        RatelimitEff (Sem rInitial) x
GetRatelimitState -> forall (i :: OpticKind) (j :: OpticKind) (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks (forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "rlState" a => a
#rlState)
    )

interpretTokenViaClient :: P.Member (P.Reader Client) r => P.Sem (TokenEff ': r) a -> P.Sem r a
interpretTokenViaClient :: forall (r :: EffectRow) (a :: OpticKind).
Member (Reader Client) r =>
Sem (TokenEff : r) a -> Sem r a
interpretTokenViaClient =
  forall (e :: (OpticKind -> OpticKind) -> OpticKind -> OpticKind)
       (r :: EffectRow) (a :: OpticKind).
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) (x :: OpticKind).
 e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
P.interpret
    ( \case
        TokenEff (Sem rInitial) x
GetBotToken -> forall (i :: OpticKind) (j :: OpticKind) (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks (forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "token" a => a
#token)
    )

{- | Create a bot, run your setup action, and then loop until the bot closes.

 This version allows you to specify the initial status
-}
runBotIO' ::
  forall r a.
  (P.Members '[P.Embed IO, P.Final IO, CacheEff, MetricEff, LogEff] r) =>
  Token ->
  -- | The intents the bot should use
  Intents ->
  -- | The initial status to send to the gateway
  Maybe StatusUpdateData ->
  P.Sem (SetupEff r) a ->
  P.Sem r (Maybe StartupError)
runBotIO' :: forall (r :: EffectRow) (a :: OpticKind).
Members '[Embed IO, Final IO, CacheEff, MetricEff, LogEff] r =>
Token
-> Intents
-> Maybe StatusUpdateData
-> Sem (SetupEff r) a
-> Sem r (Maybe StartupError)
runBotIO' Token
token Intents
intents Maybe StatusUpdateData
status Sem
  (RatelimitEff
     : TokenEff : Reader Client : AtomicState EventHandlers : Async : r)
  a
setup = do
  Maybe (Di Level Path Message)
initialDi <- forall (level :: OpticKind) (path :: OpticKind) (msg :: OpticKind)
       (r :: EffectRow).
Member (Di level path msg) r =>
Sem r (Maybe (Di level path msg))
Di.fetch
  Client
client <- forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Token -> Maybe (Di Level Path Message) -> IO Client
newClient Token
token Maybe (Di Level Path Message)
initialDi
  TVar EventHandlers
handlers <- forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). a -> IO (TVar a)
newTVarIO forall (a :: OpticKind). Default a => a
def
  forall (r :: EffectRow) (a :: OpticKind).
Member (Final IO) r =>
Sem (Async : r) a -> Sem r a
P.asyncToIOFinal forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow) (s :: OpticKind) (a :: OpticKind).
Member (Embed IO) r =>
TVar s -> Sem (AtomicState s : r) a -> Sem r a
P.runAtomicStateTVar TVar EventHandlers
handlers forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (i :: OpticKind) (r :: EffectRow) (a :: OpticKind).
i -> Sem (Reader i : r) a -> Sem r a
P.runReader Client
client forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow) (a :: OpticKind).
Member (Reader Client) r =>
Sem (TokenEff : r) a -> Sem r a
interpretTokenViaClient forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow) (a :: OpticKind).
Member (Reader Client) r =>
Sem (RatelimitEff : r) a -> Sem r a
interpretRatelimitViaClient forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (level :: OpticKind) (msg :: OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Di level Path msg) r =>
Segment -> Sem r a -> Sem r a
Di.push Segment
"calamity" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
    forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Functor f =>
f a -> f ()
void forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (level :: OpticKind) (msg :: OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Di level Path msg) r =>
Segment -> Sem r a -> Sem r a
Di.push Segment
"calamity-setup" Sem
  (RatelimitEff
     : TokenEff : Reader Client : AtomicState EventHandlers : Async : r)
  a
setup
    Either StartupError ()
r <- forall (r :: EffectRow).
BotC r =>
Maybe StatusUpdateData -> Intents -> Sem r (Either StartupError ())
shardBot Maybe StatusUpdateData
status Intents
intents
    case Either StartupError ()
r of
      Left StartupError
e -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (forall (a :: OpticKind). a -> Maybe a
Just StartupError
e)
      Right ()
_ -> do
        forall (level :: OpticKind) (msg :: OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Di level Path msg) r =>
Segment -> Sem r a -> Sem r a
Di.push Segment
"calamity-loop" forall (r :: EffectRow). BotC r => Sem r ()
clientLoop
        forall (level :: OpticKind) (msg :: OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Di level Path msg) r =>
Segment -> Sem r a -> Sem r a
Di.push Segment
"calamity-stop" forall (r :: EffectRow). BotC r => Sem r ()
finishUp
        forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind). Maybe a
Nothing

{- | Create a bot, run your setup action, and then loop until the bot closes.

 This version only handles the @'P.Reader' 'Client'@ effect, allowing you to
 handle the @'P.AtomicState' 'EventHandlers'@ yourself.
-}
runBotIO'' ::
  forall r a.
  ( P.Members
      '[ LogEff
       , MetricEff
       , CacheEff
       , P.Reader Client
       , P.AtomicState EventHandlers
       , P.Embed IO
       , P.Final IO
       , P.Async
       ]
      r
  ) =>
  Token ->
  -- | The intents the bot should use
  Intents ->
  -- | The initial status to send to the gateway
  Maybe StatusUpdateData ->
  P.Sem (RatelimitEff ': TokenEff ': P.Reader Client ': r) a ->
  P.Sem r (Maybe StartupError)
runBotIO'' :: forall (r :: EffectRow) (a :: OpticKind).
Members
  '[LogEff, MetricEff, CacheEff, Reader Client,
    AtomicState EventHandlers, Embed IO, Final IO, Async]
  r =>
Token
-> Intents
-> Maybe StatusUpdateData
-> Sem (RatelimitEff : TokenEff : Reader Client : r) a
-> Sem r (Maybe StartupError)
runBotIO'' Token
token Intents
intents Maybe StatusUpdateData
status Sem (RatelimitEff : TokenEff : Reader Client : r) a
setup = do
  Maybe (Di Level Path Message)
initialDi <- forall (level :: OpticKind) (path :: OpticKind) (msg :: OpticKind)
       (r :: EffectRow).
Member (Di level path msg) r =>
Sem r (Maybe (Di level path msg))
Di.fetch
  Client
client <- forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Token -> Maybe (Di Level Path Message) -> IO Client
newClient Token
token Maybe (Di Level Path Message)
initialDi
  forall (i :: OpticKind) (r :: EffectRow) (a :: OpticKind).
i -> Sem (Reader i : r) a -> Sem r a
P.runReader Client
client forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow) (a :: OpticKind).
Member (Reader Client) r =>
Sem (TokenEff : r) a -> Sem r a
interpretTokenViaClient forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow) (a :: OpticKind).
Member (Reader Client) r =>
Sem (RatelimitEff : r) a -> Sem r a
interpretRatelimitViaClient forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (level :: OpticKind) (msg :: OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Di level Path msg) r =>
Segment -> Sem r a -> Sem r a
Di.push Segment
"calamity" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
    forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Functor f =>
f a -> f ()
void forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (level :: OpticKind) (msg :: OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Di level Path msg) r =>
Segment -> Sem r a -> Sem r a
Di.push Segment
"calamity-setup" Sem (RatelimitEff : TokenEff : Reader Client : r) a
setup
    Either StartupError ()
r <- forall (r :: EffectRow).
BotC r =>
Maybe StatusUpdateData -> Intents -> Sem r (Either StartupError ())
shardBot Maybe StatusUpdateData
status Intents
intents
    case Either StartupError ()
r of
      Left StartupError
e -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (forall (a :: OpticKind). a -> Maybe a
Just StartupError
e)
      Right ()
_ -> do
        forall (level :: OpticKind) (msg :: OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Di level Path msg) r =>
Segment -> Sem r a -> Sem r a
Di.push Segment
"calamity-loop" forall (r :: EffectRow). BotC r => Sem r ()
clientLoop
        forall (level :: OpticKind) (msg :: OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Di level Path msg) r =>
Segment -> Sem r a -> Sem r a
Di.push Segment
"calamity-stop" forall (r :: EffectRow). BotC r => Sem r ()
finishUp
        forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind). Maybe a
Nothing

{- | Register an event handler, returning an action that removes the event handler from the bot.

 Refer to 'EventType' for what events you can register, and 'EHType' for the
 parameters the event handlers they receive.

 You'll probably want @TypeApplications@ and need @DataKinds@ enabled to
 specify the type of @s@.

 ==== Examples

 Reacting to every message:

 @
 'react' @\''MessageCreateEvt' '$' \msg -> 'print' '$' "Got message: " '<>' 'show' msg
 @

 Reacting to a custom event:

 @
 data MyCustomEvt = MyCustomEvt 'Data.Text.Text' 'Message'

 'react' @(\''CustomEvt' MyCustomEvt) $ \\(MyCustomEvt s m) ->
    'void' $ 'Calamity.Types.Tellable.tell' @'Data.Text.Text' m ("Somebody told me to tell you about: " '<>' s)
 @

 ==== Notes

 This function is pretty bad for giving nasty type errors,
 since if something doesn't match then 'EHType' might not get substituted,
 which will result in errors about parameter counts mismatching.
-}
react ::
  forall (s :: EventType) r.
  (BotC r, ReactConstraints s) =>
  (EHType s -> (P.Sem r) ()) ->
  P.Sem r (P.Sem r ())
react :: forall (s :: EventType) (r :: EffectRow).
(BotC r, ReactConstraints s) =>
(EHType s -> Sem r ()) -> Sem r (Sem r ())
react EHType s -> Sem r ()
handler = do
  EHType s -> IO (Maybe ())
handler' <- forall (r :: EffectRow) (p :: OpticKind) (a :: OpticKind).
Member (Final IO) r =>
(p -> Sem r a) -> Sem r (p -> IO (Maybe a))
bindSemToIO EHType s -> Sem r ()
handler
  IORef Integer
ehidC <- forall (i :: OpticKind) (j :: OpticKind) (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks (forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "ehidCounter" a => a
#ehidCounter)
  Integer
id' <- forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind).
IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Integer
ehidC (\Integer
i -> (Integer
i forall (a :: OpticKind). Num a => a -> a -> a
+ Integer
1, Integer
i))
  let handlers :: EventHandlers
handlers = forall (a :: EventType).
InsertEventHandler a =>
Proxy a -> Integer -> StoredEHType a -> EventHandlers
makeEventHandlers (forall {k :: OpticKind} (t :: k). Proxy t
Proxy @s) Integer
id' (forall (a :: OpticKind) (b :: OpticKind). a -> b -> a
const () forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind) (c :: OpticKind).
Functor f =>
(a -> b) -> (c -> f a) -> c -> f b
<.> EHType s -> IO (Maybe ())
handler')
  forall (s :: OpticKind) (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
P.atomicModify (EventHandlers
handlers forall (a :: OpticKind). Semigroup a => a -> a -> a
<>)
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (s :: EventType) (r :: EffectRow).
(BotC r, RemoveEventHandler s) =>
Integer -> Sem r ()
removeHandler @s Integer
id'

removeHandler :: forall (s :: EventType) r. (BotC r, RemoveEventHandler s) => Integer -> P.Sem r ()
removeHandler :: forall (s :: EventType) (r :: EffectRow).
(BotC r, RemoveEventHandler s) =>
Integer -> Sem r ()
removeHandler Integer
id' = forall (s :: OpticKind) (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
P.atomicModify (forall {k :: OpticKind} (a :: k).
RemoveEventHandler a =>
Proxy a -> Integer -> EventHandlers -> EventHandlers
removeEventHandler (forall {k :: OpticKind} (t :: k). Proxy t
Proxy @s) Integer
id')

{- | Fire an event that the bot will then handle.

 ==== Examples

 Firing an event named \"my-event\":

 @
 'fire' '$' 'customEvt' @"my-event" ("aha" :: 'Data.Text.Text', msg)
 @
-}
fire :: BotC r => CalamityEvent -> P.Sem r ()
fire :: forall (r :: EffectRow). BotC r => CalamityEvent -> Sem r ()
fire CalamityEvent
e = do
  InChan CalamityEvent
inc <- forall (i :: OpticKind) (j :: OpticKind) (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks (forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "eventsIn" a => a
#eventsIn)
  forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). InChan a -> a -> IO ()
writeChan InChan CalamityEvent
inc CalamityEvent
e

{- | Build a Custom CalamityEvent

 The type of @a@ must match up with the event handler you want to receive it.

 ==== Examples

 @
 'customEvt' (MyCustomEvent "lol")
 @
-}
customEvt :: forall a. Typeable a => a -> CalamityEvent
customEvt :: forall (a :: OpticKind). Typeable a => a -> CalamityEvent
customEvt = forall (a :: OpticKind). Typeable a => a -> CalamityEvent
Custom

-- | Get a copy of the event stream.
events :: BotC r => P.Sem r (OutChan CalamityEvent)
events :: forall (r :: EffectRow). BotC r => Sem r (OutChan CalamityEvent)
events = do
  InChan CalamityEvent
inc <- forall (i :: OpticKind) (j :: OpticKind) (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks (forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "eventsIn" a => a
#eventsIn)
  forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). InChan a -> IO (OutChan a)
dupChan InChan CalamityEvent
inc

{- | Wait until an event satisfying a condition happens, then returns its
 parameters.

 The check function for this command is pure unlike 'waitUntilM'

 This is what it would look like with @s ~ \''MessageCreateEvt'@:

 @
 'waitUntil' :: ('Message' -> 'Bool') -> 'P.Sem' r 'Message'
 @

 And for @s ~ \''MessageUpdateEvt'@:

 @
 'waitUntil' :: (('Message', 'Message') -> 'Bool') -> 'P.Sem' r ('Message', 'Message')
 @

 ==== Examples

 Waiting for a message containing the text \"hi\":

 @
 f = do msg \<\- 'waitUntil' @\''MessageCreateEvt' (\\m -> 'Data.Text.isInfixOf' "hi" $ m ^. #content)
        print $ msg ^. #content
 @
-}
waitUntil ::
  forall (s :: EventType) r.
  (BotC r, ReactConstraints s) =>
  (EHType s -> Bool) ->
  P.Sem r (EHType s)
waitUntil :: forall (s :: EventType) (r :: EffectRow).
(BotC r, ReactConstraints s) =>
(EHType s -> Bool) -> Sem r (EHType s)
waitUntil EHType s -> Bool
f = forall (r :: EffectRow) (a :: OpticKind).
Member (Final IO) r =>
Sem (Resource : r) a -> Sem r a
P.resourceToIOFinal forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
  MVar (EHType s)
result <- forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind). IO (MVar a)
newEmptyMVar
  forall (r :: EffectRow) (a :: OpticKind) (c :: OpticKind)
       (b :: OpticKind).
Member Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
P.bracket
    (forall (e :: (OpticKind -> OpticKind) -> OpticKind -> OpticKind)
       (r :: EffectRow) (a :: OpticKind).
Sem r a -> Sem (e : r) a
P.raise forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (s :: EventType) (r :: EffectRow).
(BotC r, ReactConstraints s) =>
(EHType s -> Sem r ()) -> Sem r (Sem r ())
react @s (MVar (EHType s) -> EHType s -> Sem r ()
checker MVar (EHType s)
result))
    forall (e :: (OpticKind -> OpticKind) -> OpticKind -> OpticKind)
       (r :: EffectRow) (a :: OpticKind).
Sem r a -> Sem (e : r) a
P.raise
    (forall (a :: OpticKind) (b :: OpticKind). a -> b -> a
const forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). MVar a -> IO a
takeMVar MVar (EHType s)
result)
  where
    checker :: MVar (EHType s) -> EHType s -> P.Sem r ()
    checker :: MVar (EHType s) -> EHType s -> Sem r ()
checker MVar (EHType s)
result EHType s
args = do
      forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
when (EHType s -> Bool
f EHType s
args) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
        forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). MVar a -> a -> IO ()
putMVar MVar (EHType s)
result EHType s
args

{- | Wait until an event satisfying a condition happens, then returns its
 parameters

 This is what it would look like with @s ~ \''MessageCreateEvt'@:

 @
 'waitUntilM' :: ('Message' -> 'P.Sem' r 'Bool') -> 'P.Sem' r 'Message'
 @

 And for @s ~ \''MessageUpdateEvt'@:

 @
 'waitUntilM' :: (('Message', 'Message') -> 'P.Sem' r 'Bool') -> 'P.Sem' r ('Message', 'Message')
 @

 ==== Examples

 Waiting for a message containing the text \"hi\":

 @
 f = do msg \<\- 'waitUntilM' @\''MessageCreateEvt' (\\m -> ('debug' $ "got message: " <> 'showt' msg) >> ('pure' $ 'Data.Text.isInfixOf' "hi" $ m ^. #content))
        print $ msg ^. #content
 @
-}
waitUntilM ::
  forall (s :: EventType) r.
  (BotC r, ReactConstraints s) =>
  (EHType s -> P.Sem r Bool) ->
  P.Sem r (EHType s)
waitUntilM :: forall (s :: EventType) (r :: EffectRow).
(BotC r, ReactConstraints s) =>
(EHType s -> Sem r Bool) -> Sem r (EHType s)
waitUntilM EHType s -> Sem r Bool
f = forall (r :: EffectRow) (a :: OpticKind).
Member (Final IO) r =>
Sem (Resource : r) a -> Sem r a
P.resourceToIOFinal forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
  MVar (EHType s)
result <- forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind). IO (MVar a)
newEmptyMVar
  forall (r :: EffectRow) (a :: OpticKind) (c :: OpticKind)
       (b :: OpticKind).
Member Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
P.bracket
    (forall (e :: (OpticKind -> OpticKind) -> OpticKind -> OpticKind)
       (r :: EffectRow) (a :: OpticKind).
Sem r a -> Sem (e : r) a
P.raise forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (s :: EventType) (r :: EffectRow).
(BotC r, ReactConstraints s) =>
(EHType s -> Sem r ()) -> Sem r (Sem r ())
react @s (MVar (EHType s) -> EHType s -> Sem r ()
checker MVar (EHType s)
result))
    forall (e :: (OpticKind -> OpticKind) -> OpticKind -> OpticKind)
       (r :: EffectRow) (a :: OpticKind).
Sem r a -> Sem (e : r) a
P.raise
    (forall (a :: OpticKind) (b :: OpticKind). a -> b -> a
const forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). MVar a -> IO a
takeMVar MVar (EHType s)
result)
  where
    checker :: MVar (EHType s) -> EHType s -> P.Sem r ()
    checker :: MVar (EHType s) -> EHType s -> Sem r ()
checker MVar (EHType s)
result EHType s
args = do
      Bool
res <- EHType s -> Sem r Bool
f EHType s
args
      forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
when Bool
res forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
        forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). MVar a -> a -> IO ()
putMVar MVar (EHType s)
result EHType s
args

-- | Set the bot's presence on all shards.
sendPresence :: BotC r => StatusUpdateData -> P.Sem r ()
sendPresence :: forall (r :: EffectRow). BotC r => StatusUpdateData -> Sem r ()
sendPresence StatusUpdateData
s = do
  [(InChan ControlMessage, Async (Maybe ()))]
shards <- forall (i :: OpticKind) (j :: OpticKind) (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks (forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "shards" a => a
#shards) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). TVar a -> IO a
readTVarIO
  forall (t :: OpticKind -> OpticKind) (f :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(InChan ControlMessage, Async (Maybe ()))]
shards forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \(InChan ControlMessage
inc, Async (Maybe ())
_) ->
    forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). InChan a -> a -> IO ()
writeChan InChan ControlMessage
inc (StatusUpdateData -> ControlMessage
SendPresence StatusUpdateData
s)

-- | Initiate shutting down the bot.
stopBot :: BotC r => P.Sem r ()
stopBot :: forall (r :: EffectRow). BotC r => Sem r ()
stopBot = do
  forall (r :: EffectRow). Member LogEff r => Text -> Sem r ()
debug Text
"stopping bot"
  InChan CalamityEvent
inc <- forall (i :: OpticKind) (j :: OpticKind) (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks (forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "eventsIn" a => a
#eventsIn)
  forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). InChan a -> a -> IO ()
writeChan InChan CalamityEvent
inc CalamityEvent
ShutDown

finishUp :: BotC r => P.Sem r ()
finishUp :: forall (r :: EffectRow). BotC r => Sem r ()
finishUp = do
  forall (r :: EffectRow). Member LogEff r => Text -> Sem r ()
debug Text
"finishing up"
  [(InChan ControlMessage, Async (Maybe ()))]
shards <- forall (i :: OpticKind) (j :: OpticKind) (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks (forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "shards" a => a
#shards) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). TVar a -> IO a
readTVarIO
  forall (t :: OpticKind -> OpticKind) (f :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(InChan ControlMessage, Async (Maybe ()))]
shards forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \(InChan ControlMessage
inc, Async (Maybe ())
_) ->
    forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). InChan a -> a -> IO ()
writeChan InChan ControlMessage
inc ControlMessage
ShutDownShard
  forall (t :: OpticKind -> OpticKind) (f :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(InChan ControlMessage, Async (Maybe ()))]
shards forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \(InChan ControlMessage
_, Async (Maybe ())
shardThread) -> forall (r :: EffectRow) (a :: OpticKind).
Member Async r =>
Async a -> Sem r a
P.await Async (Maybe ())
shardThread
  forall (r :: EffectRow). Member LogEff r => Text -> Sem r ()
debug Text
"bot has stopped"

{- | main loop of the client, handles fetching the next event, processing the
 event and invoking its handler functions
-}
clientLoop :: BotC r => P.Sem r ()
clientLoop :: forall (r :: EffectRow). BotC r => Sem r ()
clientLoop = do
  OutChan CalamityEvent
outc <- forall (i :: OpticKind) (j :: OpticKind) (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks (forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "eventsOut" a => a
#eventsOut)
  forall (r :: EffectRow).
Member (Final IO) r =>
Sem r Bool -> Sem r ()
whileMFinalIO forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
    !CalamityEvent
evt' <- forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). OutChan a -> IO a
readChan OutChan CalamityEvent
outc
    case CalamityEvent
evt' of
      Dispatch !Int
sid !DispatchData
evt -> forall (r :: EffectRow). BotC r => Int -> DispatchData -> Sem r ()
handleEvent Int
sid DispatchData
evt forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Bool
True
      Custom a
d -> forall (a :: OpticKind) (r :: EffectRow).
(Typeable a, BotC r) =>
a -> Sem r ()
handleCustomEvent a
d forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Bool
True
      CalamityEvent
ShutDown -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Bool
False
  forall (r :: EffectRow). Member LogEff r => Text -> Sem r ()
debug Text
"leaving client loop"

handleCustomEvent :: forall a r. (Typeable a, BotC r) => a -> P.Sem r ()
handleCustomEvent :: forall (a :: OpticKind) (r :: EffectRow).
(Typeable a, BotC r) =>
a -> Sem r ()
handleCustomEvent a
d = do
  EventHandlers
eventHandlers <- forall (s :: OpticKind) (r :: EffectRow).
Member (AtomicState s) r =>
Sem r s
P.atomicGet

  let handlers :: [a -> IO ()]
handlers = forall (a :: OpticKind).
Typeable a =>
EventHandlers -> [a -> IO ()]
getCustomEventHandlers @a EventHandlers
eventHandlers

  forall (t :: OpticKind -> OpticKind) (f :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [a -> IO ()]
handlers (\a -> IO ()
h -> forall (r :: EffectRow) (a :: OpticKind).
Member Async r =>
Sem r a -> Sem r (Async (Maybe a))
P.async forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ a -> IO ()
h a
d)

catchAllLogging :: BotC r => P.Sem r () -> P.Sem r ()
catchAllLogging :: forall (r :: EffectRow). BotC r => Sem r () -> Sem r ()
catchAllLogging Sem r ()
m = do
  Either SomeException ()
r <- forall (e :: OpticKind) (r :: EffectRow) (a :: OpticKind).
(Typeable e, Member (Final IO) r) =>
Sem (Error e : r) a -> Sem r (Either e a)
P.errorToIOFinal forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (e :: OpticKind) (r :: EffectRow) (a :: OpticKind).
(Exception e, Member (Error e) r, Member (Final IO) r) =>
Sem r a -> Sem r a
P.fromExceptionSem @SomeException forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (e :: (OpticKind -> OpticKind) -> OpticKind -> OpticKind)
       (r :: EffectRow) (a :: OpticKind).
Sem r a -> Sem (e : r) a
P.raise Sem r ()
m
  case Either SomeException ()
r of
    Right ()
_ -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
    Left SomeException
e -> forall (r :: EffectRow). Member LogEff r => Text -> Sem r ()
debug forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ String
"got exception: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> String
show SomeException
e

handleEvent :: BotC r => Int -> DispatchData -> P.Sem r ()
handleEvent :: forall (r :: EffectRow). BotC r => Int -> DispatchData -> Sem r ()
handleEvent Int
shardID DispatchData
data' = do
  forall (r :: EffectRow). Member LogEff r => Text -> Sem r ()
debug forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ String
"handling an event: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). CtorName a => a -> String
ctorName DispatchData
data'
  EventHandlers
eventHandlers <- forall (s :: OpticKind) (r :: EffectRow).
Member (AtomicState s) r =>
Sem r s
P.atomicGet
  Either String [IO ()]
actions <- forall (r :: EffectRow) (a :: OpticKind).
Sem (Fail : r) a -> Sem r (Either String a)
P.runFail forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
    Counter
evtCounter <- forall (r :: EffectRow).
Member MetricEff r =>
Text -> [(Text, Text)] -> Sem r Counter
registerCounter Text
"events_received" [(Text
"type", String -> Text
T.pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). CtorName a => a -> String
ctorName DispatchData
data'), (Text
"shard", forall (a :: OpticKind). TextShow a => a -> Text
showt Int
shardID)]
    forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Functor f =>
f a -> f ()
void forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (r :: EffectRow).
Member MetricEff r =>
Int -> Counter -> Sem r Int
addCounter Int
1 Counter
evtCounter
    Histogram
cacheUpdateHisto <- forall (r :: EffectRow).
Member MetricEff r =>
Text -> [(Text, Text)] -> [Double] -> Sem r Histogram
registerHistogram Text
"cache_update" forall (a :: OpticKind). Monoid a => a
mempty [Double
10, Double
20 .. Double
100]
    (Double
time, [IO ()]
res) <- forall (r :: EffectRow) (a :: OpticKind).
Member (Embed IO) r =>
Sem r a -> Sem r (Double, a)
timeA forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow) (a :: OpticKind).
BotC r =>
Sem r a -> Sem r a
resetDi forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (r :: EffectRow).
BotC r =>
EventHandlers -> DispatchData -> Sem (Fail : r) [IO ()]
handleEvent' EventHandlers
eventHandlers DispatchData
data'
    forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Functor f =>
f a -> f ()
void forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (r :: EffectRow).
Member MetricEff r =>
Double -> Histogram -> Sem r HistogramSample
observeHistogram Double
time Histogram
cacheUpdateHisto
    forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure [IO ()]
res

  Histogram
eventHandleHisto <- forall (r :: EffectRow).
Member MetricEff r =>
Text -> [(Text, Text)] -> [Double] -> Sem r Histogram
registerHistogram Text
"event_handle" forall (a :: OpticKind). Monoid a => a
mempty [Double
10, Double
20 .. Double
100]

  case Either String [IO ()]
actions of
    Right [IO ()]
actions -> forall (t :: OpticKind -> OpticKind) (f :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [IO ()]
actions forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \IO ()
action -> forall (r :: EffectRow) (a :: OpticKind).
Member Async r =>
Sem r a -> Sem r (Async (Maybe a))
P.async forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
      (Double
time, ()
_) <- forall (r :: EffectRow) (a :: OpticKind).
Member (Embed IO) r =>
Sem r a -> Sem r (Double, a)
timeA forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow). BotC r => Sem r () -> Sem r ()
catchAllLogging forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed IO ()
action
      forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Functor f =>
f a -> f ()
void forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (r :: EffectRow).
Member MetricEff r =>
Double -> Histogram -> Sem r HistogramSample
observeHistogram Double
time Histogram
eventHandleHisto
    -- pattern match failures are usually stuff like events for uncached guilds, etc
    Left String
err -> forall (r :: EffectRow). Member LogEff r => Text -> Sem r ()
debug forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ String
"Failed handling actions for event: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> String
show String
err

handleEvent' ::
  BotC r =>
  EventHandlers ->
  DispatchData ->
  P.Sem (P.Fail ': r) [IO ()]
handleEvent' :: forall (r :: EffectRow).
BotC r =>
EventHandlers -> DispatchData -> Sem (Fail : r) [IO ()]
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(Ready rd :: ReadyData
rd@ReadyData {}) = do
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ReadyData
rd) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'ReadyEvt EventHandlers
eh)
handleEvent' EventHandlers
_ DispatchData
Resumed = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure []
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(ChannelCreate (DMChannel' DMChannel
chan)) = do
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just Channel
newChan <- DMChannel -> Channel
DMChannel' forall (f :: OpticKind -> OpticKind) (g :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> forall (r :: EffectRow).
Member CacheEff r =>
Snowflake DMChannel -> Sem r (Maybe DMChannel)
getDM (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID DMChannel
chan)
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Channel
newChan) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'ChannelCreateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(ChannelCreate (GuildChannel' GuildChannel
chan)) = do
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just Guild
guild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID GuildChannel
chan)
  Just Channel
newChan <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ GuildChannel -> Channel
GuildChannel' forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Guild
guild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "channels" a => a
#channels forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID GuildChannel
chan)
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Channel
newChan) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'ChannelCreateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(ChannelUpdate (DMChannel' DMChannel
chan)) = do
  Just Channel
oldChan <- DMChannel -> Channel
DMChannel' forall (f :: OpticKind -> OpticKind) (g :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> forall (r :: EffectRow).
Member CacheEff r =>
Snowflake DMChannel -> Sem r (Maybe DMChannel)
getDM (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID DMChannel
chan)
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just Channel
newChan <- DMChannel -> Channel
DMChannel' forall (f :: OpticKind -> OpticKind) (g :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> forall (r :: EffectRow).
Member CacheEff r =>
Snowflake DMChannel -> Sem r (Maybe DMChannel)
getDM (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID DMChannel
chan)
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Channel
oldChan, Channel
newChan)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'ChannelUpdateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(ChannelUpdate (GuildChannel' GuildChannel
chan)) = do
  Just Guild
oldGuild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID GuildChannel
chan)
  Just Channel
oldChan <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ GuildChannel -> Channel
GuildChannel' forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Guild
oldGuild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "channels" a => a
#channels forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID GuildChannel
chan)
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just Guild
newGuild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID GuildChannel
chan)
  Just Channel
newChan <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ GuildChannel -> Channel
GuildChannel' forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Guild
newGuild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "channels" a => a
#channels forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID GuildChannel
chan)
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Channel
oldChan, Channel
newChan)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'ChannelUpdateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(ChannelDelete (GuildChannel' GuildChannel
chan)) = do
  Just Guild
oldGuild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID GuildChannel
chan)
  Just Channel
oldChan <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ GuildChannel -> Channel
GuildChannel' forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Guild
oldGuild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "channels" a => a
#channels forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID GuildChannel
chan)
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Channel
oldChan) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'ChannelDeleteEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(ChannelDelete (DMChannel' DMChannel
chan)) = do
  Just Channel
oldChan <- DMChannel -> Channel
DMChannel' forall (f :: OpticKind -> OpticKind) (g :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> forall (r :: EffectRow).
Member CacheEff r =>
Snowflake DMChannel -> Sem r (Maybe DMChannel)
getDM (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID DMChannel
chan)
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Channel
oldChan) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'ChannelDeleteEvt EventHandlers
eh)

-- handleEvent' eh evt@(ChannelPinsUpdate ChannelPinsUpdateData { channelID, lastPinTimestamp }) = do
--   chan <- (GuildChannel' <$> os ^? #channels % at (coerceSnowflake channelID) . _Just)
--     <|> (DMChannel' <$> os ^? #dms % at (coerceSnowflake channelID) . _Just)
--   pure $ map (\f -> f chan lastPinTimestamp) (getEventHandlers @"channelpinsupdate" eh)

handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildCreate Guild
guild) = do
  Bool
isNew <- Bool -> Bool
not forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r Bool
isUnavailableGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID Guild
guild)
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just Guild
guild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID Guild
guild)
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$
    forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map
      (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
guild, if Bool
isNew then GuildCreateStatus
GuildCreateNew else GuildCreateStatus
GuildCreateAvailable))
      (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildCreateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildUpdate UpdatedGuild
guild) = do
  Just Guild
oldGuild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID UpdatedGuild
guild)
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just Guild
newGuild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID UpdatedGuild
guild)
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
oldGuild, Guild
newGuild)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildUpdateEvt EventHandlers
eh)

-- NOTE: Guild will be deleted in the new cache if unavailable was false
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildDelete UnavailableGuild {Snowflake Guild
$sel:id:UnavailableGuild :: UnavailableGuild -> Snowflake Guild
id :: Snowflake Guild
id, Bool
$sel:unavailable:UnavailableGuild :: UnavailableGuild -> Bool
unavailable :: Bool
unavailable}) = do
  Just Guild
oldGuild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
id
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$
    forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map
      (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
oldGuild, if Bool
unavailable then GuildDeleteStatus
GuildDeleteUnavailable else GuildDeleteStatus
GuildDeleteRemoved))
      (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildDeleteEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildBanAdd BanData {Snowflake Guild
$sel:guildID:BanData :: BanData -> Snowflake Guild
guildID :: Snowflake Guild
guildID, User
$sel:user:BanData :: BanData -> User
user :: User
user}) = do
  Just Guild
guild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
guild, User
user)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildBanAddEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildBanRemove BanData {Snowflake Guild
guildID :: Snowflake Guild
$sel:guildID:BanData :: BanData -> Snowflake Guild
guildID, User
user :: User
$sel:user:BanData :: BanData -> User
user}) = do
  Just Guild
guild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
guild, User
user)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildBanRemoveEvt EventHandlers
eh)

-- NOTE: we fire this event using the guild data with old emojis
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildEmojisUpdate GuildEmojisUpdateData {Snowflake Guild
$sel:guildID:GuildEmojisUpdateData :: GuildEmojisUpdateData -> Snowflake Guild
guildID :: Snowflake Guild
guildID, [Emoji]
$sel:emojis:GuildEmojisUpdateData :: GuildEmojisUpdateData -> [Emoji]
emojis :: [Emoji]
emojis}) = do
  Just Guild
guild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
guild, [Emoji]
emojis)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildEmojisUpdateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildIntegrationsUpdate GuildIntegrationsUpdateData {Snowflake Guild
$sel:guildID:GuildIntegrationsUpdateData :: GuildIntegrationsUpdateData -> Snowflake Guild
guildID :: Snowflake Guild
guildID}) = do
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just Guild
guild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Guild
guild) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildIntegrationsUpdateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildMemberAdd Snowflake Guild
gid Member
member) = do
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just Guild
guild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
gid
  Just IxValue (SnowflakeMap Member)
member <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Guild
guild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "members" a => a
#members forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID Member
member)
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
guild, IxValue (SnowflakeMap Member)
member)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildMemberAddEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildMemberRemove GuildMemberRemoveData {User
$sel:user:GuildMemberRemoveData :: GuildMemberRemoveData -> User
user :: User
user, Snowflake Guild
$sel:guildID:GuildMemberRemoveData :: GuildMemberRemoveData -> Snowflake Guild
guildID :: Snowflake Guild
guildID}) = do
  Just Guild
guild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  Just IxValue (SnowflakeMap Member)
member <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Guild
guild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "members" a => a
#members forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID User
user)
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
guild, IxValue (SnowflakeMap Member)
member)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildMemberRemoveEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildMemberUpdate GuildMemberUpdateData {User
$sel:user:GuildMemberUpdateData :: GuildMemberUpdateData -> User
user :: User
user, Snowflake Guild
$sel:guildID:GuildMemberUpdateData :: GuildMemberUpdateData -> Snowflake Guild
guildID :: Snowflake Guild
guildID}) = do
  Just Guild
oldGuild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  Just IxValue (SnowflakeMap Member)
oldMember <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Guild
oldGuild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "members" a => a
#members forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID User
user)
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just Guild
newGuild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  Just IxValue (SnowflakeMap Member)
newMember <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Guild
newGuild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "members" a => a
#members forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID User
user)
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
newGuild, IxValue (SnowflakeMap Member)
oldMember, IxValue (SnowflakeMap Member)
newMember)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildMemberUpdateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildMembersChunk GuildMembersChunkData {[Member]
$sel:members:GuildMembersChunkData :: GuildMembersChunkData -> [Member]
members :: [Member]
members, Snowflake Guild
$sel:guildID:GuildMembersChunkData :: GuildMembersChunkData -> Snowflake Guild
guildID :: Snowflake Guild
guildID}) = do
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just Guild
guild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  let memberIDs :: [Snowflake Member]
memberIDs = forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Member) [Member]
members
  let members' :: [IxValue (SnowflakeMap Member)]
members' = forall (a :: OpticKind) (b :: OpticKind).
(a -> Maybe b) -> [a] -> [b]
mapMaybe (\Snowflake Member
mid -> Guild
guild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "members" a => a
#members forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Snowflake Member
mid) [Snowflake Member]
memberIDs
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
guild, [IxValue (SnowflakeMap Member)]
members')) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildMembersChunkEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildRoleCreate GuildRoleData {Snowflake Guild
$sel:guildID:GuildRoleData :: GuildRoleData -> Snowflake Guild
guildID :: Snowflake Guild
guildID, Role
$sel:role:GuildRoleData :: GuildRoleData -> Role
role :: Role
role}) = do
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just Guild
guild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  Just IxValue (SnowflakeMap Role)
role' <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Guild
guild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "roles" a => a
#roles forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID Role
role)
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
guild, IxValue (SnowflakeMap Role)
role')) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildRoleCreateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildRoleUpdate GuildRoleData {Snowflake Guild
guildID :: Snowflake Guild
$sel:guildID:GuildRoleData :: GuildRoleData -> Snowflake Guild
guildID, Role
role :: Role
$sel:role:GuildRoleData :: GuildRoleData -> Role
role}) = do
  Just Guild
oldGuild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  Just IxValue (SnowflakeMap Role)
oldRole <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Guild
oldGuild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "roles" a => a
#roles forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID Role
role)
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just Guild
newGuild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  Just IxValue (SnowflakeMap Role)
newRole <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Guild
newGuild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "roles" a => a
#roles forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID Role
role)
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
newGuild, IxValue (SnowflakeMap Role)
oldRole, IxValue (SnowflakeMap Role)
newRole)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildRoleUpdateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(GuildRoleDelete GuildRoleDeleteData {Snowflake Guild
$sel:guildID:GuildRoleDeleteData :: GuildRoleDeleteData -> Snowflake Guild
guildID :: Snowflake Guild
guildID, Snowflake Role
$sel:roleID:GuildRoleDeleteData :: GuildRoleDeleteData -> Snowflake Role
roleID :: Snowflake Role
roleID}) = do
  Just Guild
guild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  Just IxValue (SnowflakeMap Role)
role <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Guild
guild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "roles" a => a
#roles forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Snowflake Role
roleID
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
guild, IxValue (SnowflakeMap Role)
role)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildRoleDeleteEvt EventHandlers
eh)
handleEvent' EventHandlers
eh (InviteCreate InviteCreateData
d) = do
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ InviteCreateData
d) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'InviteCreateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh (InviteDelete InviteDeleteData
d) = do
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ InviteDeleteData
d) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'InviteDeleteEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(MessageCreate Message
msg Maybe User
user Maybe Member
member) = do
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Message
msg, Maybe User
user, Maybe Member
member)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'MessageCreateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(MessageUpdate UpdatedMessage
msg Maybe User
user Maybe Member
member) = do
  Maybe Message
oldMsg <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Message -> Sem r (Maybe Message)
getMessage (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID UpdatedMessage
msg)
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Maybe Message
newMsg <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Message -> Sem r (Maybe Message)
getMessage (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID UpdatedMessage
msg)
  let rawActions :: [IO ()]
rawActions = forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (UpdatedMessage
msg, Maybe User
user, Maybe Member
member)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'RawMessageUpdateEvt EventHandlers
eh)
  let actions :: [IO ()]
actions = case (Maybe Message
oldMsg, Maybe Message
newMsg) of
        (Just Message
oldMsg', Just Message
newMsg') ->
          forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Message
oldMsg', Message
newMsg', Maybe User
user, Maybe Member
member)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'MessageUpdateEvt EventHandlers
eh)
        (Maybe Message, Maybe Message)
_ -> []
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [IO ()]
rawActions forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [IO ()]
actions
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(MessageDelete MessageDeleteData {Snowflake Message
$sel:id:MessageDeleteData :: MessageDeleteData -> Snowflake Message
id :: Snowflake Message
id}) = do
  Maybe Message
oldMsg <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Message -> Sem r (Maybe Message)
getMessage Snowflake Message
id
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  let rawActions :: [IO ()]
rawActions = forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Snowflake Message
id) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'RawMessageDeleteEvt EventHandlers
eh)
  let actions :: [IO ()]
actions = case Maybe Message
oldMsg of
        Just Message
oldMsg' ->
          forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Message
oldMsg') (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'MessageDeleteEvt EventHandlers
eh)
        Maybe Message
_ -> []
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [IO ()]
rawActions forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [IO ()]
actions
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(MessageDeleteBulk MessageDeleteBulkData {[Snowflake Message]
$sel:ids:MessageDeleteBulkData :: MessageDeleteBulkData -> [Snowflake Message]
ids :: [Snowflake Message]
ids}) = do
  [Message]
messages <- forall (a :: OpticKind). [Maybe a] -> [a]
catMaybes forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (t :: OpticKind -> OpticKind) (f :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Message -> Sem r (Maybe Message)
getMessage [Snowflake Message]
ids
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  let rawActions :: [IO ()]
rawActions = forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [Snowflake Message]
ids) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'RawMessageDeleteBulkEvt EventHandlers
eh)
  let actions :: [IO ()]
actions = forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [Message]
messages) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'MessageDeleteBulkEvt EventHandlers
eh)
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [IO ()]
rawActions forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [IO ()]
actions
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(MessageReactionAdd ReactionEvtData
reaction) = do
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Maybe Message
msg <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Message -> Sem r (Maybe Message)
getMessage (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID ReactionEvtData
reaction)
  Maybe User
user <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake User -> Sem r (Maybe User)
getUser (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID ReactionEvtData
reaction)
  Maybe Channel
chan <- case ReactionEvtData
reaction forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "guildID" a => a
#guildID of
    Just Snowflake Guild
_ -> do
      Maybe GuildChannel
chan <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake GuildChannel -> Sem r (Maybe GuildChannel)
getGuildChannel (forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Channel ReactionEvtData
reaction)
      forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (GuildChannel -> Channel
GuildChannel' forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Maybe GuildChannel
chan)
    Maybe (Snowflake Guild)
Nothing -> do
      Maybe DMChannel
chan <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake DMChannel -> Sem r (Maybe DMChannel)
getDM (forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Channel ReactionEvtData
reaction)
      forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (DMChannel -> Channel
DMChannel' forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Maybe DMChannel
chan)
  let rawActions :: [IO ()]
rawActions = forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ReactionEvtData
reaction) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'RawMessageReactionAddEvt EventHandlers
eh)
  let actions :: [IO ()]
actions = case (Maybe Message
msg, Maybe User
user, Maybe Channel
chan) of
        (Just Message
msg', Just User
user', Just Channel
chan') ->
          forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Message
msg', User
user', Channel
chan', ReactionEvtData
reaction forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "emoji" a => a
#emoji)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'MessageReactionAddEvt EventHandlers
eh)
        (Maybe Message, Maybe User, Maybe Channel)
_ -> []
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [IO ()]
rawActions forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [IO ()]
actions
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(MessageReactionRemove ReactionEvtData
reaction) = do
  Maybe Message
msg <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Message -> Sem r (Maybe Message)
getMessage (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID ReactionEvtData
reaction)
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Maybe User
user <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake User -> Sem r (Maybe User)
getUser (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID ReactionEvtData
reaction)
  Maybe Channel
chan <- case ReactionEvtData
reaction forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "guildID" a => a
#guildID of
    Just Snowflake Guild
_ -> do
      Maybe GuildChannel
chan <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake GuildChannel -> Sem r (Maybe GuildChannel)
getGuildChannel (forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Channel ReactionEvtData
reaction)
      forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (GuildChannel -> Channel
GuildChannel' forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Maybe GuildChannel
chan)
    Maybe (Snowflake Guild)
Nothing -> do
      Maybe DMChannel
chan <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake DMChannel -> Sem r (Maybe DMChannel)
getDM (forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Channel ReactionEvtData
reaction)
      forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (DMChannel -> Channel
DMChannel' forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Maybe DMChannel
chan)
  let rawActions :: [IO ()]
rawActions = forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ReactionEvtData
reaction) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'RawMessageReactionRemoveEvt EventHandlers
eh)
  let actions :: [IO ()]
actions = case (Maybe Message
msg, Maybe User
user, Maybe Channel
chan) of
        (Just Message
msg', Just User
user', Just Channel
chan') ->
          forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Message
msg', User
user', Channel
chan', ReactionEvtData
reaction forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "emoji" a => a
#emoji)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'MessageReactionRemoveEvt EventHandlers
eh)
        (Maybe Message, Maybe User, Maybe Channel)
_ -> []
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [IO ()]
rawActions forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [IO ()]
actions
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(MessageReactionRemoveAll MessageReactionRemoveAllData {Snowflake Message
$sel:messageID:MessageReactionRemoveAllData :: MessageReactionRemoveAllData -> Snowflake Message
messageID :: Snowflake Message
messageID}) = do
  Maybe Message
msg <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Message -> Sem r (Maybe Message)
getMessage Snowflake Message
messageID
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  let rawActions :: [IO ()]
rawActions = forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Snowflake Message
messageID) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'RawMessageReactionRemoveAllEvt EventHandlers
eh)
  let actions :: [IO ()]
actions = case Maybe Message
msg of
        Just Message
msg' ->
          forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Message
msg') (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'MessageReactionRemoveAllEvt EventHandlers
eh)
        Maybe Message
_ -> []
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [IO ()]
rawActions forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [IO ()]
actions
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(PresenceUpdate PresenceUpdateData {Snowflake User
$sel:userID:PresenceUpdateData :: PresenceUpdateData -> Snowflake User
userID :: Snowflake User
userID, $sel:presence:PresenceUpdateData :: PresenceUpdateData -> Presence
presence = Presence {Snowflake Guild
$sel:guildID:Presence :: Presence -> Snowflake Guild
guildID :: Snowflake Guild
guildID}}) = do
  Just Guild
oldGuild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  Just Member
oldMember <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Guild
oldGuild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "members" a => a
#members forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake Snowflake User
userID)
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just Guild
newGuild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  Just Member
newMember <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Guild
newGuild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "members" a => a
#members forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake Snowflake User
userID)
  let User
oldUser :: User = let Member {Bool
Maybe Bool
Maybe Word64
Maybe Text
Maybe (Colour Double)
Maybe UserBanner
UTCTime
Text
Vector (Snowflake Role)
Snowflake User
Avatar
$sel:mute:Member :: Member -> Bool
$sel:deaf:Member :: Member -> Bool
$sel:joinedAt:Member :: Member -> UTCTime
$sel:roles:Member :: Member -> Vector (Snowflake Role)
$sel:nick:Member :: Member -> Maybe Text
$sel:premiumType:Member :: Member -> Maybe Word64
$sel:flags:Member :: Member -> Maybe Word64
$sel:email:Member :: Member -> Maybe Text
$sel:verified:Member :: Member -> Maybe Bool
$sel:locale:Member :: Member -> Maybe Text
$sel:accentColour:Member :: Member -> Maybe (Colour Double)
$sel:banner:Member :: Member -> Maybe UserBanner
$sel:mfaEnabled:Member :: Member -> Maybe Bool
$sel:memberAvatar:Member :: Member -> Maybe Text
$sel:avatar:Member :: Member -> Avatar
$sel:bot:Member :: Member -> Maybe Bool
$sel:discriminator:Member :: Member -> Text
$sel:username:Member :: Member -> Text
$sel:id:Member :: Member -> Snowflake User
mute :: Bool
deaf :: Bool
joinedAt :: UTCTime
roles :: Vector (Snowflake Role)
nick :: Maybe Text
premiumType :: Maybe Word64
flags :: Maybe Word64
email :: Maybe Text
verified :: Maybe Bool
locale :: Maybe Text
accentColour :: Maybe (Colour Double)
banner :: Maybe UserBanner
mfaEnabled :: Maybe Bool
memberAvatar :: Maybe Text
avatar :: Avatar
bot :: Maybe Bool
discriminator :: Text
username :: Text
id :: Snowflake User
..} = Member
oldMember in User {Maybe Bool
Maybe Word64
Maybe Text
Maybe (Colour Double)
Maybe UserBanner
Text
Snowflake User
Avatar
$sel:premiumType:User :: Maybe Word64
$sel:flags:User :: Maybe Word64
$sel:email:User :: Maybe Text
$sel:verified:User :: Maybe Bool
$sel:locale:User :: Maybe Text
$sel:accentColour:User :: Maybe (Colour Double)
$sel:banner:User :: Maybe UserBanner
$sel:mfaEnabled:User :: Maybe Bool
$sel:avatar:User :: Avatar
$sel:bot:User :: Maybe Bool
$sel:discriminator:User :: Text
$sel:username:User :: Text
$sel:id:User :: Snowflake User
premiumType :: Maybe Word64
flags :: Maybe Word64
email :: Maybe Text
verified :: Maybe Bool
locale :: Maybe Text
accentColour :: Maybe (Colour Double)
banner :: Maybe UserBanner
mfaEnabled :: Maybe Bool
avatar :: Avatar
bot :: Maybe Bool
discriminator :: Text
username :: Text
id :: Snowflake User
..}
      User
newUser :: User = let Member {Bool
Maybe Bool
Maybe Word64
Maybe Text
Maybe (Colour Double)
Maybe UserBanner
UTCTime
Text
Vector (Snowflake Role)
Snowflake User
Avatar
mute :: Bool
deaf :: Bool
joinedAt :: UTCTime
roles :: Vector (Snowflake Role)
nick :: Maybe Text
premiumType :: Maybe Word64
flags :: Maybe Word64
email :: Maybe Text
verified :: Maybe Bool
locale :: Maybe Text
accentColour :: Maybe (Colour Double)
banner :: Maybe UserBanner
mfaEnabled :: Maybe Bool
memberAvatar :: Maybe Text
avatar :: Avatar
bot :: Maybe Bool
discriminator :: Text
username :: Text
id :: Snowflake User
$sel:mute:Member :: Member -> Bool
$sel:deaf:Member :: Member -> Bool
$sel:joinedAt:Member :: Member -> UTCTime
$sel:roles:Member :: Member -> Vector (Snowflake Role)
$sel:nick:Member :: Member -> Maybe Text
$sel:premiumType:Member :: Member -> Maybe Word64
$sel:flags:Member :: Member -> Maybe Word64
$sel:email:Member :: Member -> Maybe Text
$sel:verified:Member :: Member -> Maybe Bool
$sel:locale:Member :: Member -> Maybe Text
$sel:accentColour:Member :: Member -> Maybe (Colour Double)
$sel:banner:Member :: Member -> Maybe UserBanner
$sel:mfaEnabled:Member :: Member -> Maybe Bool
$sel:memberAvatar:Member :: Member -> Maybe Text
$sel:avatar:Member :: Member -> Avatar
$sel:bot:Member :: Member -> Maybe Bool
$sel:discriminator:Member :: Member -> Text
$sel:username:Member :: Member -> Text
$sel:id:Member :: Member -> Snowflake User
..} = Member
newMember in User {Maybe Bool
Maybe Word64
Maybe Text
Maybe (Colour Double)
Maybe UserBanner
Text
Snowflake User
Avatar
premiumType :: Maybe Word64
flags :: Maybe Word64
email :: Maybe Text
verified :: Maybe Bool
locale :: Maybe Text
accentColour :: Maybe (Colour Double)
banner :: Maybe UserBanner
mfaEnabled :: Maybe Bool
avatar :: Avatar
bot :: Maybe Bool
discriminator :: Text
username :: Text
id :: Snowflake User
$sel:premiumType:User :: Maybe Word64
$sel:flags:User :: Maybe Word64
$sel:email:User :: Maybe Text
$sel:verified:User :: Maybe Bool
$sel:locale:User :: Maybe Text
$sel:accentColour:User :: Maybe (Colour Double)
$sel:banner:User :: Maybe UserBanner
$sel:mfaEnabled:User :: Maybe Bool
$sel:avatar:User :: Avatar
$sel:bot:User :: Maybe Bool
$sel:discriminator:User :: Text
$sel:username:User :: Text
$sel:id:User :: Snowflake User
..}
      userUpdates :: [IO ()]
userUpdates =
        if User
oldUser forall (a :: OpticKind). Eq a => a -> a -> Bool
/= User
newUser
          then forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (User
oldUser, User
newUser)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'UserUpdateEvt EventHandlers
eh)
          else forall (a :: OpticKind). Monoid a => a
mempty
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [IO ()]
userUpdates forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild
newGuild, Member
oldMember, Member
newMember)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'GuildMemberUpdateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh (TypingStart TypingStartData {Snowflake Channel
$sel:channelID:TypingStartData :: TypingStartData -> Snowflake Channel
channelID :: Snowflake Channel
channelID, Maybe (Snowflake Guild)
$sel:guildID:TypingStartData :: TypingStartData -> Maybe (Snowflake Guild)
guildID :: Maybe (Snowflake Guild)
guildID, Snowflake User
$sel:userID:TypingStartData :: TypingStartData -> Snowflake User
userID :: Snowflake User
userID, $sel:timestamp:TypingStartData :: TypingStartData -> UnixTimestamp
timestamp = UnixTimestamp UTCTime
timestamp}) =
  case Maybe (Snowflake Guild)
guildID of
    Just Snowflake Guild
gid -> do
      Just Guild
guild <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
gid
      Just Channel
chan <- forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ GuildChannel -> Channel
GuildChannel' forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Guild
guild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "channels" a => a
#channels forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake Snowflake Channel
channelID)
      forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Channel
chan, Snowflake User
userID, UTCTime
timestamp)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'TypingStartEvt EventHandlers
eh)
    Maybe (Snowflake Guild)
Nothing -> do
      Just Channel
chan <- DMChannel -> Channel
DMChannel' forall (f :: OpticKind -> OpticKind) (g :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> forall (r :: EffectRow).
Member CacheEff r =>
Snowflake DMChannel -> Sem r (Maybe DMChannel)
getDM (forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake Snowflake Channel
channelID)
      forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Channel
chan, Snowflake User
userID, UTCTime
timestamp)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'TypingStartEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(UserUpdate User
_) = do
  Just User
oldUser <- forall (r :: EffectRow). Member CacheEff r => Sem r (Maybe User)
getBotUser
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  Just User
newUser <- forall (r :: EffectRow). Member CacheEff r => Sem r (Maybe User)
getBotUser
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (User
oldUser, User
newUser)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'UserUpdateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(VoiceStateUpdate newVoiceState :: VoiceState
newVoiceState@V.VoiceState {$sel:guildID:VoiceState :: VoiceState -> Maybe (Snowflake Guild)
guildID = Just Snowflake Guild
guildID}) = do
  Maybe VoiceState
oldVoiceState <- ((forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
(a -> Bool) -> t a -> Maybe a
find ((forall (a :: OpticKind). Eq a => a -> a -> Bool
== VoiceState -> Text
V.sessionID VoiceState
newVoiceState) forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. VoiceState -> Text
V.sessionID) forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Guild -> [VoiceState]
voiceStates) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Monad m =>
(a -> m b) -> m a -> m b
=<<) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
guildID
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Maybe VoiceState
oldVoiceState, VoiceState
newVoiceState)) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'VoiceStateUpdateEvt EventHandlers
eh)
handleEvent' EventHandlers
eh evt :: DispatchData
evt@(InteractionCreate Interaction
interaction) = do
  forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache DispatchData
evt
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Interaction
interaction) (forall (a :: EventType).
GetEventHandlers a =>
EventHandlers -> [StoredEHType a]
getEventHandlers @'InteractionEvt EventHandlers
eh)
handleEvent' EventHandlers
_ DispatchData
e = forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadFail m =>
String -> m a
fail forall (a :: OpticKind) b. (a -> b) -> a -> b
$ String
"Unhandled event: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> String
show DispatchData
e

updateCache :: P.Members '[CacheEff, P.Fail] r => DispatchData -> P.Sem r ()
updateCache :: forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache (Ready ReadyData {User
$sel:user:ReadyData :: ReadyData -> User
user :: User
user, [UnavailableGuild]
$sel:guilds:ReadyData :: ReadyData -> [UnavailableGuild]
guilds :: [UnavailableGuild]
guilds}) = do
  forall (r :: EffectRow). Member CacheEff r => User -> Sem r ()
setBotUser User
user
  forall (t :: OpticKind -> OpticKind) (f :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID [UnavailableGuild]
guilds) forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r ()
setUnavailableGuild
updateCache DispatchData
Resumed = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
updateCache (ChannelCreate (DMChannel' DMChannel
chan)) =
  forall (r :: EffectRow). Member CacheEff r => DMChannel -> Sem r ()
setDM DMChannel
chan
updateCache (ChannelCreate (GuildChannel' GuildChannel
chan)) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID GuildChannel
chan) (forall (a :: OpticKind). IsLabel "channels" a => a
#channels forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (a :: OpticKind).
HasID' a =>
a -> SnowflakeMap a -> SnowflakeMap a
SM.insert GuildChannel
chan)
updateCache (ChannelUpdate (DMChannel' DMChannel
chan)) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake DMChannel -> (DMChannel -> DMChannel) -> Sem r ()
updateDM (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID DMChannel
chan) (forall (a :: OpticKind). Updateable a => Updated a -> a -> a
update DMChannel
chan)
updateCache (ChannelUpdate (GuildChannel' GuildChannel
chan)) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID GuildChannel
chan) (forall (a :: OpticKind). IsLabel "channels" a => a
#channels forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID GuildChannel
chan) forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (a :: OpticKind). Updateable a => Updated a -> a -> a
update GuildChannel
chan)
updateCache (ChannelDelete (DMChannel' DMChannel
chan)) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake DMChannel -> Sem r ()
delDM (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID DMChannel
chan)
updateCache (ChannelDelete (GuildChannel' GuildChannel
chan)) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID GuildChannel
chan) (forall (a :: OpticKind). IsLabel "channels" a => a
#channels forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (m :: OpticKind). At m => Index m -> m -> m
sans (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID GuildChannel
chan))
updateCache (GuildCreate Guild
guild) = do
  Bool
isNew <- forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r Bool
isUnavailableGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID Guild
guild)
  forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
when Bool
isNew forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r ()
delUnavailableGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID Guild
guild)
  forall (r :: EffectRow). Member CacheEff r => Guild -> Sem r ()
setGuild Guild
guild
  forall (t :: OpticKind -> OpticKind) (f :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall (a :: OpticKind). SnowflakeMap a -> [a]
SM.elems (Guild
guild forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "members" a => a
#members)) (\Member {Bool
Maybe Bool
Maybe Word64
Maybe Text
Maybe (Colour Double)
Maybe UserBanner
UTCTime
Text
Vector (Snowflake Role)
Snowflake User
Avatar
mute :: Bool
deaf :: Bool
joinedAt :: UTCTime
roles :: Vector (Snowflake Role)
nick :: Maybe Text
premiumType :: Maybe Word64
flags :: Maybe Word64
email :: Maybe Text
verified :: Maybe Bool
locale :: Maybe Text
accentColour :: Maybe (Colour Double)
banner :: Maybe UserBanner
mfaEnabled :: Maybe Bool
memberAvatar :: Maybe Text
avatar :: Avatar
bot :: Maybe Bool
discriminator :: Text
username :: Text
id :: Snowflake User
$sel:mute:Member :: Member -> Bool
$sel:deaf:Member :: Member -> Bool
$sel:joinedAt:Member :: Member -> UTCTime
$sel:roles:Member :: Member -> Vector (Snowflake Role)
$sel:nick:Member :: Member -> Maybe Text
$sel:premiumType:Member :: Member -> Maybe Word64
$sel:flags:Member :: Member -> Maybe Word64
$sel:email:Member :: Member -> Maybe Text
$sel:verified:Member :: Member -> Maybe Bool
$sel:locale:Member :: Member -> Maybe Text
$sel:accentColour:Member :: Member -> Maybe (Colour Double)
$sel:banner:Member :: Member -> Maybe UserBanner
$sel:mfaEnabled:Member :: Member -> Maybe Bool
$sel:memberAvatar:Member :: Member -> Maybe Text
$sel:avatar:Member :: Member -> Avatar
$sel:bot:Member :: Member -> Maybe Bool
$sel:discriminator:Member :: Member -> Text
$sel:username:Member :: Member -> Text
$sel:id:Member :: Member -> Snowflake User
..} -> forall (r :: EffectRow). Member CacheEff r => User -> Sem r ()
setUser User {Maybe Bool
Maybe Word64
Maybe Text
Maybe (Colour Double)
Maybe UserBanner
Text
Snowflake User
Avatar
premiumType :: Maybe Word64
flags :: Maybe Word64
email :: Maybe Text
verified :: Maybe Bool
locale :: Maybe Text
accentColour :: Maybe (Colour Double)
banner :: Maybe UserBanner
mfaEnabled :: Maybe Bool
avatar :: Avatar
bot :: Maybe Bool
discriminator :: Text
username :: Text
id :: Snowflake User
$sel:premiumType:User :: Maybe Word64
$sel:flags:User :: Maybe Word64
$sel:email:User :: Maybe Text
$sel:verified:User :: Maybe Bool
$sel:locale:User :: Maybe Text
$sel:accentColour:User :: Maybe (Colour Double)
$sel:banner:User :: Maybe UserBanner
$sel:mfaEnabled:User :: Maybe Bool
$sel:avatar:User :: Avatar
$sel:bot:User :: Maybe Bool
$sel:discriminator:User :: Text
$sel:username:User :: Text
$sel:id:User :: Snowflake User
..})
updateCache (GuildUpdate UpdatedGuild
guild) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID UpdatedGuild
guild) (forall (a :: OpticKind). Updateable a => Updated a -> a -> a
update UpdatedGuild
guild)
updateCache (GuildDelete UnavailableGuild {Snowflake Guild
id :: Snowflake Guild
$sel:id:UnavailableGuild :: UnavailableGuild -> Snowflake Guild
id, Bool
unavailable :: Bool
$sel:unavailable:UnavailableGuild :: UnavailableGuild -> Bool
unavailable}) =
  if Bool
unavailable
    then forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r ()
setUnavailableGuild Snowflake Guild
id
    else forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> Sem r ()
delGuild Snowflake Guild
id
updateCache (GuildEmojisUpdate GuildEmojisUpdateData {Snowflake Guild
guildID :: Snowflake Guild
$sel:guildID:GuildEmojisUpdateData :: GuildEmojisUpdateData -> Snowflake Guild
guildID, [Emoji]
emojis :: [Emoji]
$sel:emojis:GuildEmojisUpdateData :: GuildEmojisUpdateData -> [Emoji]
emojis}) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild Snowflake Guild
guildID (forall (a :: OpticKind). IsLabel "emojis" a => a
#emojis forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall (a :: OpticKind). HasID' a => [a] -> SnowflakeMap a
SM.fromList [Emoji]
emojis)
updateCache (GuildMemberAdd Snowflake Guild
gid Member
member) = do
  forall (r :: EffectRow). Member CacheEff r => User -> Sem r ()
setUser forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (\Member {Bool
Maybe Bool
Maybe Word64
Maybe Text
Maybe (Colour Double)
Maybe UserBanner
UTCTime
Text
Vector (Snowflake Role)
Snowflake User
Avatar
mute :: Bool
deaf :: Bool
joinedAt :: UTCTime
roles :: Vector (Snowflake Role)
nick :: Maybe Text
premiumType :: Maybe Word64
flags :: Maybe Word64
email :: Maybe Text
verified :: Maybe Bool
locale :: Maybe Text
accentColour :: Maybe (Colour Double)
banner :: Maybe UserBanner
mfaEnabled :: Maybe Bool
memberAvatar :: Maybe Text
avatar :: Avatar
bot :: Maybe Bool
discriminator :: Text
username :: Text
id :: Snowflake User
$sel:mute:Member :: Member -> Bool
$sel:deaf:Member :: Member -> Bool
$sel:joinedAt:Member :: Member -> UTCTime
$sel:roles:Member :: Member -> Vector (Snowflake Role)
$sel:nick:Member :: Member -> Maybe Text
$sel:premiumType:Member :: Member -> Maybe Word64
$sel:flags:Member :: Member -> Maybe Word64
$sel:email:Member :: Member -> Maybe Text
$sel:verified:Member :: Member -> Maybe Bool
$sel:locale:Member :: Member -> Maybe Text
$sel:accentColour:Member :: Member -> Maybe (Colour Double)
$sel:banner:Member :: Member -> Maybe UserBanner
$sel:mfaEnabled:Member :: Member -> Maybe Bool
$sel:memberAvatar:Member :: Member -> Maybe Text
$sel:avatar:Member :: Member -> Avatar
$sel:bot:Member :: Member -> Maybe Bool
$sel:discriminator:Member :: Member -> Text
$sel:username:Member :: Member -> Text
$sel:id:Member :: Member -> Snowflake User
..} -> User {Maybe Bool
Maybe Word64
Maybe Text
Maybe (Colour Double)
Maybe UserBanner
Text
Snowflake User
Avatar
premiumType :: Maybe Word64
flags :: Maybe Word64
email :: Maybe Text
verified :: Maybe Bool
locale :: Maybe Text
accentColour :: Maybe (Colour Double)
banner :: Maybe UserBanner
mfaEnabled :: Maybe Bool
avatar :: Avatar
bot :: Maybe Bool
discriminator :: Text
username :: Text
id :: Snowflake User
$sel:premiumType:User :: Maybe Word64
$sel:flags:User :: Maybe Word64
$sel:email:User :: Maybe Text
$sel:verified:User :: Maybe Bool
$sel:locale:User :: Maybe Text
$sel:accentColour:User :: Maybe (Colour Double)
$sel:banner:User :: Maybe UserBanner
$sel:mfaEnabled:User :: Maybe Bool
$sel:avatar:User :: Avatar
$sel:bot:User :: Maybe Bool
$sel:discriminator:User :: Text
$sel:username:User :: Text
$sel:id:User :: Snowflake User
..}) Member
member
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild Snowflake Guild
gid (forall (a :: OpticKind). IsLabel "members" a => a
#members forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID Member
member) forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Member
member)
updateCache (GuildMemberRemove GuildMemberRemoveData {Snowflake Guild
guildID :: Snowflake Guild
$sel:guildID:GuildMemberRemoveData :: GuildMemberRemoveData -> Snowflake Guild
guildID, User
user :: User
$sel:user:GuildMemberRemoveData :: GuildMemberRemoveData -> User
user}) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild Snowflake Guild
guildID (forall (a :: OpticKind). IsLabel "members" a => a
#members forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (m :: OpticKind). At m => Index m -> m -> m
sans (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID User
user))
updateCache (GuildMemberUpdate GuildMemberUpdateData {Snowflake Guild
guildID :: Snowflake Guild
$sel:guildID:GuildMemberUpdateData :: GuildMemberUpdateData -> Snowflake Guild
guildID, $sel:roles:GuildMemberUpdateData :: GuildMemberUpdateData -> AesonVector (Snowflake Role)
roles = AesonVector Vector (Snowflake Role)
roles, User
user :: User
$sel:user:GuildMemberUpdateData :: GuildMemberUpdateData -> User
user, Maybe Text
$sel:nick:GuildMemberUpdateData :: GuildMemberUpdateData -> Maybe Text
nick :: Maybe Text
nick}) = do
  forall (r :: EffectRow). Member CacheEff r => User -> Sem r ()
setUser User
user
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild Snowflake Guild
guildID (forall (a :: OpticKind). IsLabel "members" a => a
#members forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID User
user) forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall (a :: OpticKind). IsLabel "roles" a => a
#roles forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Vector (Snowflake Role)
roles) forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. (forall (a :: OpticKind). IsLabel "nick" a => a
#nick forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Maybe Text
nick))
updateCache (GuildMembersChunk GuildMembersChunkData {Snowflake Guild
guildID :: Snowflake Guild
$sel:guildID:GuildMembersChunkData :: GuildMembersChunkData -> Snowflake Guild
guildID, [Member]
members :: [Member]
$sel:members:GuildMembersChunkData :: GuildMembersChunkData -> [Member]
members}) =
  forall (t :: OpticKind -> OpticKind) (f :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (r :: EffectRow).
Members '[CacheEff, Fail] r =>
DispatchData -> Sem r ()
updateCache forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Snowflake Guild -> Member -> DispatchData
GuildMemberAdd Snowflake Guild
guildID) [Member]
members
updateCache (GuildRoleCreate GuildRoleData {Snowflake Guild
guildID :: Snowflake Guild
$sel:guildID:GuildRoleData :: GuildRoleData -> Snowflake Guild
guildID, Role
role :: Role
$sel:role:GuildRoleData :: GuildRoleData -> Role
role}) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild Snowflake Guild
guildID (forall (a :: OpticKind). IsLabel "roles" a => a
#roles forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (a :: OpticKind).
HasID' a =>
a -> SnowflakeMap a -> SnowflakeMap a
SM.insert Role
role)
updateCache (GuildRoleUpdate GuildRoleData {Snowflake Guild
guildID :: Snowflake Guild
$sel:guildID:GuildRoleData :: GuildRoleData -> Snowflake Guild
guildID, Role
role :: Role
$sel:role:GuildRoleData :: GuildRoleData -> Role
role}) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild Snowflake Guild
guildID (forall (a :: OpticKind). IsLabel "roles" a => a
#roles forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (a :: OpticKind).
HasID' a =>
a -> SnowflakeMap a -> SnowflakeMap a
SM.insert Role
role)
updateCache (GuildRoleDelete GuildRoleDeleteData {Snowflake Guild
guildID :: Snowflake Guild
$sel:guildID:GuildRoleDeleteData :: GuildRoleDeleteData -> Snowflake Guild
guildID, Snowflake Role
roleID :: Snowflake Role
$sel:roleID:GuildRoleDeleteData :: GuildRoleDeleteData -> Snowflake Role
roleID}) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild Snowflake Guild
guildID (forall (a :: OpticKind). IsLabel "roles" a => a
#roles forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (m :: OpticKind). At m => Index m -> m -> m
sans Snowflake Role
roleID)
updateCache (MessageCreate !Message
msg !Maybe User
user !Maybe Member
_) = do
  forall (r :: EffectRow). Member CacheEff r => Message -> Sem r ()
setMessage Message
msg
  forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe User
user forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \User
u ->
    forall (r :: EffectRow). Member CacheEff r => User -> Sem r ()
setUser User
u
updateCache (MessageUpdate UpdatedMessage
msg !Maybe User
_ !Maybe Member
_) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Message -> (Message -> Message) -> Sem r ()
updateMessage (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID UpdatedMessage
msg) (forall (a :: OpticKind). Updateable a => Updated a -> a -> a
update UpdatedMessage
msg)
updateCache (MessageDelete MessageDeleteData {Snowflake Message
id :: Snowflake Message
$sel:id:MessageDeleteData :: MessageDeleteData -> Snowflake Message
id}) = forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Message -> Sem r ()
delMessage Snowflake Message
id
updateCache (MessageDeleteBulk MessageDeleteBulkData {[Snowflake Message]
ids :: [Snowflake Message]
$sel:ids:MessageDeleteBulkData :: MessageDeleteBulkData -> [Snowflake Message]
ids}) =
  forall (t :: OpticKind -> OpticKind) (f :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Snowflake Message]
ids forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Message -> Sem r ()
delMessage
updateCache (MessageReactionAdd ReactionEvtData
reaction) = do
  Bool
isMe <- (\Maybe User
u -> forall (a :: OpticKind). a -> Maybe a
Just (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @User ReactionEvtData
reaction) forall (a :: OpticKind). Eq a => a -> a -> Bool
== (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @User forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Maybe User
u)) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (r :: EffectRow). Member CacheEff r => Sem r (Maybe User)
getBotUser
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Message -> (Message -> Message) -> Sem r ()
updateMessage
    (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID ReactionEvtData
reaction)
    ( \Message
m ->
        case Message
m forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "reactions" a => a
#reactions forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (a :: OpticKind). (a -> Bool) -> [a] -> [a]
filter ((forall (a :: OpticKind). Eq a => a -> a -> Bool
== (ReactionEvtData
reaction forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "emoji" a => a
#emoji)) forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. (forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "emoji" a => a
#emoji)) of
          [] -> Message
m forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (a :: OpticKind). IsLabel "reactions" a => a
#reactions forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [Integer -> Bool -> RawEmoji -> Reaction
Reaction Integer
1 Bool
isMe (ReactionEvtData
reaction forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "emoji" a => a
#emoji)])
          [Reaction]
_ ->
            Message
m forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (a :: OpticKind). IsLabel "reactions" a => a
#reactions forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (t :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Traversable t =>
Traversal (t a) (t b) a b
traversed forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ Bool -> RawEmoji -> Reaction -> Reaction
updateReactionAdd Bool
isMe (ReactionEvtData
reaction forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "emoji" a => a
#emoji)
    )
updateCache (MessageReactionRemove ReactionEvtData
reaction) = do
  Bool
isMe <- (\Maybe User
u -> forall (a :: OpticKind). a -> Maybe a
Just (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @User ReactionEvtData
reaction) forall (a :: OpticKind). Eq a => a -> a -> Bool
== (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @User forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Maybe User
u)) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (r :: EffectRow). Member CacheEff r => Sem r (Maybe User)
getBotUser
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Message -> (Message -> Message) -> Sem r ()
updateMessage
    (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID ReactionEvtData
reaction)
    ( \Message
m ->
        Message
m
          forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (a :: OpticKind). IsLabel "reactions" a => a
#reactions forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (t :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Traversable t =>
Traversal (t a) (t b) a b
traversed forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ Bool -> RawEmoji -> Reaction -> Reaction
updateReactionRemove Bool
isMe (ReactionEvtData
reaction forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "emoji" a => a
#emoji)
          forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (a :: OpticKind). IsLabel "reactions" a => a
#reactions forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (a :: OpticKind). (a -> Bool) -> [a] -> [a]
filter (\Reaction
r -> Reaction
r forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "count" a => a
#count forall (a :: OpticKind). Eq a => a -> a -> Bool
/= Integer
0)
    )
updateCache (MessageReactionRemoveAll MessageReactionRemoveAllData {Snowflake Message
messageID :: Snowflake Message
$sel:messageID:MessageReactionRemoveAllData :: MessageReactionRemoveAllData -> Snowflake Message
messageID}) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Message -> (Message -> Message) -> Sem r ()
updateMessage Snowflake Message
messageID (forall (a :: OpticKind). IsLabel "reactions" a => a
#reactions forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall (a :: OpticKind). Monoid a => a
mempty)
updateCache (PresenceUpdate PresenceUpdateData {Snowflake User
userID :: Snowflake User
$sel:userID:PresenceUpdateData :: PresenceUpdateData -> Snowflake User
userID, Presence
presence :: Presence
$sel:presence:PresenceUpdateData :: PresenceUpdateData -> Presence
presence}) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID Presence
presence) (forall (a :: OpticKind). IsLabel "presences" a => a
#presences forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Snowflake User
userID forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Presence
presence)
updateCache (UserUpdate User
user) = forall (r :: EffectRow). Member CacheEff r => User -> Sem r ()
setBotUser User
user
-- we don't handle group channels currently
updateCache (ChannelCreate (GroupChannel' GroupChannel
_)) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
updateCache (ChannelUpdate (GroupChannel' GroupChannel
_)) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
updateCache (ChannelDelete (GroupChannel' GroupChannel
_)) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
-- these don't modify state
updateCache (GuildBanAdd BanData
_) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
updateCache (GuildBanRemove BanData
_) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
updateCache (GuildIntegrationsUpdate GuildIntegrationsUpdateData
_) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
updateCache (TypingStart TypingStartData
_) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
updateCache (ChannelPinsUpdate ChannelPinsUpdateData
_) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
updateCache (WebhooksUpdate WebhooksUpdateData
_) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
updateCache (InviteCreate InviteCreateData
_) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
updateCache (InviteDelete InviteDeleteData
_) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
updateCache (VoiceStateUpdate voiceState :: VoiceState
voiceState@V.VoiceState {$sel:guildID:VoiceState :: VoiceState -> Maybe (Snowflake Guild)
guildID = Just Snowflake Guild
guildID}) =
  forall (r :: EffectRow).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild Snowflake Guild
guildID (forall (a :: OpticKind). IsLabel "voiceStates" a => a
#voiceStates forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ [VoiceState] -> [VoiceState]
updateVoiceStates)
  where
    updateVoiceStates :: [VoiceState] -> [VoiceState]
updateVoiceStates [] = [VoiceState
voiceState]
    updateVoiceStates (VoiceState
x : [VoiceState]
xs)
      | VoiceState -> Text
V.sessionID VoiceState
x forall (a :: OpticKind). Eq a => a -> a -> Bool
== VoiceState -> Text
V.sessionID VoiceState
voiceState = VoiceState
voiceState forall (a :: OpticKind). a -> [a] -> [a]
: [VoiceState]
xs
      | Bool
otherwise = VoiceState
x forall (a :: OpticKind). a -> [a] -> [a]
: [VoiceState] -> [VoiceState]
updateVoiceStates [VoiceState]
xs

-- we don't handle voice server update and direct voice connections currently
updateCache (VoiceStateUpdate V.VoiceState {$sel:guildID:VoiceState :: VoiceState -> Maybe (Snowflake Guild)
guildID = Maybe (Snowflake Guild)
Nothing}) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
updateCache (VoiceServerUpdate VoiceServerUpdateData
_) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
-- we don't update the cache from interactions
-- TODO: should we?
updateCache (InteractionCreate Interaction
_) = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()

updateReactionAdd :: Bool -> RawEmoji -> Reaction -> Reaction
updateReactionAdd :: Bool -> RawEmoji -> Reaction -> Reaction
updateReactionAdd Bool
isMe RawEmoji
emoji Reaction
reaction =
  if RawEmoji
emoji forall (a :: OpticKind). Eq a => a -> a -> Bool
== Reaction
reaction forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "emoji" a => a
#emoji
    then
      Reaction
reaction forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (a :: OpticKind). IsLabel "count" a => a
#count forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (a :: OpticKind). Enum a => a -> a
succ
        forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (a :: OpticKind). IsLabel "me" a => a
#me forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Bool -> Bool -> Bool
|| Bool
isMe)
    else Reaction
reaction

updateReactionRemove :: Bool -> RawEmoji -> Reaction -> Reaction
updateReactionRemove :: Bool -> RawEmoji -> Reaction -> Reaction
updateReactionRemove Bool
isMe RawEmoji
emoji Reaction
reaction =
  if RawEmoji
emoji forall (a :: OpticKind). Eq a => a -> a -> Bool
== Reaction
reaction forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "emoji" a => a
#emoji
    then
      Reaction
reaction forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (a :: OpticKind). IsLabel "count" a => a
#count forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (a :: OpticKind). Enum a => a -> a
pred
        forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (a :: OpticKind). IsLabel "me" a => a
#me forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isMe)
    else Reaction
reaction