aboutsummaryrefslogtreecommitdiff
path: root/lib/models/guild
diff options
context:
space:
mode:
authorAdelyn Breelove <[email protected]>2019-01-23 10:40:04 -0700
committerAdelyn Breelove <[email protected]>2019-01-23 10:40:04 -0700
commitf23a12be25f819b9cc9ae05829b14edb6807082f (patch)
treee90bf9fa5a469c9707feccce9bf3926858c67f35 /lib/models/guild
parentfix a doc typo (diff)
downloaddisml-f23a12be25f819b9cc9ae05829b14edb6807082f.tar.xz
disml-f23a12be25f819b9cc9ae05829b14edb6807082f.zip
Guild ID and Channel ID abstractions
Diffstat (limited to 'lib/models/guild')
-rw-r--r--lib/models/guild/guild.ml122
-rw-r--r--lib/models/guild/guild.mli32
-rw-r--r--lib/models/guild/guild_t.ml4
-rw-r--r--lib/models/guild/guild_t.mli3
4 files changed, 15 insertions, 146 deletions
diff --git a/lib/models/guild/guild.ml b/lib/models/guild/guild.ml
index c1b9925..253ea07 100644
--- a/lib/models/guild/guild.ml
+++ b/lib/models/guild/guild.ml
@@ -1,127 +1,19 @@
open Core
open Async
-include Guild_t
-
-let ban_user ~id ?(reason="") ?(days=0) guild =
- Http.guild_ban_add guild.id id (`Assoc [
- ("delete-message-days", `Int days);
- ("reason", `String reason);
- ]) >>| Result.map ~f:ignore
-
-let create_emoji ~name ~image guild =
- Http.create_emoji guild.id (`Assoc [
- ("name", `String name);
- ("image", `String image);
- ("roles", `List []);
- ]) >>| Result.map ~f:Emoji.of_yojson_exn
-
-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 guild.id (`Assoc payload)
- >>| Result.map ~f:(fun r -> Role_t.role_of_yojson_exn r |> Role_t.wrap ~guild_id:guild.id)
-let create_channel ~mode ~name guild =
- let kind = match mode with
- | `Text -> 0
- | `Voice -> 2
- | `Category -> 4
- in Http.create_guild_channel guild.id (`Assoc [
- ("name", `String name);
- ("type", `Int kind);
- ]) >>| Result.map ~f:Channel_t.of_yojson_exn
-
-let delete guild =
- Http.delete_guild guild.id >>| Result.map ~f:ignore
-
-let get_ban ~id guild =
- Http.get_ban guild.id id >>| Result.map ~f:Ban_t.of_yojson_exn
+include Guild_t
+include Impl.Guild(Guild_t)
-let get_bans guild =
- Http.get_bans guild.id >>| Result.map ~f:(fun bans ->
- Yojson.Safe.Util.to_list bans
- |> List.map ~f:Ban_t.of_yojson_exn)
+let get_member ~id guild =
+ match List.find ~f:(fun m -> m.user.id = id) guild.members with
+ | Some m -> Deferred.Or_error.return m
+ | None -> Http.get_member (get_id guild) id >>| Result.map ~f:Member_t.of_yojson_exn
let get_channel ~id guild =
match List.find ~f:(fun c -> Channel_t.get_id c = id) guild.channels with
| Some c -> Deferred.Or_error.return c
| None -> Http.get_channel id >>| Result.map ~f:(fun c -> Channel_t.(channel_wrapper_of_yojson_exn c |> wrap))
-let get_emoji ~id guild =
- Http.get_emoji guild.id id >>| Result.map ~f:Emoji.of_yojson_exn
-
-(* TODO add invite abstraction? *)
-let get_invites guild =
- Http.get_guild_invites guild.id
-
-let get_member ~id guild =
- match List.find ~f:(fun m -> m.user.id = id) guild.members with
- | Some m -> Deferred.Or_error.return m
- | None -> Http.get_member guild.id id >>| Result.map ~f:Member_t.of_yojson_exn
-
-let get_prune_count ~days guild =
- Http.guild_prune_count guild.id days >>| Result.map ~f:(fun prune ->
- Yojson.Safe.Util.(member "pruned" prune |> to_int))
-
(* TODO add HTTP fallback *)
let get_role ~id guild =
- List.find ~f:(fun r -> r.id = id) guild.roles
-
-(* TODO add webhook abstraction? *)
-let get_webhooks guild =
- Http.get_guild_webhooks guild.id
-
-let kick_user ~id ?reason guild =
- let payload = match reason with
- | Some r -> `Assoc [("reason", `String r)]
- | None -> `Null
- in Http.remove_member guild.id id payload >>| Result.map ~f:ignore
-
-let leave guild =
- Http.leave_guild guild.id
-
-(* TODO Voice region abstractions? *)
-let list_voice_regions guild =
- Http.get_guild_voice_regions guild.id
-
-let prune ~days guild =
- Http.guild_prune_start guild.id days >>| Result.map ~f:(fun prune ->
- Yojson.Safe.Util.(member "pruned" prune |> to_int))
-
-let request_members guild =
- Http.get_members guild.id >>| Result.map ~f:(fun members ->
- Yojson.Safe.Util.to_list members
- |> List.map ~f:Member_t.of_yojson_exn)
-
-let set_afk_channel ~id guild = Http.edit_guild guild.id (`Assoc [
- ("afk_channel_id", `Int id);
- ]) >>| Result.map ~f:of_yojson_exn
-
-let set_afk_timeout ~timeout guild = Http.edit_guild guild.id (`Assoc [
- ("afk_timeout", `Int timeout);
- ]) >>| Result.map ~f:of_yojson_exn
-
-let set_name ~name guild = Http.edit_guild guild.id (`Assoc [
- ("name", `String name);
- ]) >>| Result.map ~f:of_yojson_exn
-
-let set_icon ~icon guild = Http.edit_guild guild.id (`Assoc [
- ("icon", `String icon);
- ]) >>| Result.map ~f:of_yojson_exn
-
-let unban_user ~id ?reason guild =
- let payload = match reason with
- | Some r -> `Assoc [("reason", `String r)]
- | None -> `Null
- in Http.guild_ban_remove guild.id id payload >>| Result.map ~f:ignore \ No newline at end of file
+ List.find ~f:(fun r -> r.id = id) guild.roles \ No newline at end of file
diff --git a/lib/models/guild/guild.mli b/lib/models/guild/guild.mli
index e972951..a6d3bcf 100644
--- a/lib/models/guild/guild.mli
+++ b/lib/models/guild/guild.mli
@@ -1,35 +1,9 @@
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_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_channel : id:Snowflake.t -> t -> Channel_t.t Deferred.Or_error.t
-val get_emoji : id:Snowflake.t -> t -> Emoji.t Deferred.Or_error.t
-val get_invites : t -> Yojson.Safe.json Deferred.Or_error.t
val get_member : id:Snowflake.t -> t -> Member_t.t Deferred.Or_error.t
-val get_prune_count : days:int -> t -> int Deferred.Or_error.t
-val get_role : id:Snowflake.t -> t -> Role_t.t option
-val get_webhooks : t -> Yojson.Safe.json Deferred.Or_error.t
-val kick_user : id:Snowflake.t -> ?reason:string -> t -> unit Deferred.Or_error.t
-val leave : t -> Yojson.Safe.json Deferred.Or_error.t
-val list_voice_regions : t -> Yojson.Safe.json 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 -> t Deferred.Or_error.t
-val set_afk_timeout : timeout:int -> t -> t Deferred.Or_error.t
-val set_name : name:string -> t -> t Deferred.Or_error.t
-val set_icon : icon:string -> 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
+val get_role : id:Snowflake.t -> t -> Role_t.t option \ No newline at end of file
diff --git a/lib/models/guild/guild_t.ml b/lib/models/guild/guild_t.ml
index 6bb5090..7984064 100644
--- a/lib/models/guild/guild_t.ml
+++ b/lib/models/guild/guild_t.ml
@@ -64,4 +64,6 @@ let wrap ({id;name;icon;splash;owner_id;region;afk_channel_id;afk_timeout;embed_
let channels = List.map ~f:Channel_t.wrap channels in
let widget_channel = Option.map ~f:Channel_t.wrap widget_channel in
let system_channel = Option.map ~f:Channel_t.wrap system_channel in
- {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;system_channel;large;unavailable;member_count;members;channels} \ No newline at end of file
+ {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;system_channel;large;unavailable;member_count;members;channels}
+
+let get_id guild = guild.id \ No newline at end of file
diff --git a/lib/models/guild/guild_t.mli b/lib/models/guild/guild_t.mli
index 6d9e4d3..b298334 100644
--- a/lib/models/guild/guild_t.mli
+++ b/lib/models/guild/guild_t.mli
@@ -56,4 +56,5 @@ type t = {
channels: Channel_t.t list;
} [@@deriving sexp, yojson]
-val wrap : pre -> t \ No newline at end of file
+val wrap : pre -> t
+val get_id : t -> Snowflake.t \ No newline at end of file