folder restructure

12 files changed, 401 insertions, 0 deletions

diff --git a/lib/models/guild/ban.ml b/lib/models/guild/ban.ml
new file mode 100644
index 0000000..45f7679
--- /dev/null
+++ b/lib/models/guild/ban.ml
@@ -0,0 +1 @@
+include Ban_t
\ No newline at end of file
diff --git a/lib/models/guild/ban.mli b/lib/models/guild/ban.mli
new file mode 100644
index 0000000..f8b1c2e
--- /dev/null
+++ b/lib/models/guild/ban.mli
@@ -0,0 +1 @@
+include module type of Ban_t
\ No newline at end of file
diff --git a/lib/models/guild/ban_t.ml b/lib/models/guild/ban_t.ml
new file mode 100644
index 0000000..b49eefc
--- /dev/null
+++ b/lib/models/guild/ban_t.ml
@@ -0,0 +1,6 @@
+open Core
+
+type t = {
+    reason: string [@default ""];
+    user: User_t.t;
+} [@@deriving sexp, yojson { strict = false}]
\ No newline at end of file
diff --git a/lib/models/guild/guild.ml b/lib/models/guild/guild.ml
new file mode 100644
index 0000000..c1b9925
--- /dev/null
+++ b/lib/models/guild/guild.ml
@@ -0,0 +1,127 @@
+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
+
+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_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
diff --git a/lib/models/guild/guild.mli b/lib/models/guild/guild.mli
new file mode 100644
index 0000000..e972951
--- /dev/null
+++ b/lib/models/guild/guild.mli
@@ -0,0 +1,35 @@
+open Async
+
+include module type of Guild_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
diff --git a/lib/models/guild/guild_t.ml b/lib/models/guild/guild_t.ml
new file mode 100644
index 0000000..6bb5090
--- /dev/null
+++ b/lib/models/guild/guild_t.ml
@@ -0,0 +1,67 @@
+open Core
+
+type pre = {
+    id: Snowflake.t;
+    name: string;
+    icon: string option [@default None];
+    splash: string option [@default None];
+    owner_id: Snowflake.t;
+    region: string;
+    afk_channel_id: Snowflake.t option [@default None];
+    afk_timeout: int;
+    embed_enabled: bool option [@default None];
+    embed_channel_id: Snowflake.t option [@default None];
+    verification_level: int;
+    default_message_notifications: int;
+    explicit_content_filter: int;
+    roles: Role_t.role list;
+    emojis: Emoji.t list;
+    features: string list;
+    mfa_level: int;
+    application_id: Snowflake.t option [@default None];
+    widget_enabled: bool option [@default None];
+    widget_channel: Channel_t.channel_wrapper option [@default None];
+    system_channel: Channel_t.channel_wrapper option [@default None];
+    large: bool;
+    unavailable: bool;
+    member_count: int option [@default None];
+    members: Member_t.member list;
+    channels: Channel_t.channel_wrapper list;
+} [@@deriving sexp, yojson { strict = false }]
+
+type t = {
+    id: Snowflake.t;
+    name: string;
+    icon: string option [@default None];
+    splash: string option [@default None];
+    owner_id: Snowflake.t;
+    region: string;
+    afk_channel_id: Snowflake.t option [@default None];
+    afk_timeout: int;
+    embed_enabled: bool option [@default None];
+    embed_channel_id: Snowflake.t option [@default None];
+    verification_level: int;
+    default_message_notifications: int;
+    explicit_content_filter: int;
+    roles: Role_t.t list;
+    emojis: Emoji.t list;
+    features: string list;
+    mfa_level: int;
+    application_id: Snowflake.t option [@default None];
+    widget_enabled: bool option [@default None];
+    widget_channel: Channel_t.t option [@default None];
+    system_channel: Channel_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 }]
+
+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;system_channel;large;unavailable;member_count;members;channels}:pre) =
+    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
+    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
diff --git a/lib/models/guild/member.ml b/lib/models/guild/member.ml
new file mode 100644
index 0000000..25f2f75
--- /dev/null
+++ b/lib/models/guild/member.ml
@@ -0,0 +1,43 @@
+open Async
+open Core
+include Member_t
+
+let add_role ~(role:Role_t.t) member =
+    Http.add_member_role member.guild_id member.user.id role.id
+    >>| Result.map ~f:ignore
+
+let remove_role ~(role:Role_t.t) member =
+    Http.remove_member_role member.guild_id member.user.id role.id
+    >>| Result.map ~f:ignore
+
+let ban ?(reason="") ?(days=0) member =
+    Http.guild_ban_add member.guild_id member.user.id (`Assoc [
+        ("delete-message-days", `Int days);
+        ("reason", `String reason);
+    ]) >>| Result.map ~f:ignore
+
+let kick ?reason member =
+    let payload = match reason with
+    | Some r -> `Assoc [("reason", `String r)]
+    | None -> `Null
+    in Http.remove_member member.guild_id member.user.id payload >>| Result.map ~f:ignore
+
+let mute member =
+    Http.edit_member member.guild_id member.user.id (`Assoc [
+        ("mute", `Bool true);
+    ]) >>| Result.map ~f:ignore
+
+let deafen member =
+    Http.edit_member member.guild_id member.user.id (`Assoc [
+        ("deaf", `Bool true);
+    ]) >>| Result.map ~f:ignore
+
+let unmute member =
+    Http.edit_member member.guild_id member.user.id (`Assoc [
+        ("mute", `Bool false);
+    ]) >>| Result.map ~f:ignore
+
+let undeafen member =
+    Http.edit_member member.guild_id member.user.id (`Assoc [
+        ("deaf", `Bool false);
+    ]) >>| Result.map ~f:ignore
diff --git a/lib/models/guild/member.mli b/lib/models/guild/member.mli
new file mode 100644
index 0000000..3ac786c
--- /dev/null
+++ b/lib/models/guild/member.mli
@@ -0,0 +1,12 @@
+open Async
+
+include module type of Member_t
+
+val add_role : role:Role_t.t -> Member_t.t -> unit Deferred.Or_error.t
+val remove_role : role:Role_t.t -> Member_t.t -> unit Deferred.Or_error.t
+val ban : ?reason:string -> ?days:int -> Member_t.t -> unit Deferred.Or_error.t
+val kick : ?reason:string -> Member_t.t -> unit Deferred.Or_error.t
+val mute : Member_t.t -> unit Deferred.Or_error.t
+val deafen : Member_t.t -> unit Deferred.Or_error.t
+val unmute : Member_t.t -> unit Deferred.Or_error.t
+val undeafen : Member_t.t -> unit Deferred.Or_error.t
\ No newline at end of file
diff --git a/lib/models/guild/member_t.ml b/lib/models/guild/member_t.ml
new file mode 100644
index 0000000..e6edb61
--- /dev/null
+++ b/lib/models/guild/member_t.ml
@@ -0,0 +1,43 @@
+open Core
+
+type partial_member = {
+    nick: string option [@default None];
+    roles: Snowflake.t list;
+    joined_at: string;
+    deaf: bool;
+    mute: bool;
+} [@@deriving sexp, yojson { strict = false}]
+
+type member = {
+    nick: string option [@default None];
+    roles: Snowflake.t list;
+    joined_at: string;
+    deaf: bool;
+    mute: bool;
+    user: User_t.t;
+} [@@deriving sexp, yojson { strict = false}]
+
+type member_wrapper = {
+    guild_id: Snowflake.t;
+    user: User_t.t;
+} [@@deriving sexp, yojson { strict = false }]
+
+type member_update = {
+    guild_id: Snowflake.t;
+    roles: Snowflake.t list [@default []];
+    user: User_t.t;
+    nick: string option [@default None];
+} [@@deriving sexp, yojson { strict = false}]
+
+type t = {
+    nick: string option [@default None];
+    roles: Snowflake.t list;
+    joined_at: string;
+    deaf: bool;
+    mute: bool;
+    user: User_t.t;
+    guild_id: Snowflake.t;
+} [@@deriving sexp, yojson { strict = false}]
+
+let wrap ~guild_id ({nick;roles;joined_at;deaf;mute;user}:member) =
+    {nick;roles;joined_at;deaf;mute;user;guild_id}
\ No newline at end of file
diff --git a/lib/models/guild/role.ml b/lib/models/guild/role.ml
new file mode 100644
index 0000000..ee6bb0a
--- /dev/null
+++ b/lib/models/guild/role.ml
@@ -0,0 +1,23 @@
+include Role_t
+
+let edit_role ~body (role:t) = Http.guild_role_edit role.guild_id role.id body
+
+let allow_mention role =
+    edit_role ~body:(`Assoc [("mentionable", `Bool true)]) role
+
+let delete (role:t) = Http.guild_role_remove role.guild_id role.id
+
+let disallow_mention role =
+    edit_role ~body:(`Assoc [("mentionable", `Bool false)]) role
+
+let hoist role =
+    edit_role ~body:(`Assoc [("hoist", `Bool true)]) role
+
+let set_colour ~colour role =
+    edit_role ~body:(`Assoc [("color", `Int colour)]) role
+
+let set_name ~name role =
+    edit_role ~body:(`Assoc [("name", `String name)]) role
+
+let unhoist role =
+    edit_role ~body:(`Assoc [("hoist", `Bool false)]) role
\ No newline at end of file
diff --git a/lib/models/guild/role.mli b/lib/models/guild/role.mli
new file mode 100644
index 0000000..d37f733
--- /dev/null
+++ b/lib/models/guild/role.mli
@@ -0,0 +1,11 @@
+open Async
+
+include module type of Role_t
+
+val allow_mention : t -> Yojson.Safe.json Deferred.Or_error.t
+val delete : t -> Yojson.Safe.json Deferred.Or_error.t
+val disallow_mention : t -> Yojson.Safe.json Deferred.Or_error.t
+val hoist : t -> Yojson.Safe.json Deferred.Or_error.t
+val set_colour : colour:int -> t -> Yojson.Safe.json Deferred.Or_error.t
+val set_name : name:string -> t -> Yojson.Safe.json Deferred.Or_error.t
+val unhoist : t -> Yojson.Safe.json Deferred.Or_error.t
\ No newline at end of file
diff --git a/lib/models/guild/role_t.ml b/lib/models/guild/role_t.ml
new file mode 100644
index 0000000..e41f31d
--- /dev/null
+++ b/lib/models/guild/role_t.ml
@@ -0,0 +1,32 @@
+open Core
+
+type role = {
+    id: Snowflake.t;
+    name: string;
+    colour: int [@key "color"];
+    hoist: bool;
+    position: int;
+    permissions: int;
+    managed: bool;
+    mentionable: bool;
+} [@@deriving sexp, yojson { strict = false}]
+
+type role_update = {
+    role: role;
+    guild_id: Snowflake.t;
+} [@@deriving sexp, yojson { strict = false}]
+
+type t = {
+    id: Snowflake.t;
+    name: string;
+    colour: int [@key "color"];
+    hoist: bool;
+    position: int;
+    permissions: int;
+    managed: bool;
+    mentionable: bool;
+    guild_id: Snowflake.t;
+} [@@deriving sexp, yojson { strict = false}]
+
+let wrap ~guild_id ({id;name;colour;hoist;position;permissions;managed;mentionable}:role) =
+    {id;name;colour;hoist;position;permissions;managed;mentionable;guild_id}
\ No newline at end of file