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/guild/guild.ml | 108 ++++++++++++++++++++++++++++++++++++++++++- lib/models/guild/guild.mli | 32 ++++++++++++- lib/models/guild/guild_t.ml | 13 +++--- lib/models/guild/guild_t.mli | 3 +- 4 files changed, 144 insertions(+), 12 deletions(-) (limited to 'lib/models/guild') 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. *) -- cgit v1.2.3