From 7c9b809078b5cd53e3d54c0004c683da2ec679af Mon Sep 17 00:00:00 2001 From: Adelyn Breedlove Date: Mon, 11 Feb 2019 17:23:59 +0000 Subject: Add a cache --- lib/models/id/channel_id.ml | 55 +++++++++++++++++++++- lib/models/id/channel_id.mli | 47 ++++++++++++++++++- lib/models/id/channel_id_t.ml | 4 ++ lib/models/id/channel_id_t.mli | 1 + lib/models/id/guild_id.ml | 104 ++++++++++++++++++++++++++++++++++++++++- lib/models/id/guild_id.mli | 32 ++++++++++++- lib/models/id/guild_id_t.ml | 4 ++ lib/models/id/guild_id_t.mli | 1 + lib/models/id/user_id.ml | 3 +- lib/models/id/user_id.mli | 4 +- lib/models/id/user_id_t.ml | 4 ++ lib/models/id/user_id_t.mli | 1 + 12 files changed, 249 insertions(+), 11 deletions(-) (limited to 'lib/models/id') 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 -- cgit v1.2.3