Add a cache

12 files changed, 249 insertions, 11 deletions

diff --git a/lib/models/id/channel_id.ml b/lib/models/id/channel_id.ml
index be4bfab..1017ad1 100644
--- a/lib/models/id/channel_id.ml
+++ b/lib/models/id/channel_id.ml
@@ -1,2 +1,55 @@
+open Core

 include Channel_id_t

-include Impl.Channel(Channel_id_t)
\ No newline at end of file
+

+exception Invalid_message

+exception No_message_found

+

+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);

+    ])

+

+let say content ch =

+    send_message ~content ch

+

+let delete ch =

+    Http.delete_channel (get_id ch)

+

+let get_message ~id ch =

+    Http.get_message (get_id ch) id

+

+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

+

+let broadcast_typing ch =

+    Http.broadcast_typing (get_id ch)

+

+let get_pins ch =

+    Http.get_pinned_messages (get_id ch)

+

+let bulk_delete msgs ch =

+    let msgs = `List (List.map ~f:(fun id -> `Int id) msgs) in

+    Http.bulk_delete (get_id ch) msgs
\ No newline at end of file
diff --git a/lib/models/id/channel_id.mli b/lib/models/id/channel_id.mli
index 59b4d23..20987c5 100644
--- a/lib/models/id/channel_id.mli
+++ b/lib/models/id/channel_id.mli
@@ -1,3 +1,46 @@
+open Async

 include module type of Channel_id_t

-include S.ChannelImpl with

-    type t := Channel_id_t.t
\ No newline at end of file
+

+exception Invalid_message

+exception No_message_found

+

+(** Advanced message sending.

+

+    Raises {!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 |> title "Hello World!") in

+                Channel_id.send_message ~embed msg.channel_id >>> 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

+

+(** [say str ch] is equivalent to [send_message ~content:str ch]. *)

+val say : string -> t -> Message_t.t Deferred.Or_error.t

+

+val delete : t -> Channel_t.t 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

+val bulk_delete : Snowflake.t list -> t -> unit Deferred.Or_error.t

+(* TODO more things related to guild channels *)
\ No newline at end of file
diff --git a/lib/models/id/channel_id_t.ml b/lib/models/id/channel_id_t.ml
index e49beef..cea85e0 100644
--- a/lib/models/id/channel_id_t.ml
+++ b/lib/models/id/channel_id_t.ml
@@ -1,5 +1,9 @@
+open Core

+

 type t = [ `Channel_id of Snowflake.t ] [@@deriving sexp]

 

+let compare (`Channel_id t) (`Channel_id t') = Int.compare t t'

+

 let of_yojson a : (t, string) result =

     match Snowflake.of_yojson a with

     | Ok id -> Ok (`Channel_id id)

diff --git a/lib/models/id/channel_id_t.mli b/lib/models/id/channel_id_t.mli
index df0d518..72324a7 100644
--- a/lib/models/id/channel_id_t.mli
+++ b/lib/models/id/channel_id_t.mli
@@ -1,3 +1,4 @@
 type t = [ `Channel_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }]

 

+val compare : t -> t -> int

 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
index 79b4323..6b3385c 100644
--- a/lib/models/id/guild_id.ml
+++ b/lib/models/id/guild_id.ml
@@ -1,2 +1,104 @@
 include Guild_id_t

-include Impl.Guild(Guild_id_t)
\ No newline at end of file
+

+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_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
\ No newline at end of file
diff --git a/lib/models/id/guild_id.mli b/lib/models/id/guild_id.mli
index 88e9fa7..11f34f7 100644
--- a/lib/models/id/guild_id.mli
+++ b/lib/models/id/guild_id.mli
@@ -1,3 +1,31 @@
+open Async

 include module type of Guild_id_t

-include S.GuildImpl with

-    type t := Guild_id_t.t
\ No newline at end of file
+

+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_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
\ No newline at end of file
diff --git a/lib/models/id/guild_id_t.ml b/lib/models/id/guild_id_t.ml
index cd8eb58..a39c07d 100644
--- a/lib/models/id/guild_id_t.ml
+++ b/lib/models/id/guild_id_t.ml
@@ -1,5 +1,9 @@
+open Core

+

 type t = [ `Guild_id of Snowflake.t ] [@@deriving sexp]

 

+let compare (`Guild_id t) (`Guild_id t') = Int.compare t t'

+

 let of_yojson a : (t, string) result =

     match Snowflake.of_yojson a with

     | Ok id -> Ok (`Guild_id id)

diff --git a/lib/models/id/guild_id_t.mli b/lib/models/id/guild_id_t.mli
index 4605d34..f4d415a 100644
--- a/lib/models/id/guild_id_t.mli
+++ b/lib/models/id/guild_id_t.mli
@@ -1,3 +1,4 @@
 type t = [ `Guild_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }]

 

+val compare : t -> t -> int

 val get_id : t -> Snowflake.t
\ No newline at end of file
diff --git a/lib/models/id/user_id.ml b/lib/models/id/user_id.ml
index cc71764..00d930f 100644
--- a/lib/models/id/user_id.ml
+++ b/lib/models/id/user_id.ml
@@ -1,2 +1 @@
-include User_id_t

-include Impl.User(User_id_t)
\ No newline at end of file
+include User_id_t
\ No newline at end of file
diff --git a/lib/models/id/user_id.mli b/lib/models/id/user_id.mli
index 574c4f0..f9506f7 100644
--- a/lib/models/id/user_id.mli
+++ b/lib/models/id/user_id.mli
@@ -1,3 +1 @@
-include module type of User_id_t

-include S.UserImpl with

-    type t := User_id_t.t
\ No newline at end of file
+include module type of User_id_t
\ No newline at end of file
diff --git a/lib/models/id/user_id_t.ml b/lib/models/id/user_id_t.ml
index f168daa..cf1634a 100644
--- a/lib/models/id/user_id_t.ml
+++ b/lib/models/id/user_id_t.ml
@@ -1,5 +1,9 @@
+open Core

+

 type t = [ `User_id of Snowflake.t ] [@@deriving sexp]

 

+let compare (`User_id t) (`User_id t') = Int.compare t t'

+

 let of_yojson a : (t, string) result =

     match Snowflake.of_yojson a with

     | Ok id -> Ok (`User_id id)

diff --git a/lib/models/id/user_id_t.mli b/lib/models/id/user_id_t.mli
index 194951b..e728b00 100644
--- a/lib/models/id/user_id_t.mli
+++ b/lib/models/id/user_id_t.mli
@@ -1,3 +1,4 @@
 type t = [ `User_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }]

 

+val compare : t -> t -> int

 val get_id : t -> Snowflake.t
\ No newline at end of file