Add a cache

4 files changed, 144 insertions, 12 deletions

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. *)