Guild ID and Channel ID abstractions

18 files changed, 99 insertions, 244 deletions

diff --git a/lib/models/channel/channel.ml b/lib/models/channel/channel.ml
index 972f888..68b3a97 100644
--- a/lib/models/channel/channel.ml
+++ b/lib/models/channel/channel.ml
@@ -1,57 +1,3 @@
-open Async
-open Core
 include Channel_t
 
-exception Invalid_message
-exception No_message_found
-
-let say ~content ch =
-    Http.create_message (get_id ch) (`Assoc [("content", `String content)])
-    >>| Result.map ~f:Message_t.of_yojson_exn
-
-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);
-    ]) >>| Result.map ~f:Message_t.of_yojson_exn
-
-let delete ch =
-    Http.delete_channel (get_id ch) >>| Result.map ~f:ignore
-
-let get_message ~id ch =
-    Http.get_message (get_id ch) id >>| Result.map ~f:Message_t.of_yojson_exn
-
-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 >>| Result.map ~f:(fun l ->
-        Yojson.Safe.Util.to_list l
-        |> List.map ~f:Message_t.of_yojson_exn)
-
-let broadcast_typing ch =
-    Http.broadcast_typing (get_id ch) >>| Result.map ~f:ignore
-
-let get_pins ch =
-    Http.get_pinned_messages (get_id ch) >>| Result.map ~f:(fun l ->
-        Yojson.Safe.Util.to_list l
-        |> List.map ~f:Message_t.of_yojson_exn)
\ No newline at end of file
+include Impl.Channel(Channel_t)
\ No newline at end of file
diff --git a/lib/models/channel/channel.mli b/lib/models/channel/channel.mli
index 001bb05..feb7323 100644
--- a/lib/models/channel/channel.mli
+++ b/lib/models/channel/channel.mli
@@ -1,44 +1,3 @@
-open Async
 include module type of Channel_t
-
-exception Invalid_message
-exception No_message_found
-
-(** Simple version of send_message that only takes [~content] *)
-val say : content:string -> t -> Message_t.t Deferred.Or_error.t
-
-(** Advanced message sending.
-
-    Raises {!Channel.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 with title = Some "Hello World!" } in
-                Channel.send_message ~embed msg.channel >>> 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
-val delete : t -> unit 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
-(* TODO more things related to guild channels *)
\ No newline at end of file
+include S.ChannelImpl with
+    type t := Channel_t.t
\ No newline at end of file
diff --git a/lib/models/channel/channel_t.mli b/lib/models/channel/channel_t.mli
index 2ac66fb..f3974d4 100644
--- a/lib/models/channel/channel_t.mli
+++ b/lib/models/channel/channel_t.mli
@@ -1,5 +1,6 @@
 exception Invalid_channel of Yojson.Safe.json
 
+(** Represents a Group channel object. *)
 type group = {
     id: Snowflake.t;
     last_message_id: Snowflake.t option;
@@ -10,12 +11,14 @@ type group = {
     recipients: User_t.t list;
 } [@@deriving sexp, yojson]
 
+(** Represents a private channel with a single user. *)
 type dm = {
     id: Snowflake.t;
     last_message_id: Snowflake.t option;
     last_pin_timestamp: string option;
 } [@@deriving sexp, yojson]
 
+(** Represents a text channel in a guild. *)
 type guild_text = {
     id: Snowflake.t;
     last_message_id: Snowflake.t option;
@@ -29,6 +32,7 @@ type guild_text = {
     slow_mode_timeout: int option;
 } [@@deriving sexp, yojson]
 
+(** Represents a voice channel in a guild. *)
 type guild_voice = {
     id: Snowflake.t;
     category_id: Snowflake.t option;
@@ -39,6 +43,7 @@ type guild_voice = {
     bitrate: int option;
 } [@@deriving sexp, yojson]
 
+(** Represents a guild category. *)
 type category = {
     id: Snowflake.t;
     guild_id: Snowflake.t option;
@@ -46,6 +51,7 @@ type category = {
     name: string;
 } [@@deriving sexp, yojson]
 
+(** Wrapper variant for all channel types. *)
 type t =
 | Group of group
 | Private of dm
@@ -54,6 +60,7 @@ type t =
 | Category of category
 [@@deriving sexp, yojson]
 
+(** Intermediate used internally. *)
 type channel_wrapper = {
     id: Snowflake.t;
     kind: int;
diff --git a/lib/models/channel/message/embed.mli b/lib/models/channel/message/embed.mli
index d15c9fd..411d8cc 100644
--- a/lib/models/channel/message/embed.mli
+++ b/lib/models/channel/message/embed.mli
@@ -1,9 +1,11 @@
+(** A footer object belonging to an embed. *)
 type footer = {
     text: string;
     icon_url: string option;
     proxy_icon_url: string option;
 } [@@deriving sexp, yojson]
 
+(** An image object belonging to an embed. *)
 type image = {
     url: string option;
     proxy_url: string option;
@@ -11,17 +13,20 @@ type image = {
     width: int option;
 } [@@deriving sexp, yojson]
 
+(** A video object belonging to an embed. *)
 type video = {
     url: string option;
     height: int option;
     width: int option;
 } [@@deriving sexp, yojson]
 
+(** A provider object belonging to an embed. *)
 type provider = {
     name: string option;
     url: string option;
 } [@@deriving sexp, yojson]
 
+(** An author object belonging to an embed. *)
 type author = {
     name: string option;
     url: string option;
@@ -29,12 +34,14 @@ type author = {
     proxy_icon_url: string option;
 } [@@deriving sexp, yojson]
 
+(** A field object belonging to an embed. *)
 type field = {
     name: string;
     value: string;
     inline: bool;
 } [@@deriving sexp, yojson]
 
+(** An embed object. See this {{:https://leovoel.github.io/embed-visualizer/}embed visualiser} if you need help understanding each component. *)
 type t = {
     title: string option;
     kind: string option[@key "type"];
@@ -51,29 +58,71 @@ type t = {
     fields: field list [@default []];
 } [@@deriving sexp, yojson { strict = false }]
 
+(** An embed where all values are empty. *)
 val default : t
+
+(** A footer where all values are empty. *)
 val default_footer : footer
+
+(** An image where all values are empty. *)
 val default_image : image
+
+(** A video where all values are empty. *)
 val default_video : video
+
+(** A provider where all values are empty. *)
 val default_provider : provider
+
+(** An author where all values are empty. *)
 val default_author : author
 
+(** Set the title of an embed. *)
 val title : string -> t -> t
+
+(** Set the description of an embed. *)
 val description : string -> t -> t
+
+(** Set the URL of an embed. *)
 val url : string -> t -> t
+
+(** Set the timestamp of an embed. *)
 val timestamp : string -> t -> t
+
+(** Set the colour of an embed. *)
 val colour : int -> t -> t
+
+(** Identical to {!colour} but with US English spelling. *)
 val color : int -> t -> t
+
+(** Set the footer of an embed. The function passes {!default_footer} and must return a footer. *)
 val footer : (footer -> footer) -> t -> t
+
+(** Set the image URL of an embed. *)
 val image : string -> t -> t
+
+(** Set the thumbnail URL of an embed. *)
 val thumbnail : string -> t -> t
+
+(** Set the author of an embed. The function passes {!default_author} and must return an author. *)
 val author : (author -> author) -> t -> t
+
+(** Add a field to an embed. Takes a tuple in [(name, value, inline)] order. {b Fields added this way will appear in reverse order in the embed.} *)
 val field : string * string * bool -> t -> t
+
+(** Set the fields of an embed. Similar to {!val:field}, but because a complete list is passed, fields preserve order. *)
 val fields : (string * string * bool) list -> t -> t
 
+(** Set the footer text. Typically used in the closure passed to {!val:footer}. *)
 val footer_text : string -> footer -> footer
+
+(** Set the footer icon URL. Typically used in the closure passed to {!val:footer}. *)
 val footer_icon : string -> footer -> footer
 
+(** Set the author name. Typically used in the closure passed to {!val:author}. *)
 val author_name : string -> author -> author
+
+(** Set the author URL. Typically used in the closure passed to {!val:author}. *)
 val author_url : string -> author -> author
+
+(** Set the author icon URL. Typically used in the closure passed to {!val:author}. *)
 val author_icon : string -> author -> author
\ No newline at end of file
diff --git a/lib/models/channel/message/message_t.mli b/lib/models/channel/message/message_t.mli
index 20360e8..097a705 100644
--- a/lib/models/channel/message/message_t.mli
+++ b/lib/models/channel/message/message_t.mli
@@ -1,3 +1,4 @@
+(** Represents data sent on {{!Dispatch.member_update}member update} events. *)
 type message_update = {
     id: Snowflake.t;
     author: User_t.t option;
@@ -20,6 +21,7 @@ type message_update = {
     kind: int option;
 } [@@deriving sexp, yojson]
 
+(** Represents a message object. *)
 type t = {
     id: Snowflake.t;
     author: User_t.t;
diff --git a/lib/models/channel/message/reaction_t.mli b/lib/models/channel/message/reaction_t.mli
index 5bdd275..db95521 100644
--- a/lib/models/channel/message/reaction_t.mli
+++ b/lib/models/channel/message/reaction_t.mli
@@ -1,3 +1,4 @@
+(** Represents a single reaction as received over the gateway. *)
 type reaction_event = {
     user_id: Snowflake.t;
     channel_id: Snowflake.t;
@@ -6,6 +7,7 @@ type reaction_event = {
     emoji: Emoji.partial_emoji;
 } [@@deriving sexp, yojson]
 
+(** Represents a number of emojis used as a reaction on a message. *)
 type t = {
     count: int;
     emoji: Emoji.t;
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
diff --git a/lib/models/id/channel_id.ml b/lib/models/id/channel_id.ml
new file mode 100644
index 0000000..1533728
--- /dev/null
+++ b/lib/models/id/channel_id.ml
@@ -0,0 +1,3 @@
+include Channel_id_t
+
+include Impl.Channel(Channel_id_t)
\ No newline at end of file
diff --git a/lib/models/id/channel_id.mli b/lib/models/id/channel_id.mli
new file mode 100644
index 0000000..f352160
--- /dev/null
+++ b/lib/models/id/channel_id.mli
@@ -0,0 +1,3 @@
+include module type of Channel_id_t
+include S.ChannelImpl with
+    type t := Channel_id_t.t
\ No newline at end of file
diff --git a/lib/models/id/channel_id_t.ml b/lib/models/id/channel_id_t.ml
new file mode 100644
index 0000000..2164b4f
--- /dev/null
+++ b/lib/models/id/channel_id_t.ml
@@ -0,0 +1,3 @@
+type t = [ `Channel_id of Snowflake.t ] [@@deriving sexp, yojson]
+
+let get_id (`Channel_id id) = id
\ No newline at end of file
diff --git a/lib/models/id/channel_id_t.mli b/lib/models/id/channel_id_t.mli
new file mode 100644
index 0000000..821c8b0
--- /dev/null
+++ b/lib/models/id/channel_id_t.mli
@@ -0,0 +1,3 @@
+type t = [ `Channel_id of Snowflake.t ] [@@deriving sexp, yojson]
+
+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
new file mode 100644
index 0000000..0242058
--- /dev/null
+++ b/lib/models/id/guild_id.ml
@@ -0,0 +1 @@
+include Impl.Guild(Guild_id_t)
\ No newline at end of file
diff --git a/lib/models/id/guild_id.mli b/lib/models/id/guild_id.mli
new file mode 100644
index 0000000..ea9d509
--- /dev/null
+++ b/lib/models/id/guild_id.mli
@@ -0,0 +1,2 @@
+include S.GuildImpl with
+    type t := Guild_id_t.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
new file mode 100644
index 0000000..c67b9e5
--- /dev/null
+++ b/lib/models/id/guild_id_t.ml
@@ -0,0 +1,3 @@
+type t = [ `Guild_id of Snowflake.t ] [@@deriving sexp, yojson]
+
+let get_id (`Guild_id id) = id
\ No newline at end of file
diff --git a/lib/models/id/guild_id_t.mli b/lib/models/id/guild_id_t.mli
new file mode 100644
index 0000000..dc72deb
--- /dev/null
+++ b/lib/models/id/guild_id_t.mli
@@ -0,0 +1,3 @@
+type t = [ `Guild_id of Snowflake.t ] [@@deriving sexp, yojson]
+
+val get_id : t -> Snowflake.t
\ No newline at end of file