From 7c9b809078b5cd53e3d54c0004c683da2ec679af Mon Sep 17 00:00:00 2001 From: Adelyn Breedlove Date: Mon, 11 Feb 2019 17:23:59 +0000 Subject: Add a cache --- lib/models/channel/channel.ml | 54 +++- lib/models/channel/channel.mli | 47 ++- lib/models/channel/message/embed.ml | 12 +- lib/models/event_models.ml | 605 +++++++++++++++++++++++++++--------- lib/models/guild/guild.ml | 108 ++++++- lib/models/guild/guild.mli | 32 +- lib/models/guild/guild_t.ml | 13 +- lib/models/guild/guild_t.mli | 3 +- lib/models/id/channel_id.ml | 55 +++- lib/models/id/channel_id.mli | 47 ++- lib/models/id/channel_id_t.ml | 4 + lib/models/id/channel_id_t.mli | 1 + lib/models/id/guild_id.ml | 104 ++++++- lib/models/id/guild_id.mli | 32 +- lib/models/id/guild_id_t.ml | 4 + lib/models/id/guild_id_t.mli | 1 + lib/models/id/user_id.ml | 3 +- lib/models/id/user_id.mli | 4 +- lib/models/id/user_id_t.ml | 4 + lib/models/id/user_id_t.mli | 1 + lib/models/user/presence.ml | 2 - lib/models/user/presence.mli | 2 - lib/models/user/user_t.ml | 4 + lib/models/user/user_t.mli | 4 + 24 files changed, 955 insertions(+), 191 deletions(-) (limited to 'lib/models') diff --git a/lib/models/channel/channel.ml b/lib/models/channel/channel.ml index 6ccc66d..47cf500 100644 --- a/lib/models/channel/channel.ml +++ b/lib/models/channel/channel.ml @@ -1,3 +1,55 @@ +open Core include Channel_t -include Impl.Channel(Channel_t) \ No newline at end of file +exception Invalid_message +exception No_message_found + +let send_message ?embed ?content ?file ?(tts=false) ch = + let embed = match embed with + | Some e -> Embed.to_yojson e + | None -> `Null in + let content = match content with + | Some c -> `String c + | None -> `Null in + let file = match file with + | Some f -> `String f + | None -> `Null in + let () = match embed, content with + | `Null, `Null -> raise Invalid_message + | _ -> () in + Http.create_message (get_id ch) (`Assoc [ + ("embed", embed); + ("content", content); + ("file", file); + ("tts", `Bool tts); + ]) + +let say content ch = + send_message ~content ch + +let delete ch = + Http.delete_channel (get_id ch) + +let get_message ~id ch = + Http.get_message (get_id ch) id + +let get_messages ?(mode=`Around) ?id ?(limit=50) ch = + let kind = match mode with + | `Around -> "around", limit + | `Before -> "before", limit + | `After -> "after", limit + in + let id = match id with + | Some id -> id + | None -> raise No_message_found in + Http.get_messages (get_id ch) id kind + +let broadcast_typing ch = + Http.broadcast_typing (get_id ch) + +let get_pins ch = + Http.get_pinned_messages (get_id ch) + +let bulk_delete msgs ch = + let msgs = `List (List.map ~f:(fun id -> `Int id) msgs) in + Http.bulk_delete (get_id ch) msgs \ No newline at end of file diff --git a/lib/models/channel/channel.mli b/lib/models/channel/channel.mli index 3eece7d..9e981ae 100644 --- a/lib/models/channel/channel.mli +++ b/lib/models/channel/channel.mli @@ -1,3 +1,46 @@ +open Async include module type of Channel_t -include S.ChannelImpl with - type t := Channel_t.t \ No newline at end of file + +exception Invalid_message +exception No_message_found + +(** Advanced message sending. + + Raises {!Invalid_message} if one of content or embed is not set. + + {3 Examples} + {[ + open Core + open Disml + + let check_command (msg : Message.t) = + if String.is_prefix ~prefix:"!hello" msg.content then + let embed = Embed.(default |> title "Hello World!") in + Channel_id.send_message ~embed msg.channel_id >>> ignore + + Client.message_create := check_command + ]} +*) +val send_message : + ?embed:Embed.t -> + ?content:string -> + ?file:string -> + ?tts:bool -> + t -> + Message_t.t Deferred.Or_error.t + +(** [say str ch] is equivalent to [send_message ~content:str ch]. *) +val say : string -> t -> Message_t.t Deferred.Or_error.t + +val delete : t -> Channel_t.t Deferred.Or_error.t +val get_message : id:Snowflake.t -> t -> Message_t.t Deferred.Or_error.t +val get_messages : + ?mode:[ `Before | `After | `Around ] -> + ?id:Snowflake.t -> + ?limit:int -> + t -> + Message_t.t list Deferred.Or_error.t +val broadcast_typing : t -> unit Deferred.Or_error.t +val get_pins : t -> Message_t.t list Deferred.Or_error.t +val bulk_delete : Snowflake.t list -> t -> unit Deferred.Or_error.t +(* TODO more things related to guild channels *) \ No newline at end of file diff --git a/lib/models/channel/message/embed.ml b/lib/models/channel/message/embed.ml index f66aa3f..0dd7343 100644 --- a/lib/models/channel/message/embed.ml +++ b/lib/models/channel/message/embed.ml @@ -4,38 +4,38 @@ type footer = { text: string; icon_url: string option [@default None]; proxy_icon_url: string option [@default None]; -} [@@deriving sexp, yojson { exn = true }] +} [@@deriving sexp, yojson { strict = false; exn = true }] type image = { url: string option [@default None]; proxy_url: string option [@default None]; height: int option [@default None]; width: int option [@default None]; -} [@@deriving sexp, yojson { exn = true }] +} [@@deriving sexp, yojson { strict = false; exn = true }] type video = { url: string option [@default None]; height: int option [@default None]; width: int option [@default None]; -} [@@deriving sexp, yojson { exn = true }] +} [@@deriving sexp, yojson { strict = false; exn = true }] type provider = { name: string option [@default None]; url: string option [@default None]; -} [@@deriving sexp, yojson { exn = true }] +} [@@deriving sexp, yojson { strict = false; exn = true }] type author = { name: string option [@default None]; url: string option [@default None]; icon_url: string option [@default None]; proxy_icon_url: string option [@default None]; -} [@@deriving sexp, yojson { exn = true }] +} [@@deriving sexp, yojson { strict = false; exn = true }] type field = { name: string; value: string; inline: bool [@default false]; -} [@@deriving sexp, yojson { exn = true }] +} [@@deriving sexp, yojson { strict = false; exn = true }] type t = { title: string option [@default None]; 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; } diff --git a/lib/models/guild/guild.ml b/lib/models/guild/guild.ml index b1e8bfe..bd3143e 100644 --- a/lib/models/guild/guild.ml +++ b/lib/models/guild/guild.ml @@ -2,7 +2,113 @@ open Core open Async include Guild_t -include Impl.Guild(Guild_t) + +let ban_user ~id ?(reason="") ?(days=0) guild = + Http.guild_ban_add (get_id guild) id (`Assoc [ + ("delete-message-days", `Int days); + ("reason", `String reason); + ]) + +let create data = + let data = `Assoc data in + Http.create_guild data + +let create_emoji ~name ~image guild = + Http.create_emoji (get_id guild) (`Assoc [ + ("name", `String name); + ("image", `String image); + ("roles", `List []); + ]) + +let create_role ~name ?colour ?permissions ?hoist ?mentionable guild = + let payload = ("name", `String name) :: [] in + let payload = match permissions with + | Some p -> ("permissions", `Int p) :: payload + | None -> payload + in let payload = match colour with + | Some c -> ("color", `Int c) :: payload + | None -> payload + in let payload = match hoist with + | Some h -> ("hoist", `Bool h) :: payload + | None -> payload + in let payload = match mentionable with + | Some m -> ("mentionable", `Bool m) :: payload + | None -> payload + in Http.guild_role_add (get_id guild) (`Assoc payload) + +let create_channel ~mode ~name guild = + let kind = match mode with + | `Text -> 0 + | `Voice -> 2 + | `Category -> 4 + in Http.create_guild_channel (get_id guild) (`Assoc [ + ("name", `String name); + ("type", `Int kind); + ]) + +let delete guild = + Http.delete_guild (get_id guild) + +let get_ban ~id guild = + Http.get_ban (get_id guild) id + +let get_bans guild = + Http.get_bans (get_id guild) + +let get_emoji ~id guild = + Http.get_emoji (get_id guild) id + +(* TODO add invite abstraction? *) +let get_invites guild = + Http.get_guild_invites (get_id guild) + +let get_prune_count ~days guild = + Http.guild_prune_count (get_id guild) days + +(* TODO add webhook abstraction? *) +let get_webhooks guild = + Http.get_guild_webhooks (get_id guild) + +let kick_user ~id ?reason guild = + let payload = match reason with + | Some r -> `Assoc [("reason", `String r)] + | None -> `Null + in Http.remove_member (get_id guild) id payload + +let leave guild = + Http.leave_guild (get_id guild) + +(* TODO Voice region abstractions? *) +let list_voice_regions guild = + Http.get_guild_voice_regions (get_id guild) + +let prune ~days guild = + Http.guild_prune_start (get_id guild) days + +let request_members guild = + Http.get_members (get_id guild) + +let set_afk_channel ~id guild = Http.edit_guild (get_id guild) (`Assoc [ + ("afk_channel_id", `Int id); + ]) + +let set_afk_timeout ~timeout guild = Http.edit_guild (get_id guild) (`Assoc [ + ("afk_timeout", `Int timeout); + ]) + +let set_name ~name guild = Http.edit_guild (get_id guild) (`Assoc [ + ("name", `String name); + ]) + +let set_icon ~icon guild = Http.edit_guild (get_id guild) (`Assoc [ + ("icon", `String icon); + ]) + +let unban_user ~id ?reason guild = + let payload = match reason with + | Some r -> `Assoc [("reason", `String r)] + | None -> `Null + in Http.guild_ban_remove (get_id guild) id payload let get_member ~(id:User_id_t.t) guild = match List.find ~f:(fun m -> m.user.id = id) guild.members with diff --git a/lib/models/guild/guild.mli b/lib/models/guild/guild.mli index be9300a..1fbcf55 100644 --- a/lib/models/guild/guild.mli +++ b/lib/models/guild/guild.mli @@ -1,8 +1,36 @@ open Async include module type of Guild_t -include S.GuildImpl with - type t := Guild_t.t + +val ban_user : id:Snowflake.t -> ?reason:string -> ?days:int -> t -> unit Deferred.Or_error.t +val create : (string * Yojson.Safe.t) list -> t Deferred.Or_error.t +val create_emoji : name:string -> image:string -> t -> Emoji.t Deferred.Or_error.t +val create_role : + name:string -> + ?colour:int -> + ?permissions:int -> + ?hoist:bool -> + ?mentionable:bool -> + t -> + Role_t.t Deferred.Or_error.t +val create_channel : mode:[ `Text | `Voice | `Category ] -> name:string -> t -> Channel_t.t Deferred.Or_error.t +val delete : t -> unit Deferred.Or_error.t +val get_ban : id:Snowflake.t -> t -> Ban_t.t Deferred.Or_error.t +val get_bans : t -> Ban_t.t list Deferred.Or_error.t +val get_emoji : id:Snowflake.t -> t -> Emoji.t Deferred.Or_error.t +val get_invites : t -> Yojson.Safe.t Deferred.Or_error.t +val get_prune_count : days:int -> t -> int Deferred.Or_error.t +val get_webhooks : t -> Yojson.Safe.t Deferred.Or_error.t +val kick_user : id:Snowflake.t -> ?reason:string -> t -> unit Deferred.Or_error.t +val leave : t -> unit Deferred.Or_error.t +val list_voice_regions : t -> Yojson.Safe.t Deferred.Or_error.t +val prune : days:int -> t -> int Deferred.Or_error.t +val request_members : t -> Member_t.t list Deferred.Or_error.t +val set_afk_channel : id:Snowflake.t -> t -> Guild_t.t Deferred.Or_error.t +val set_afk_timeout : timeout:int -> t -> Guild_t.t Deferred.Or_error.t +val set_name : name:string -> t -> Guild_t.t Deferred.Or_error.t +val set_icon : icon:string -> t -> Guild_t.t Deferred.Or_error.t +val unban_user : id:Snowflake.t -> ?reason:string -> t -> unit Deferred.Or_error.t (** Get a channel belonging to this guild. This does not make an HTTP request. *) val get_channel : id:Channel_id_t.t -> t -> Channel_t.t Deferred.Or_error.t diff --git a/lib/models/guild/guild_t.ml b/lib/models/guild/guild_t.ml index fa9673a..afe3d19 100644 --- a/lib/models/guild/guild_t.ml +++ b/lib/models/guild/guild_t.ml @@ -2,6 +2,7 @@ open Core type unavailable = { id: Guild_id_t.t; + unavailable: bool [@default false]; } [@@deriving sexp, yojson { strict = false; exn = true }] type pre = { @@ -26,11 +27,10 @@ type pre = { widget_enabled: bool [@default false]; widget_channel_id: Channel_id_t.t option [@default None]; system_channel_id: Channel_id_t.t option [@default None]; - large: bool; - unavailable: bool; + large: bool [@default false]; member_count: int option [@default None]; - members: Member_t.member list; - channels: Channel_t.channel_wrapper list; + members: Member_t.member list [@default []]; + channels: Channel_t.channel_wrapper list [@default []]; } [@@deriving sexp, yojson { strict = false; exn = true }] type t = { @@ -56,17 +56,16 @@ type t = { widget_channel_id: Channel_id_t.t option [@default None]; system_channel_id: Channel_id_t.t option [@default None]; large: bool; - unavailable: bool; member_count: int option [@default None]; members: Member_t.t list; channels: Channel_t.t list; } [@@deriving sexp, yojson { strict = false; exn = true }] -let wrap ({id;name;icon;splash;owner_id;region;afk_channel_id;afk_timeout;embed_enabled;embed_channel_id;verification_level;default_message_notifications;explicit_content_filter;roles;emojis;features;mfa_level;application_id;widget_enabled;widget_channel_id;system_channel_id;large;unavailable;member_count;members;channels}:pre) = +let wrap ({id;name;icon;splash;owner_id;region;afk_channel_id;afk_timeout;embed_enabled;embed_channel_id;verification_level;default_message_notifications;explicit_content_filter;roles;emojis;features;mfa_level;application_id;widget_enabled;widget_channel_id;system_channel_id;large;member_count;members;channels}:pre) = let `Guild_id id = id in let roles = List.map ~f:(Role_t.wrap ~guild_id:id) roles in let members = List.map ~f:(Member_t.wrap ~guild_id:id) members in let channels = List.map ~f:Channel_t.wrap channels in - {id = `Guild_id id;name;icon;splash;owner_id;region;afk_channel_id;afk_timeout;embed_enabled;embed_channel_id;verification_level;default_message_notifications;explicit_content_filter;roles;emojis;features;mfa_level;application_id;widget_enabled;widget_channel_id;system_channel_id;large;unavailable;member_count;members;channels} + {id = `Guild_id id;name;icon;splash;owner_id;region;afk_channel_id;afk_timeout;embed_enabled;embed_channel_id;verification_level;default_message_notifications;explicit_content_filter;roles;emojis;features;mfa_level;application_id;widget_enabled;widget_channel_id;system_channel_id;large;member_count;members;channels} let get_id guild = let `Guild_id id = guild.id in id \ No newline at end of file diff --git a/lib/models/guild/guild_t.mli b/lib/models/guild/guild_t.mli index 89cf9a2..7327be9 100644 --- a/lib/models/guild/guild_t.mli +++ b/lib/models/guild/guild_t.mli @@ -1,5 +1,6 @@ type unavailable = { id: Guild_id_t.t; + unavailable: bool; } [@@deriving sexp, yojson { exn = true }] (** Used internally. *) @@ -26,7 +27,6 @@ type pre = { widget_channel_id: Channel_id_t.t option; system_channel_id: Channel_id_t.t option; large: bool; - unavailable: bool; member_count: int option; members: Member_t.member list; channels: Channel_t.channel_wrapper list; @@ -56,7 +56,6 @@ type t = { widget_channel_id: Channel_id_t.t option; (** The channel ID for the widget, if enabled. *) system_channel_id: Channel_id_t.t option; (** The channel ID where system messages are sent. *) large: bool; (** Whether the guild exceeds the configured large threshold. *) - unavailable: bool; (** Whether the guild is unavailable or not. *) member_count: int option; (** Total number of members in the guild. *) members: Member_t.t list; (** List of guild members. *) channels: Channel_t.t list; (** List of guild channels. *) diff --git a/lib/models/id/channel_id.ml b/lib/models/id/channel_id.ml index be4bfab..1017ad1 100644 --- a/lib/models/id/channel_id.ml +++ b/lib/models/id/channel_id.ml @@ -1,2 +1,55 @@ +open Core include Channel_id_t -include Impl.Channel(Channel_id_t) \ No newline at end of file + +exception Invalid_message +exception No_message_found + +let send_message ?embed ?content ?file ?(tts=false) ch = + let embed = match embed with + | Some e -> Embed.to_yojson e + | None -> `Null in + let content = match content with + | Some c -> `String c + | None -> `Null in + let file = match file with + | Some f -> `String f + | None -> `Null in + let () = match embed, content with + | `Null, `Null -> raise Invalid_message + | _ -> () in + Http.create_message (get_id ch) (`Assoc [ + ("embed", embed); + ("content", content); + ("file", file); + ("tts", `Bool tts); + ]) + +let say content ch = + send_message ~content ch + +let delete ch = + Http.delete_channel (get_id ch) + +let get_message ~id ch = + Http.get_message (get_id ch) id + +let get_messages ?(mode=`Around) ?id ?(limit=50) ch = + let kind = match mode with + | `Around -> "around", limit + | `Before -> "before", limit + | `After -> "after", limit + in + let id = match id with + | Some id -> id + | None -> raise No_message_found in + Http.get_messages (get_id ch) id kind + +let broadcast_typing ch = + Http.broadcast_typing (get_id ch) + +let get_pins ch = + Http.get_pinned_messages (get_id ch) + +let bulk_delete msgs ch = + let msgs = `List (List.map ~f:(fun id -> `Int id) msgs) in + Http.bulk_delete (get_id ch) msgs \ No newline at end of file diff --git a/lib/models/id/channel_id.mli b/lib/models/id/channel_id.mli index 59b4d23..20987c5 100644 --- a/lib/models/id/channel_id.mli +++ b/lib/models/id/channel_id.mli @@ -1,3 +1,46 @@ +open Async include module type of Channel_id_t -include S.ChannelImpl with - type t := Channel_id_t.t \ No newline at end of file + +exception Invalid_message +exception No_message_found + +(** Advanced message sending. + + Raises {!Invalid_message} if one of content or embed is not set. + + {3 Examples} + {[ + open Core + open Disml + + let check_command (msg : Message.t) = + if String.is_prefix ~prefix:"!hello" msg.content then + let embed = Embed.(default |> title "Hello World!") in + Channel_id.send_message ~embed msg.channel_id >>> ignore + + Client.message_create := check_command + ]} +*) +val send_message : + ?embed:Embed.t -> + ?content:string -> + ?file:string -> + ?tts:bool -> + t -> + Message_t.t Deferred.Or_error.t + +(** [say str ch] is equivalent to [send_message ~content:str ch]. *) +val say : string -> t -> Message_t.t Deferred.Or_error.t + +val delete : t -> Channel_t.t Deferred.Or_error.t +val get_message : id:Snowflake.t -> t -> Message_t.t Deferred.Or_error.t +val get_messages : + ?mode:[ `Before | `After | `Around ] -> + ?id:Snowflake.t -> + ?limit:int -> + t -> + Message_t.t list Deferred.Or_error.t +val broadcast_typing : t -> unit Deferred.Or_error.t +val get_pins : t -> Message_t.t list Deferred.Or_error.t +val bulk_delete : Snowflake.t list -> t -> unit Deferred.Or_error.t +(* TODO more things related to guild channels *) \ No newline at end of file diff --git a/lib/models/id/channel_id_t.ml b/lib/models/id/channel_id_t.ml index e49beef..cea85e0 100644 --- a/lib/models/id/channel_id_t.ml +++ b/lib/models/id/channel_id_t.ml @@ -1,5 +1,9 @@ +open Core + type t = [ `Channel_id of Snowflake.t ] [@@deriving sexp] +let compare (`Channel_id t) (`Channel_id t') = Int.compare t t' + let of_yojson a : (t, string) result = match Snowflake.of_yojson a with | Ok id -> Ok (`Channel_id id) diff --git a/lib/models/id/channel_id_t.mli b/lib/models/id/channel_id_t.mli index df0d518..72324a7 100644 --- a/lib/models/id/channel_id_t.mli +++ b/lib/models/id/channel_id_t.mli @@ -1,3 +1,4 @@ type t = [ `Channel_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }] +val compare : t -> t -> int val get_id : t -> Snowflake.t \ No newline at end of file diff --git a/lib/models/id/guild_id.ml b/lib/models/id/guild_id.ml index 79b4323..6b3385c 100644 --- a/lib/models/id/guild_id.ml +++ b/lib/models/id/guild_id.ml @@ -1,2 +1,104 @@ include Guild_id_t -include Impl.Guild(Guild_id_t) \ No newline at end of file + +let ban_user ~id ?(reason="") ?(days=0) guild = + Http.guild_ban_add (get_id guild) id (`Assoc [ + ("delete-message-days", `Int days); + ("reason", `String reason); + ]) + +let create_emoji ~name ~image guild = + Http.create_emoji (get_id guild) (`Assoc [ + ("name", `String name); + ("image", `String image); + ("roles", `List []); + ]) + +let create_role ~name ?colour ?permissions ?hoist ?mentionable guild = + let payload = ("name", `String name) :: [] in + let payload = match permissions with + | Some p -> ("permissions", `Int p) :: payload + | None -> payload + in let payload = match colour with + | Some c -> ("color", `Int c) :: payload + | None -> payload + in let payload = match hoist with + | Some h -> ("hoist", `Bool h) :: payload + | None -> payload + in let payload = match mentionable with + | Some m -> ("mentionable", `Bool m) :: payload + | None -> payload + in Http.guild_role_add (get_id guild) (`Assoc payload) + +let create_channel ~mode ~name guild = + let kind = match mode with + | `Text -> 0 + | `Voice -> 2 + | `Category -> 4 + in Http.create_guild_channel (get_id guild) (`Assoc [ + ("name", `String name); + ("type", `Int kind); + ]) + +let delete guild = + Http.delete_guild (get_id guild) + +let get_ban ~id guild = + Http.get_ban (get_id guild) id + +let get_bans guild = + Http.get_bans (get_id guild) + +let get_emoji ~id guild = + Http.get_emoji (get_id guild) id + +(* TODO add invite abstraction? *) +let get_invites guild = + Http.get_guild_invites (get_id guild) + +let get_prune_count ~days guild = + Http.guild_prune_count (get_id guild) days + +(* TODO add webhook abstraction? *) +let get_webhooks guild = + Http.get_guild_webhooks (get_id guild) + +let kick_user ~id ?reason guild = + let payload = match reason with + | Some r -> `Assoc [("reason", `String r)] + | None -> `Null + in Http.remove_member (get_id guild) id payload + +let leave guild = + Http.leave_guild (get_id guild) + +(* TODO Voice region abstractions? *) +let list_voice_regions guild = + Http.get_guild_voice_regions (get_id guild) + +let prune ~days guild = + Http.guild_prune_start (get_id guild) days + +let request_members guild = + Http.get_members (get_id guild) + +let set_afk_channel ~id guild = Http.edit_guild (get_id guild) (`Assoc [ + ("afk_channel_id", `Int id); + ]) + +let set_afk_timeout ~timeout guild = Http.edit_guild (get_id guild) (`Assoc [ + ("afk_timeout", `Int timeout); + ]) + +let set_name ~name guild = Http.edit_guild (get_id guild) (`Assoc [ + ("name", `String name); + ]) + +let set_icon ~icon guild = Http.edit_guild (get_id guild) (`Assoc [ + ("icon", `String icon); + ]) + +let unban_user ~id ?reason guild = + let payload = match reason with + | Some r -> `Assoc [("reason", `String r)] + | None -> `Null + in Http.guild_ban_remove (get_id guild) id payload \ No newline at end of file diff --git a/lib/models/id/guild_id.mli b/lib/models/id/guild_id.mli index 88e9fa7..11f34f7 100644 --- a/lib/models/id/guild_id.mli +++ b/lib/models/id/guild_id.mli @@ -1,3 +1,31 @@ +open Async include module type of Guild_id_t -include S.GuildImpl with - type t := Guild_id_t.t \ No newline at end of file + +val ban_user : id:Snowflake.t -> ?reason:string -> ?days:int -> t -> unit Deferred.Or_error.t +val create_emoji : name:string -> image:string -> t -> Emoji.t Deferred.Or_error.t +val create_role : + name:string -> + ?colour:int -> + ?permissions:int -> + ?hoist:bool -> + ?mentionable:bool -> + t -> + Role_t.t Deferred.Or_error.t +val create_channel : mode:[ `Text | `Voice | `Category ] -> name:string -> t -> Channel_t.t Deferred.Or_error.t +val delete : t -> unit Deferred.Or_error.t +val get_ban : id:Snowflake.t -> t -> Ban_t.t Deferred.Or_error.t +val get_bans : t -> Ban_t.t list Deferred.Or_error.t +val get_emoji : id:Snowflake.t -> t -> Emoji.t Deferred.Or_error.t +val get_invites : t -> Yojson.Safe.t Deferred.Or_error.t +val get_prune_count : days:int -> t -> int Deferred.Or_error.t +val get_webhooks : t -> Yojson.Safe.t Deferred.Or_error.t +val kick_user : id:Snowflake.t -> ?reason:string -> t -> unit Deferred.Or_error.t +val leave : t -> unit Deferred.Or_error.t +val list_voice_regions : t -> Yojson.Safe.t Deferred.Or_error.t +val prune : days:int -> t -> int Deferred.Or_error.t +val request_members : t -> Member_t.t list Deferred.Or_error.t +val set_afk_channel : id:Snowflake.t -> t -> Guild_t.t Deferred.Or_error.t +val set_afk_timeout : timeout:int -> t -> Guild_t.t Deferred.Or_error.t +val set_name : name:string -> t -> Guild_t.t Deferred.Or_error.t +val set_icon : icon:string -> t -> Guild_t.t Deferred.Or_error.t +val unban_user : id:Snowflake.t -> ?reason:string -> t -> unit Deferred.Or_error.t \ No newline at end of file diff --git a/lib/models/id/guild_id_t.ml b/lib/models/id/guild_id_t.ml index cd8eb58..a39c07d 100644 --- a/lib/models/id/guild_id_t.ml +++ b/lib/models/id/guild_id_t.ml @@ -1,5 +1,9 @@ +open Core + type t = [ `Guild_id of Snowflake.t ] [@@deriving sexp] +let compare (`Guild_id t) (`Guild_id t') = Int.compare t t' + let of_yojson a : (t, string) result = match Snowflake.of_yojson a with | Ok id -> Ok (`Guild_id id) diff --git a/lib/models/id/guild_id_t.mli b/lib/models/id/guild_id_t.mli index 4605d34..f4d415a 100644 --- a/lib/models/id/guild_id_t.mli +++ b/lib/models/id/guild_id_t.mli @@ -1,3 +1,4 @@ type t = [ `Guild_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }] +val compare : t -> t -> int val get_id : t -> Snowflake.t \ No newline at end of file diff --git a/lib/models/id/user_id.ml b/lib/models/id/user_id.ml index cc71764..00d930f 100644 --- a/lib/models/id/user_id.ml +++ b/lib/models/id/user_id.ml @@ -1,2 +1 @@ -include User_id_t -include Impl.User(User_id_t) \ No newline at end of file +include User_id_t \ No newline at end of file diff --git a/lib/models/id/user_id.mli b/lib/models/id/user_id.mli index 574c4f0..f9506f7 100644 --- a/lib/models/id/user_id.mli +++ b/lib/models/id/user_id.mli @@ -1,3 +1 @@ -include module type of User_id_t -include S.UserImpl with - type t := User_id_t.t \ No newline at end of file +include module type of User_id_t \ No newline at end of file diff --git a/lib/models/id/user_id_t.ml b/lib/models/id/user_id_t.ml index f168daa..cf1634a 100644 --- a/lib/models/id/user_id_t.ml +++ b/lib/models/id/user_id_t.ml @@ -1,5 +1,9 @@ +open Core + type t = [ `User_id of Snowflake.t ] [@@deriving sexp] +let compare (`User_id t) (`User_id t') = Int.compare t t' + let of_yojson a : (t, string) result = match Snowflake.of_yojson a with | Ok id -> Ok (`User_id id) diff --git a/lib/models/id/user_id_t.mli b/lib/models/id/user_id_t.mli index 194951b..e728b00 100644 --- a/lib/models/id/user_id_t.mli +++ b/lib/models/id/user_id_t.mli @@ -1,3 +1,4 @@ type t = [ `User_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }] +val compare : t -> t -> int val get_id : t -> Snowflake.t \ No newline at end of file diff --git a/lib/models/user/presence.ml b/lib/models/user/presence.ml index 0b83000..d8683b7 100644 --- a/lib/models/user/presence.ml +++ b/lib/models/user/presence.ml @@ -2,9 +2,7 @@ open Core type t = { user: User_t.partial_user; - roles: Role_id.t list; game: Activity.t option [@default None]; - guild_id: Guild_id_t.t; status: string; activities: Activity.t list; } [@@deriving sexp, yojson { strict = false; exn = true }] \ No newline at end of file diff --git a/lib/models/user/presence.mli b/lib/models/user/presence.mli index 2df252b..ae01373 100644 --- a/lib/models/user/presence.mli +++ b/lib/models/user/presence.mli @@ -1,9 +1,7 @@ (** A user presence. *) type t = { user: User_t.partial_user; (** A partial user that this presence belongs to. *) - roles: Role_id.t list; (** A list of roles that the user has. *) game: Activity.t option; (** The current activity of the user, if any. *) - guild_id: Guild_id_t.t; (** The guild ID in which this presence exists. *) status: string; (** One of [online], [idle], [offline], or [dnd]. *) activities: Activity.t list; (** A list of all of the user's current activities. *) } [@@deriving sexp, yojson { exn = true }] \ No newline at end of file diff --git a/lib/models/user/user_t.ml b/lib/models/user/user_t.ml index f001e4a..b68808d 100644 --- a/lib/models/user/user_t.ml +++ b/lib/models/user/user_t.ml @@ -2,6 +2,10 @@ open Core type partial_user = { id: User_id_t.t; + username: string option [@default None]; + discriminator: string option [@default None]; + avatar: string option [@default None]; + bot: bool [@default false]; } [@@deriving sexp, yojson { strict = false; exn = true }] type t = { diff --git a/lib/models/user/user_t.mli b/lib/models/user/user_t.mli index 7b8f6b6..78f7a28 100644 --- a/lib/models/user/user_t.mli +++ b/lib/models/user/user_t.mli @@ -1,6 +1,10 @@ (** A partial user. Used internally. *) type partial_user = { id: User_id_t.t; + username: string option; + discriminator: string option; + avatar: string option; + bot: bool; } [@@deriving sexp, yojson { exn = true }] (** A user object. *) -- cgit v1.2.3