diff options
| author | Adelyn Breedlove <[email protected]> | 2019-02-11 17:23:59 +0000 |
|---|---|---|
| committer | Adelyn Breedlove <[email protected]> | 2019-02-11 17:23:59 +0000 |
| commit | 7c9b809078b5cd53e3d54c0004c683da2ec679af (patch) | |
| tree | 5a1b165b597fc1ad4167115d9a23b12852a4636b /lib/models/event_models.ml | |
| parent | Merge branch 'sharder_fixes' into 'master' (diff) | |
| download | disml-7c9b809078b5cd53e3d54c0004c683da2ec679af.tar.xz disml-7c9b809078b5cd53e3d54c0004c683da2ec679af.zip | |
Add a cache
Diffstat (limited to 'lib/models/event_models.ml')
| -rw-r--r-- | lib/models/event_models.ml | 605 |
1 files changed, 450 insertions, 155 deletions
diff --git a/lib/models/event_models.ml b/lib/models/event_models.ml index 2dba4a4..542572f 100644 --- a/lib/models/event_models.ml +++ b/lib/models/event_models.ml @@ -1,250 +1,523 @@ open Core
module ChannelCreate = struct
- type t = {
- channel: Channel_t.t;
- } [@@deriving sexp]
+ type t = Channel_t.t
let deserialize ev =
- let channel = Channel_t.(channel_wrapper_of_yojson_exn ev |> wrap) in
- { channel; }
+ Channel_t.(channel_wrapper_of_yojson_exn ev |> wrap)
+
+ let update_cache (cache:Cache.t) t =
+ let open Channel_t in
+ let module C = Cache.ChannelMap in
+ match t with
+ | GuildText c ->
+ let text_channels = C.update cache.text_channels c.id ~f:(function
+ | Some _ | None -> c) in
+ { cache with text_channels }
+ | GuildVoice c ->
+ let voice_channels = C.update cache.voice_channels c.id ~f:(function
+ | Some _ | None -> c) in
+ { cache with voice_channels }
+ | Category c ->
+ let categories = C.update cache.categories c.id ~f:(function
+ | Some _ | None -> c) in
+ { cache with categories }
+ | Group c ->
+ let groups = C.update cache.groups c.id ~f:(function
+ | Some _ | None -> c) in
+ { cache with groups }
+ | Private c ->
+ let private_channels = C.update cache.private_channels c.id ~f:(function
+ | Some _ | None -> c) in
+ { cache with private_channels }
end
module ChannelDelete = struct
- type t = {
- channel: Channel_t.t;
- } [@@deriving sexp]
+ type t = Channel_t.t
let deserialize ev =
- let channel = Channel_t.(channel_wrapper_of_yojson_exn ev |> wrap) in
- { channel; }
+ Channel_t.(channel_wrapper_of_yojson_exn ev |> wrap)
+
+ let update_cache (cache:Cache.t) t =
+ let open Channel_t in
+ let module C = Cache.ChannelMap in
+ match t with
+ | GuildText c ->
+ let text_channels = C.remove cache.text_channels c.id in
+ { cache with text_channels }
+ | GuildVoice c ->
+ let voice_channels = C.remove cache.voice_channels c.id in
+ { cache with voice_channels }
+ | Category c ->
+ let categories = C.remove cache.categories c.id in
+ { cache with categories }
+ | Group c ->
+ let groups = C.remove cache.groups c.id in
+ { cache with groups }
+ | Private c ->
+ let private_channels = C.remove cache.private_channels c.id in
+ { cache with private_channels }
end
module ChannelUpdate = struct
- type t = {
- channel: Channel_t.t;
- } [@@deriving sexp]
+ type t = Channel_t.t
let deserialize ev =
- let channel = Channel_t.(channel_wrapper_of_yojson_exn ev |> wrap) in
- { channel; }
+ Channel_t.(channel_wrapper_of_yojson_exn ev |> wrap)
+
+ let update_cache (cache:Cache.t) t =
+ let open Channel_t in
+ let module C = Cache.ChannelMap in
+ match t with
+ | GuildText c ->
+ let text_channels = C.update cache.text_channels c.id ~f:(function
+ | Some _ -> c
+ | None -> c) in
+ { cache with text_channels }
+ | GuildVoice c ->
+ let voice_channels = C.update cache.voice_channels c.id ~f:(function
+ | Some _ -> c
+ | None -> c) in
+ { cache with voice_channels }
+ | Category c ->
+ let categories = C.update cache.categories c.id ~f:(function
+ | Some _ -> c
+ | None -> c) in
+ { cache with categories }
+ | Group c ->
+ let groups = C.update cache.groups c.id ~f:(function
+ | Some _ -> c
+ | None -> c) in
+ { cache with groups }
+ | Private c ->
+ let private_channels = C.update cache.private_channels c.id ~f:(function
+ | Some _ -> c
+ | None -> c) in
+ { cache with private_channels }
end
module ChannelPinsUpdate = struct
- type t = {
- channel_id: Channel_id.t;
- last_pin_timestamp: string option [@default None];
+ type t =
+ { channel_id: Channel_id.t
+ ; last_pin_timestamp: string option [@default None]
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
-end
-module ChannelRecipientAdd = struct
+ let update_cache (cache:Cache.t) t =
+ let module C = Cache.ChannelMap in
+ if C.mem cache.private_channels t.channel_id then
+ let private_channels = match C.find cache.private_channels t.channel_id with
+ | Some c -> C.set cache.private_channels ~key:t.channel_id ~data:{ c with last_pin_timestamp = t.last_pin_timestamp }
+ | None -> cache.private_channels in
+ { cache with private_channels }
+ else if C.mem cache.text_channels t.channel_id then
+ let text_channels = match C.find cache.text_channels t.channel_id with
+ | Some c -> C.set cache.text_channels ~key:t.channel_id ~data:{ c with last_pin_timestamp = t.last_pin_timestamp }
+ | None -> cache.text_channels in
+ { cache with text_channels }
+ else if C.mem cache.groups t.channel_id then
+ let groups = match C.find cache.groups t.channel_id with
+ | Some c -> C.set cache.groups ~key:t.channel_id ~data:{ c with last_pin_timestamp = t.last_pin_timestamp }
+ | None -> cache.groups in
+ { cache with groups }
+ else cache
+end
+
+(* Don't see where these would get used *)
+
+(* module ChannelRecipientAdd = struct
type t = {
channel_id: Channel_id.t;
user: User_t.t;
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
-end
-module ChannelRecipientRemove = struct
+ let update_cache (cache:Cache.t) t = ()
+end *)
+
+(* module ChannelRecipientRemove = struct
type t = {
channel_id: Channel_id.t;
user: User_t.t;
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
-end
+ let update_cache (cache:Cache.t) t = ()
+end *)
+
+(* TODO decide on ban caching, if any *)
module GuildBanAdd = struct
- type t = {
- guild_id: Guild_id.t;
- user: User_t.t;
+ type t =
+ { guild_id: Guild_id.t
+ ; user: User_t.t
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) _t = cache
end
module GuildBanRemove = struct
- type t = {
- guild_id: Guild_id.t;
- user: User_t.t;
+ type t =
+ { guild_id: Guild_id.t
+ ; user: User_t.t
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) _t = cache
end
module GuildCreate = struct
- type t = {
- guild: Guild_t.t;
- } [@@deriving sexp]
+ type t = Guild_t.t
let deserialize ev =
- let guild = Guild_t.(pre_of_yojson_exn ev |> wrap) in
- { guild; }
+ Guild_t.(pre_of_yojson_exn ev |> wrap)
+
+ let update_cache (cache:Cache.t) (t:t) =
+ let open Channel_t in
+ let module C = Cache.ChannelMap in
+ let guilds = Cache.GuildMap.update cache.guilds t.id ~f:(function Some _ | None -> t) in
+ let unavailable_guilds = Cache.GuildMap.remove cache.unavailable_guilds t.id in
+ let text, voice, cat = ref [], ref [], ref [] in
+ List.iter t.channels ~f:(function
+ | GuildText c -> text := (c.id, c) :: !text
+ | GuildVoice c -> voice := (c.id, c) :: !voice
+ | Category c -> cat := (c.id, c) :: !cat
+ | _ -> ());
+ let text_channels = match C.of_alist !text with
+ | `Ok m ->
+ C.merge m cache.text_channels ~f:(fun ~key -> function
+ | `Both (c, _) | `Left c | `Right c -> let _ = key in Some c)
+ | _ -> cache.text_channels in
+ let voice_channels = match C.of_alist !voice with
+ | `Ok m ->
+ C.merge m cache.voice_channels ~f:(fun ~key -> function
+ | `Both (c, _) | `Left c | `Right c -> let _ = key in Some c)
+ | _ -> cache.voice_channels in
+ let categories = match C.of_alist !cat with
+ | `Ok m ->
+ C.merge m cache.categories ~f:(fun ~key -> function
+ | `Both (c, _) | `Left c | `Right c -> let _ = key in Some c)
+ | _ -> cache.categories in
+ let users = List.map t.members ~f:(fun m -> m.user.id, m.user) in
+ let users = match Cache.UserMap.of_alist users with
+ | `Ok m ->
+ Cache.UserMap.merge m cache.users ~f:(fun ~key -> function
+ | `Both (u, _) | `Left u | `Right u -> let _ = key in Some u)
+ | _ -> cache.users in
+ { cache with guilds
+ ; unavailable_guilds
+ ; text_channels
+ ; voice_channels
+ ; categories
+ ; users
+ }
end
module GuildDelete = struct
- type t = {
- id: Guild_id.t;
- } [@@deriving sexp, yojson { strict = false; exn = true }]
-
- let deserialize = of_yojson_exn
+ type t = Guild_t.unavailable =
+ { id: Guild_id_t.t
+ ; unavailable: bool
+ }
+
+ let deserialize = Guild_t.unavailable_of_yojson_exn
+
+ let update_cache (cache:Cache.t) (t:t) =
+ let open Channel_t in
+ let module G = Cache.GuildMap in
+ let module C = Cache.ChannelMap in
+ if t.unavailable then
+ let guilds = G.remove cache.guilds t.id in
+ let unavailable_guilds = G.update cache.unavailable_guilds t.id ~f:(function Some _ | None -> t) in
+ { cache with guilds
+ ; unavailable_guilds
+ }
+ else
+ match G.find cache.guilds t.id with
+ | Some g ->
+ let text_channels = ref cache.text_channels in
+ let voice_channels = ref cache.voice_channels in
+ let categories = ref cache.categories in
+ List.iter g.channels ~f:(function
+ | GuildText c -> text_channels := C.remove cache.text_channels c.id
+ | GuildVoice c -> voice_channels := C.remove cache.voice_channels c.id
+ | Category c -> categories := C.remove cache.categories c.id
+ | _ -> ()
+ );
+ let guilds = G.remove cache.guilds g.id in
+ let text_channels, voice_channels, categories = !text_channels, !voice_channels, !categories in
+ { cache with guilds
+ ; text_channels
+ ; voice_channels
+ ; categories
+ }
+ | None ->
+ let guilds = G.remove cache.guilds t.id in
+ { cache with guilds }
end
module GuildUpdate = struct
- type t = {
- guild: Guild_t.t;
- } [@@deriving sexp]
+ type t = Guild_t.t
let deserialize ev =
- let guild = Guild_t.(pre_of_yojson_exn ev |> wrap) in
- { guild; }
+ Guild_t.(pre_of_yojson_exn ev |> wrap)
+
+ let update_cache (cache:Cache.t) t =
+ let open Guild_t in
+ let {id; _} = t in
+ let guilds = Cache.GuildMap.update cache.guilds id ~f:(function
+ | Some _ | None -> t) in
+ { cache with guilds }
end
module GuildEmojisUpdate = struct
- type t = {
- emojis: Emoji.t list;
- guild_id: Guild_id.t
+ type t =
+ { emojis: Emoji.t list
+ ; guild_id: Guild_id.t
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) t =
+ if Cache.GuildMap.mem cache.guilds t.guild_id then
+ let guilds = match Cache.GuildMap.find cache.guilds t.guild_id with
+ | Some g -> Cache.GuildMap.set cache.guilds ~key:t.guild_id ~data:{ g with emojis = t.emojis }
+ | None -> cache.guilds in
+ { cache with guilds }
+ else cache
end
(* TODO guild integrations *)
module GuildMemberAdd = struct
- include Member_t
+ type t = Member_t.t
- let deserialize = of_yojson_exn
+ let deserialize = Member_t.of_yojson_exn
+
+ let update_cache (cache:Cache.t) (t:t) =
+ if Cache.GuildMap.mem cache.guilds t.guild_id then
+ let guilds = match Cache.GuildMap.find cache.guilds t.guild_id with
+ | Some g ->
+ let members = t :: g.members in
+ let data = { g with members } in
+ Cache.GuildMap.set cache.guilds ~key:t.guild_id ~data
+ | None -> cache.guilds in
+ { cache with guilds }
+ else cache
end
module GuildMemberRemove = struct
- type t = {
- guild_id: Guild_id.t;
- user: User_t.t;
+ type t =
+ { guild_id: Guild_id.t
+ ; user: User_t.t
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) t =
+ if Cache.GuildMap.mem cache.guilds t.guild_id then
+ let guilds = match Cache.GuildMap.find cache.guilds t.guild_id with
+ | Some g ->
+ let members = List.filter g.members ~f:(fun m -> m.user.id <> t.user.id) in
+ let data = { g with members } in
+ Cache.GuildMap.set cache.guilds ~key:t.guild_id ~data
+ | None -> cache.guilds in
+ { cache with guilds }
+ else cache
end
module GuildMemberUpdate = struct
- type t = {
- guild_id: Guild_id.t;
- nick: string option;
- roles: Role_id.t list;
- user: User_t.t;
+ type t =
+ { guild_id: Guild_id.t
+ ; nick: string option
+ ; roles: Role_id.t list
+ ; user: User_t.t
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) t =
+ if Cache.GuildMap.mem cache.guilds t.guild_id then
+ let guilds = match Cache.GuildMap.find cache.guilds t.guild_id with
+ | Some g ->
+ let members = List.map g.members ~f:(fun m ->
+ if m.user.id = t.user.id then
+ { m with nick = t.nick; roles = t.roles }
+ else m) in
+ let data = { g with members } in
+ Cache.GuildMap.set cache.guilds ~key:t.guild_id ~data
+ | None -> cache.guilds in
+ { cache with guilds }
+ else cache
end
module GuildMembersChunk = struct
- type t = {
- guild_id: Guild_id.t;
- members: (Snowflake.t * Member_t.t) list;
+ type t =
+ { guild_id: Guild_id.t
+ ; members: Member_t.member list
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) t =
+ match Cache.GuildMap.find cache.guilds t.guild_id with
+ | None -> cache
+ | Some g ->
+ let `Guild_id guild_id = t.guild_id in
+ let users = List.map t.members ~f:(fun m -> m.user.id, m.user) in
+ let members = List.filter_map t.members ~f:(fun m ->
+ if List.exists g.members ~f:(fun m' -> m'.user.id <> m.user.id) then
+ Some (Member_t.wrap ~guild_id m)
+ else None) in
+ let guilds = Cache.GuildMap.set cache.guilds ~key:t.guild_id ~data:{ g with members } in
+ let users = match Cache.UserMap.of_alist users with
+ | `Ok m ->
+ Cache.UserMap.merge m cache.users ~f:(fun ~key -> function
+ | `Both (u, _) | `Left u | `Right u -> let _ = key in Some u)
+ | _ -> cache.users in
+ { cache with guilds
+ ; users
+ }
+
end
module GuildRoleCreate = struct
- type t = {
- guild_id: Guild_id.t;
- role: Role_t.role;
+ type t =
+ { guild_id: Guild_id.t
+ ; role: Role_t.role
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) t =
+ if Cache.GuildMap.mem cache.guilds t.guild_id then
+ let guilds = match Cache.GuildMap.find cache.guilds t.guild_id with
+ | Some g ->
+ let `Guild_id guild_id = t.guild_id in
+ let roles = Role_t.wrap ~guild_id t.role :: g.roles in
+ let data = { g with roles } in
+ Cache.GuildMap.set cache.guilds ~key:t.guild_id ~data
+ | None -> cache.guilds in
+ { cache with guilds }
+ else cache
end
module GuildRoleDelete = struct
- type t = {
- guild_id: Guild_id.t;
- role_id: Role_id.t;
+ type t =
+ { guild_id: Guild_id.t
+ ; role_id: Role_id.t
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) t =
+ if Cache.GuildMap.mem cache.guilds t.guild_id then
+ let guilds = match Cache.GuildMap.find cache.guilds t.guild_id with
+ | Some g ->
+ let roles = List.filter g.roles ~f:(fun r -> r.id <> t.role_id) in
+ let data = { g with roles } in
+ Cache.GuildMap.set cache.guilds ~key:t.guild_id ~data
+ | None -> cache.guilds in
+ { cache with guilds }
+ else cache
end
module GuildRoleUpdate = struct
- type t = {
- guild_id: Guild_id.t;
- role: Role_t.role;
+ type t =
+ { guild_id: Guild_id.t
+ ; role: Role_t.role
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
-end
-(* TODO figure out if this is necessary *)
-module GuildUnavailable = struct
- type t = {
- guild_id: Guild_id.t;
- } [@@deriving sexp, yojson { strict = false; exn = true }]
-
- let deserialize = of_yojson_exn
+ let update_cache (cache:Cache.t) t =
+ if Cache.GuildMap.mem cache.guilds t.guild_id then
+ let guilds = match Cache.GuildMap.find cache.guilds t.guild_id with
+ | Some g ->
+ let `Guild_id guild_id = t.guild_id in
+ let roles = List.map g.roles ~f:(fun r ->
+ if r.id = t.role.id then Role_t.wrap ~guild_id t.role else r) in
+ let data = { g with roles } in
+ Cache.GuildMap.set cache.guilds ~key:t.guild_id ~data
+ | None -> cache.guilds in
+ { cache with guilds }
+ else cache
end
module MessageCreate = struct
- type t = {
- message: Message_t.t;
- } [@@deriving sexp]
+ type t = Message_t.t
- let deserialize ev =
- let message = Message_t.of_yojson_exn ev in
- { message; }
+ let deserialize =
+ Message_t.of_yojson_exn
+
+ let update_cache (cache:Cache.t) _t = cache
end
module MessageDelete = struct
- type t = {
- id: Message_id.t;
- channel_id: Channel_id.t;
- guild_id: Guild_id.t option [@default None];
+ type t =
+ { id: Message_id.t
+ ; channel_id: Channel_id.t
+ ; guild_id: Guild_id.t option [@default None]
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) _t = cache
end
module MessageUpdate = struct
- type t = {
- id: Message_id.t;
- author: User_t.t option [@default None];
- channel_id: Channel_id.t;
- member: Member_t.partial_member option [@default None];
- guild_id: Guild_id.t option [@default None];
- content: string option [@default None];
- timestamp: string option [@default None];
- editedimestamp: string option [@default None];
- tts: bool option [@default None];
- mention_everyone: bool option [@default None];
- mentions: User_t.t list [@default []];
- role_mentions: Role_id.t list [@default []];
- attachments: Attachment.t list [@default []];
- embeds: Embed.t list [@default []];
- reactions: Reaction_t.t list [@default []];
- nonce: Snowflake.t option [@default None];
- pinned: bool option [@default None];
- webhook_id: Snowflake.t option [@default None];
- kind: int option [@default None][@key "type"];
+ type t =
+ { id: Message_id.t
+ ; author: User_t.t option [@default None]
+ ; channel_id: Channel_id.t
+ ; member: Member_t.partial_member option [@default None]
+ ; guild_id: Guild_id.t option [@default None]
+ ; content: string option [@default None]
+ ; timestamp: string option [@default None]
+ ; editedimestamp: string option [@default None]
+ ; tts: bool option [@default None]
+ ; mention_everyone: bool option [@default None]
+ ; mentions: User_t.t list [@default []]
+ ; role_mentions: Role_id.t list [@default []]
+ ; attachments: Attachment.t list [@default []]
+ ; embeds: Embed.t list [@default []]
+ ; reactions: Reaction_t.t list [@default []]
+ ; nonce: Snowflake.t option [@default None]
+ ; pinned: bool option [@default None]
+ ; webhook_id: Snowflake.t option [@default None]
+ ; kind: int option [@default None][@key "type"]
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) _t = cache
end
module MessageDeleteBulk = struct
- type t = {
- guild_id: Guild_id.t option [@default None];
- channel_id: Channel_id.t;
- ids: Message_id.t list;
+ type t =
+ { guild_id: Guild_id.t option [@default None]
+ ; channel_id: Channel_id.t
+ ; ids: Message_id.t list
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) _t = cache
end
module PresenceUpdate = struct
- include Presence
+ type t = Presence.t
- let deserialize = of_yojson_exn
+ let deserialize = Presence.of_yojson_exn
+
+ let update_cache (cache:Cache.t) (t:t) =
+ let id = t.user.id in
+ let presences = Cache.UserMap.update cache.presences id ~f:(function Some _ | None -> t) in
+ { cache with presences }
end
(* module PresencesReplace = struct
@@ -254,93 +527,115 @@ end end *)
module ReactionAdd = struct
- type t = {
- user_id: User_id.t;
- channel_id: Channel_id.t;
- message_id: Message_id.t;
- guild_id: Guild_id.t option [@default None];
- emoji: Emoji.partial_emoji;
+ type t =
+ { user_id: User_id.t
+ ; channel_id: Channel_id.t
+ ; message_id: Message_id.t
+ ; guild_id: Guild_id.t option [@default None]
+ ; emoji: Emoji.partial_emoji
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) _t = cache
end
module ReactionRemove = struct
- type t = {
- user_id: User_id.t;
- channel_id: Channel_id.t;
- message_id: Message_id.t;
- guild_id: Guild_id.t option [@default None];
- emoji: Emoji.partial_emoji;
+ type t =
+ { user_id: User_id.t
+ ; channel_id: Channel_id.t
+ ; message_id: Message_id.t
+ ; guild_id: Guild_id.t option [@default None]
+ ; emoji: Emoji.partial_emoji
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) _t = cache
end
module ReactionRemoveAll = struct
- type t = {
- channel_id: Channel_id.t;
- message_id: Message_id.t;
- guild_id: Guild_id.t option [@default None];
+ type t =
+ { channel_id: Channel_id.t
+ ; message_id: Message_id.t
+ ; guild_id: Guild_id.t option [@default None]
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) _t = cache
end
module Ready = struct
- type t = {
- version: int [@key "v"];
- user: User_t.t;
- private_channels: Channel_id.t list;
- guilds: Guild_t.unavailable list;
- session_id: string;
+ type t =
+ { version: int [@key "v"]
+ ; user: User_t.t
+ ; private_channels: Channel_id.t list
+ ; guilds: Guild_t.unavailable list
+ ; session_id: string
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) t =
+ let unavailable_guilds = match List.map t.guilds ~f:(fun g -> g.id, g) |> Cache.GuildMap.of_alist with
+ | `Ok m -> Cache.GuildMap.merge m cache.unavailable_guilds ~f:(fun ~key -> function
+ | ` Both (g, _) | `Left g | `Right g -> let _ = key in Some g)
+ | _ -> cache.unavailable_guilds
+ in
+ let user = Some t.user in
+ { cache with user
+ ; unavailable_guilds
+ }
end
module Resumed = struct
- type t = {
- trace: string option list [@key "_trace"];
- } [@@deriving sexp, yojson { strict = false; exn = true }]
+ type t = { trace: string option list [@key "_trace"] }
+ [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) _t = cache
end
module TypingStart = struct
- type t = {
- channel_id: Channel_id.t;
- guild_id: Guild_id.t option [@default None];
- timestamp: int;
- user_id: User_id.t;
+ type t =
+ { channel_id: Channel_id.t
+ ; guild_id: Guild_id.t option [@default None]
+ ; timestamp: int
+ ; user_id: User_id.t
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) _t = cache
end
module UserUpdate = struct
- type t = {
- user: User_t.t;
- } [@@deriving sexp, yojson { strict = false; exn = true }]
+ type t = User_t.t
- let deserialize ev =
- let user = User_t.of_yojson_exn ev in
- { user; }
+ let deserialize = User_t.of_yojson_exn
+
+ let update_cache (cache:Cache.t) t =
+ let user = Some t in
+ { cache with user }
end
module WebhookUpdate = struct
- type t = {
- channel_id: Channel_id.t;
- guild_id: Guild_id.t;
+ type t =
+ { channel_id: Channel_id.t
+ ; guild_id: Guild_id.t
} [@@deriving sexp, yojson { strict = false; exn = true }]
let deserialize = of_yojson_exn
+
+ let update_cache (cache:Cache.t) _t = cache
end
module Unknown = struct
- type t = {
- kind: string;
- value: Yojson.Safe.t;
+ type t =
+ { kind: string
+ ; value: Yojson.Safe.t
}
let deserialize kind value = { kind; value; }
|