From c3d6e15bb89d4a93a2fa486db6c8e126baf4da2e Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Mon, 21 Jan 2019 08:52:33 -0700 Subject: folder restructure --- lib/models/activity.ml | 7 -- lib/models/activity.mli | 5 -- lib/models/attachment.ml | 11 --- lib/models/attachment.mli | 9 --- lib/models/ban.ml | 1 - lib/models/ban.mli | 1 - lib/models/ban_t.ml | 6 -- lib/models/channel.ml | 57 -------------- lib/models/channel.mli | 44 ----------- lib/models/channel/channel.ml | 57 ++++++++++++++ lib/models/channel/channel.mli | 44 +++++++++++ lib/models/channel/channel_t.ml | 118 +++++++++++++++++++++++++++ lib/models/channel/message/attachment.ml | 11 +++ lib/models/channel/message/attachment.mli | 9 +++ lib/models/channel/message/embed.ml | 121 ++++++++++++++++++++++++++++ lib/models/channel/message/embed.mli | 79 +++++++++++++++++++ lib/models/channel/message/message.ml | 70 ++++++++++++++++ lib/models/channel/message/message.mli | 20 +++++ lib/models/channel/message/message_t.ml | 45 +++++++++++ lib/models/channel/message/reaction.ml | 1 + lib/models/channel/message/reaction.mli | 6 ++ lib/models/channel/message/reaction_t.ml | 14 ++++ lib/models/channel_t.ml | 118 --------------------------- lib/models/embed.ml | 121 ---------------------------- lib/models/embed.mli | 79 ------------------- lib/models/guild.ml | 127 ------------------------------ lib/models/guild.mli | 35 -------- lib/models/guild/ban.ml | 1 + lib/models/guild/ban.mli | 1 + lib/models/guild/ban_t.ml | 6 ++ lib/models/guild/guild.ml | 127 ++++++++++++++++++++++++++++++ lib/models/guild/guild.mli | 35 ++++++++ lib/models/guild/guild_t.ml | 67 ++++++++++++++++ lib/models/guild/member.ml | 43 ++++++++++ lib/models/guild/member.mli | 12 +++ lib/models/guild/member_t.ml | 43 ++++++++++ lib/models/guild/role.ml | 23 ++++++ lib/models/guild/role.mli | 11 +++ lib/models/guild/role_t.ml | 32 ++++++++ lib/models/guild_t.ml | 67 ---------------- lib/models/member.ml | 43 ---------- lib/models/member.mli | 12 --- lib/models/member_t.ml | 43 ---------- lib/models/message.ml | 70 ---------------- lib/models/message.mli | 20 ----- lib/models/message_t.ml | 45 ----------- lib/models/presence.ml | 10 --- lib/models/reaction.ml | 1 - lib/models/reaction.mli | 6 -- lib/models/reaction_t.ml | 14 ---- lib/models/role.ml | 23 ------ lib/models/role.mli | 11 --- lib/models/role_t.ml | 32 -------- lib/models/user.ml | 20 ----- lib/models/user.mli | 8 -- lib/models/user/activity.ml | 7 ++ lib/models/user/activity.mli | 5 ++ lib/models/user/presence.ml | 10 +++ lib/models/user/user.ml | 20 +++++ lib/models/user/user.mli | 8 ++ lib/models/user/user_t.ml | 13 +++ lib/models/user_t.ml | 13 --- 62 files changed, 1059 insertions(+), 1059 deletions(-) delete mode 100644 lib/models/activity.ml delete mode 100644 lib/models/activity.mli delete mode 100644 lib/models/attachment.ml delete mode 100644 lib/models/attachment.mli delete mode 100644 lib/models/ban.ml delete mode 100644 lib/models/ban.mli delete mode 100644 lib/models/ban_t.ml delete mode 100644 lib/models/channel.ml delete mode 100644 lib/models/channel.mli create mode 100644 lib/models/channel/channel.ml create mode 100644 lib/models/channel/channel.mli create mode 100644 lib/models/channel/channel_t.ml create mode 100644 lib/models/channel/message/attachment.ml create mode 100644 lib/models/channel/message/attachment.mli create mode 100644 lib/models/channel/message/embed.ml create mode 100644 lib/models/channel/message/embed.mli create mode 100644 lib/models/channel/message/message.ml create mode 100644 lib/models/channel/message/message.mli create mode 100644 lib/models/channel/message/message_t.ml create mode 100644 lib/models/channel/message/reaction.ml create mode 100644 lib/models/channel/message/reaction.mli create mode 100644 lib/models/channel/message/reaction_t.ml delete mode 100644 lib/models/channel_t.ml delete mode 100644 lib/models/embed.ml delete mode 100644 lib/models/embed.mli delete mode 100644 lib/models/guild.ml delete mode 100644 lib/models/guild.mli create mode 100644 lib/models/guild/ban.ml create mode 100644 lib/models/guild/ban.mli create mode 100644 lib/models/guild/ban_t.ml create mode 100644 lib/models/guild/guild.ml create mode 100644 lib/models/guild/guild.mli create mode 100644 lib/models/guild/guild_t.ml create mode 100644 lib/models/guild/member.ml create mode 100644 lib/models/guild/member.mli create mode 100644 lib/models/guild/member_t.ml create mode 100644 lib/models/guild/role.ml create mode 100644 lib/models/guild/role.mli create mode 100644 lib/models/guild/role_t.ml delete mode 100644 lib/models/guild_t.ml delete mode 100644 lib/models/member.ml delete mode 100644 lib/models/member.mli delete mode 100644 lib/models/member_t.ml delete mode 100644 lib/models/message.ml delete mode 100644 lib/models/message.mli delete mode 100644 lib/models/message_t.ml delete mode 100644 lib/models/presence.ml delete mode 100644 lib/models/reaction.ml delete mode 100644 lib/models/reaction.mli delete mode 100644 lib/models/reaction_t.ml delete mode 100644 lib/models/role.ml delete mode 100644 lib/models/role.mli delete mode 100644 lib/models/role_t.ml delete mode 100644 lib/models/user.ml delete mode 100644 lib/models/user.mli create mode 100644 lib/models/user/activity.ml create mode 100644 lib/models/user/activity.mli create mode 100644 lib/models/user/presence.ml create mode 100644 lib/models/user/user.ml create mode 100644 lib/models/user/user.mli create mode 100644 lib/models/user/user_t.ml delete mode 100644 lib/models/user_t.ml (limited to 'lib') diff --git a/lib/models/activity.ml b/lib/models/activity.ml deleted file mode 100644 index 8e6ff80..0000000 --- a/lib/models/activity.ml +++ /dev/null @@ -1,7 +0,0 @@ -open Core - -type t = { - name: string; - kind: int [@key "type"]; - url: string [@default ""]; -} [@@deriving sexp, yojson { strict = false}] \ No newline at end of file diff --git a/lib/models/activity.mli b/lib/models/activity.mli deleted file mode 100644 index 53173b7..0000000 --- a/lib/models/activity.mli +++ /dev/null @@ -1,5 +0,0 @@ -type t = { - name: string; - kind: int; - url: string; -} [@@deriving sexp, yojson] \ No newline at end of file diff --git a/lib/models/attachment.ml b/lib/models/attachment.ml deleted file mode 100644 index c56b389..0000000 --- a/lib/models/attachment.ml +++ /dev/null @@ -1,11 +0,0 @@ -open Core - -type t = { - id: Snowflake.t; - filename: string; - size: int; - url: string; - proxy_url: string; - height: int [@default -1]; - width: int [@default -1]; -} [@@deriving sexp, yojson { strict = false}] \ No newline at end of file diff --git a/lib/models/attachment.mli b/lib/models/attachment.mli deleted file mode 100644 index 2780011..0000000 --- a/lib/models/attachment.mli +++ /dev/null @@ -1,9 +0,0 @@ -type t = { - id: Snowflake.t; - filename: string; - size: int; - url: string; - proxy_url: string; - height: int; - width: int; -} [@@deriving sexp, yojson] \ No newline at end of file diff --git a/lib/models/ban.ml b/lib/models/ban.ml deleted file mode 100644 index 45f7679..0000000 --- a/lib/models/ban.ml +++ /dev/null @@ -1 +0,0 @@ -include Ban_t \ No newline at end of file diff --git a/lib/models/ban.mli b/lib/models/ban.mli deleted file mode 100644 index f8b1c2e..0000000 --- a/lib/models/ban.mli +++ /dev/null @@ -1 +0,0 @@ -include module type of Ban_t \ No newline at end of file diff --git a/lib/models/ban_t.ml b/lib/models/ban_t.ml deleted file mode 100644 index b49eefc..0000000 --- a/lib/models/ban_t.ml +++ /dev/null @@ -1,6 +0,0 @@ -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/channel.ml b/lib/models/channel.ml deleted file mode 100644 index 972f888..0000000 --- a/lib/models/channel.ml +++ /dev/null @@ -1,57 +0,0 @@ -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 diff --git a/lib/models/channel.mli b/lib/models/channel.mli deleted file mode 100644 index 001bb05..0000000 --- a/lib/models/channel.mli +++ /dev/null @@ -1,44 +0,0 @@ -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 diff --git a/lib/models/channel/channel.ml b/lib/models/channel/channel.ml new file mode 100644 index 0000000..972f888 --- /dev/null +++ b/lib/models/channel/channel.ml @@ -0,0 +1,57 @@ +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 diff --git a/lib/models/channel/channel.mli b/lib/models/channel/channel.mli new file mode 100644 index 0000000..001bb05 --- /dev/null +++ b/lib/models/channel/channel.mli @@ -0,0 +1,44 @@ +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 diff --git a/lib/models/channel/channel_t.ml b/lib/models/channel/channel_t.ml new file mode 100644 index 0000000..dce1d54 --- /dev/null +++ b/lib/models/channel/channel_t.ml @@ -0,0 +1,118 @@ +open Core + +exception Invalid_channel of Yojson.Safe.json + +type group = { + id: Snowflake.t; + last_message_id: Snowflake.t option [@default None]; + last_pin_timestamp: string option [@default None]; + icon: string option [@default None]; + name: string option [@default None]; + owner_id: Snowflake.t; + recipients: User_t.t list [@default []]; +} [@@deriving sexp, yojson { strict = false}] + +type dm = { + id: Snowflake.t; + last_message_id: Snowflake.t option [@default None]; + last_pin_timestamp: string option [@default None]; +} [@@deriving sexp, yojson { strict = false}] + +type guild_text = { + id: Snowflake.t; + last_message_id: Snowflake.t option [@default None]; + last_pin_timestamp: string option [@default None]; + category_id: Snowflake.t option [@default None][@key "parent_id"]; + guild_id: Snowflake.t option [@default None]; + name: string; + position: int; + topic: string option [@default None]; + nsfw: bool; + slow_mode_timeout: int option [@default None]; +} [@@deriving sexp, yojson { strict = false}] + +type guild_voice = { + id: Snowflake.t; + category_id: Snowflake.t option [@default None][@key "parent_id"]; + guild_id: Snowflake.t option [@default None]; + name: string; + position: int; + user_limit: int [@default -1]; + bitrate: int option [@default None]; +} [@@deriving sexp, yojson { strict = false}] + +type category = { + id: Snowflake.t; + guild_id: Snowflake.t option [@default None]; + position: int; + name: string; +} [@@deriving sexp, yojson { strict = false}] + +type t = +| Group of group +| Private of dm +| GuildText of guild_text +| GuildVoice of guild_voice +| Category of category +[@@deriving sexp, yojson { strict = false}] + +type channel_wrapper = { + id: Snowflake.t; + kind: int [@key "type"]; + guild_id: Snowflake.t option [@default None]; + position: int option [@default None]; + name: string option [@default None]; + topic: string option [@default None]; + nsfw: bool option [@default None]; + last_message_id: Snowflake.t option [@default None]; + bitrate: int option [@default None]; + user_limit: int option [@default None]; + slow_mode_timeout: int option [@default None]; + recipients: User_t.t list option [@default None]; + icon: string option [@default None]; + owner_id: Snowflake.t option [@default None]; + application_id: Snowflake.t option [@default None]; + category_id: Snowflake.t option [@default None][@key "parent_id"]; + last_pin_timestamp: string option [@default None]; +} [@@deriving sexp, yojson { strict = false}] + +let unwrap_as_guild_text {id;guild_id;position;name;topic;nsfw;last_message_id;slow_mode_timeout;category_id;last_pin_timestamp;_} = + let position = Option.value_exn position in + let name = Option.value_exn name in + let nsfw = Option.value ~default:false nsfw in + { id; guild_id; position; name; topic; nsfw; last_message_id; slow_mode_timeout; category_id; last_pin_timestamp } + +let unwrap_as_guild_voice {id;guild_id;position;name;bitrate;user_limit;category_id;_} = + let position = Option.value_exn position in + let name = Option.value_exn name in + let user_limit = Option.value ~default:(-1) user_limit in + { id; guild_id; position; name; user_limit; bitrate ; category_id; } + +let unwrap_as_dm {id;last_message_id;last_pin_timestamp;_} = + { id; last_message_id; last_pin_timestamp; } + +let unwrap_as_group {id;name;last_message_id;recipients;icon;owner_id;last_pin_timestamp;_} = + let recipients = Option.value ~default:[] recipients in + let owner_id = Option.value_exn owner_id in + { id; name; last_message_id; recipients; icon; owner_id; last_pin_timestamp; } + +let unwrap_as_category {id;guild_id;position;name;_} = + let position = Option.value_exn position in + let name = Option.value_exn name in + { id; guild_id; position; name; } + +let wrap s = + match s.kind with + | 0 -> GuildText (unwrap_as_guild_text s) + | 1 -> Private (unwrap_as_dm s) + | 2 -> GuildVoice (unwrap_as_guild_voice s) + | 3 -> Group (unwrap_as_group s) + | 4 -> Category (unwrap_as_category s) + | _ -> raise (Invalid_channel (channel_wrapper_to_yojson s)) + +let get_id = function +| Group g -> g.id +| Private p -> p.id +| GuildText t -> t.id +| GuildVoice v -> v.id +| Category c -> c.id \ No newline at end of file diff --git a/lib/models/channel/message/attachment.ml b/lib/models/channel/message/attachment.ml new file mode 100644 index 0000000..c56b389 --- /dev/null +++ b/lib/models/channel/message/attachment.ml @@ -0,0 +1,11 @@ +open Core + +type t = { + id: Snowflake.t; + filename: string; + size: int; + url: string; + proxy_url: string; + height: int [@default -1]; + width: int [@default -1]; +} [@@deriving sexp, yojson { strict = false}] \ No newline at end of file diff --git a/lib/models/channel/message/attachment.mli b/lib/models/channel/message/attachment.mli new file mode 100644 index 0000000..2780011 --- /dev/null +++ b/lib/models/channel/message/attachment.mli @@ -0,0 +1,9 @@ +type t = { + id: Snowflake.t; + filename: string; + size: int; + url: string; + proxy_url: string; + height: int; + width: int; +} [@@deriving sexp, yojson] \ No newline at end of file diff --git a/lib/models/channel/message/embed.ml b/lib/models/channel/message/embed.ml new file mode 100644 index 0000000..9f9aacd --- /dev/null +++ b/lib/models/channel/message/embed.ml @@ -0,0 +1,121 @@ +open Core + +type footer = { + text: string; + icon_url: string option [@default None]; + proxy_icon_url: string option [@default None]; +} [@@deriving sexp, yojson] + +type image = { + url: string option [@default None]; + proxy_url: string option [@default None]; + height: int option [@default None]; + width: int option [@default None]; +} [@@deriving sexp, yojson] + +type video = { + url: string option [@default None]; + height: int option [@default None]; + width: int option [@default None]; +} [@@deriving sexp, yojson] + +type provider = { + name: string option [@default None]; + url: string option [@default None]; +} [@@deriving sexp, yojson] + +type author = { + name: string option [@default None]; + url: string option [@default None]; + icon_url: string option [@default None]; + proxy_icon_url: string option [@default None]; +} [@@deriving sexp, yojson] + +type field = { + name: string; + value: string; + inline: bool [@default false]; +} [@@deriving sexp, yojson] + +type t = { + title: string option [@default None]; + kind: string option [@default None][@key "type"]; + description: string option [@default None]; + url: string option [@default None]; + timestamp: string option [@default None]; + colour: int option [@default None][@key "color"]; + footer: footer option [@default None]; + image: image option [@default None]; + thumbnail: image option [@default None]; + video: video option [@default None]; + provider: provider option [@default None]; + author: author option [@default None]; + fields: field list [@default []]; +} [@@deriving sexp, yojson { strict = false }] + +let default = { + title = None; + kind = None; + description = None; + url = None; + timestamp = None; + colour = None; + footer = None; + image = None; + thumbnail = None; + video = None; + provider = None; + author = None; + fields = []; +} + +let default_footer = { + text = ""; + icon_url = None; + proxy_icon_url = None; +} + +let default_image = { + url = None; + proxy_url = None; + height = None; + width = None; +} + +let default_video = { + url = None; + width = None; + height = None; +} + +let default_provider = { + name = None; + url = None; +} + +let default_author = { + name = None; + url = None; + icon_url = None; + proxy_icon_url = None; +} + +let title v e = { e with title = Some v } +let description v e = { e with description = Some v } +let url v e = { e with url = Some v } +let timestamp v e = { e with timestamp = Some v } +let colour v e = { e with colour = Some v } +let color v e = { e with colour = Some v } +let footer f e = { e with footer = Some (f default_footer) } +let image v e = { e with image = Some { default_image with url = Some v } } +let thumbnail v e = { e with thumbnail = Some { default_image with url = Some v } } +let author f e = { e with author = Some (f default_author) } +let field (name, value, inline) e = { e with fields = { name; value; inline; }::e.fields } +let fields l e = { e with fields = List.map ~f:(fun (name, value, inline) -> { name; value; inline; }) l } + +let footer_text v f : footer = { f with text = v } +let footer_icon v f : footer = { f with icon_url = Some v } + +let author_name v a : author = { a with name = Some v } +let author_url v a : author = { a with url = Some v } +let author_icon v a : author = { a with icon_url = Some v } \ No newline at end of file diff --git a/lib/models/channel/message/embed.mli b/lib/models/channel/message/embed.mli new file mode 100644 index 0000000..d15c9fd --- /dev/null +++ b/lib/models/channel/message/embed.mli @@ -0,0 +1,79 @@ +type footer = { + text: string; + icon_url: string option; + proxy_icon_url: string option; +} [@@deriving sexp, yojson] + +type image = { + url: string option; + proxy_url: string option; + height: int option; + width: int option; +} [@@deriving sexp, yojson] + +type video = { + url: string option; + height: int option; + width: int option; +} [@@deriving sexp, yojson] + +type provider = { + name: string option; + url: string option; +} [@@deriving sexp, yojson] + +type author = { + name: string option; + url: string option; + icon_url: string option; + proxy_icon_url: string option; +} [@@deriving sexp, yojson] + +type field = { + name: string; + value: string; + inline: bool; +} [@@deriving sexp, yojson] + +type t = { + title: string option; + kind: string option[@key "type"]; + description: string option; + url: string option; + timestamp: string option; + colour: int option[@key "color"]; + footer: footer option; + image: image option; + thumbnail: image option; + video: video option; + provider: provider option; + author: author option; + fields: field list [@default []]; +} [@@deriving sexp, yojson { strict = false }] + +val default : t +val default_footer : footer +val default_image : image +val default_video : video +val default_provider : provider +val default_author : author + +val title : string -> t -> t +val description : string -> t -> t +val url : string -> t -> t +val timestamp : string -> t -> t +val colour : int -> t -> t +val color : int -> t -> t +val footer : (footer -> footer) -> t -> t +val image : string -> t -> t +val thumbnail : string -> t -> t +val author : (author -> author) -> t -> t +val field : string * string * bool -> t -> t +val fields : (string * string * bool) list -> t -> t + +val footer_text : string -> footer -> footer +val footer_icon : string -> footer -> footer + +val author_name : string -> author -> author +val author_url : string -> author -> author +val author_icon : string -> author -> author \ No newline at end of file diff --git a/lib/models/channel/message/message.ml b/lib/models/channel/message/message.ml new file mode 100644 index 0000000..f772c48 --- /dev/null +++ b/lib/models/channel/message/message.ml @@ -0,0 +1,70 @@ +open Core +open Async +include Message_t + +let add_reaction msg (emoji:Emoji.t) = + let e = match emoji.id with + | Some i -> Printf.sprintf "%s:%d" emoji.name i + | None -> emoji.name + in + Http.create_reaction msg.channel_id msg.id e + >>| Result.map ~f:ignore + +let remove_reaction msg (emoji:Emoji.t) (user:User_t.t) = + let e = match emoji.id with + | Some i -> Printf.sprintf "%s:%d" emoji.name i + | None -> emoji.name + in + Http.delete_reaction msg.channel_id msg.id e user.id + >>| Result.map ~f:ignore + +let clear_reactions msg = + Http.delete_reactions msg.channel_id msg.id + >>| Result.map ~f:ignore + +let delete msg = + Http.delete_message msg.channel_id msg.id + >>| Result.map ~f:ignore + +let pin msg = + Http.pin_message msg.channel_id msg.id + >>| Result.map ~f:ignore + +let unpin msg = + Http.unpin_message msg.channel_id msg.id + >>| Result.map ~f:ignore + +let reply msg cont = + let rep = `Assoc [("content", `String cont)] in + Http.create_message msg.channel_id rep + >>| Result.map ~f:Message_t.of_yojson_exn + +let reply_with ?embed ?content ?file ?(tts=false) msg = + 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 Channel.Invalid_message + | _ -> () in + Http.create_message (msg.channel_id) (`Assoc [ + ("embed", embed); + ("content", content); + ("file", file); + ("tts", `Bool tts); + ]) >>| Result.map ~f:Message_t.of_yojson_exn + +let set_content msg cont = + to_yojson { msg with content = cont; } + |> Http.edit_message msg.channel_id msg.id + >>| Result.map ~f:Message_t.of_yojson_exn + +let set_embed msg embed = + to_yojson { msg with embeds = [embed]; } + |> Http.edit_message msg.channel_id msg.id + >>| Result.map ~f:Message_t.of_yojson_exn \ No newline at end of file diff --git a/lib/models/channel/message/message.mli b/lib/models/channel/message/message.mli new file mode 100644 index 0000000..09e62a4 --- /dev/null +++ b/lib/models/channel/message/message.mli @@ -0,0 +1,20 @@ +open Async + +include module type of Message_t + +val add_reaction : t -> Emoji.t -> unit Deferred.Or_error.t +val remove_reaction : t -> Emoji.t -> User_t.t -> unit Deferred.Or_error.t +val clear_reactions : t -> unit Deferred.Or_error.t +val delete : t -> unit Deferred.Or_error.t +val pin : t -> unit Deferred.Or_error.t +val unpin : t -> unit Deferred.Or_error.t +val reply : t -> string -> t Deferred.Or_error.t +val reply_with : + ?embed:Embed.t -> + ?content:string -> + ?file:string -> + ?tts:bool -> + t -> + Message_t.t Deferred.Or_error.t +val set_content : t -> string -> t Deferred.Or_error.t +val set_embed : t -> Embed.t -> t Deferred.Or_error.t \ No newline at end of file diff --git a/lib/models/channel/message/message_t.ml b/lib/models/channel/message/message_t.ml new file mode 100644 index 0000000..c4253d5 --- /dev/null +++ b/lib/models/channel/message/message_t.ml @@ -0,0 +1,45 @@ +open Core + +type message_update = { + id: Snowflake.t; + author: User_t.t option [@default None]; + channel_id: Snowflake.t; + member: Member_t.partial_member option [@default None]; + guild_id: Snowflake.t option [@default None]; + content: string option [@default None]; + timestamp: string option [@default None]; + editedimestamp: string option [@default None]; + tts: bool option [@default None]; + mention_everyone: bool option [@default None]; + mentions: Snowflake.t list [@default []]; + role_mentions: Snowflake.t list [@default []]; + attachments: Attachment.t list [@default []]; + embeds: Embed.t list [@default []]; + reactions: Snowflake.t list [@default []]; + nonce: Snowflake.t option [@default None]; + pinned: bool option [@default None]; + webhook_id: Snowflake.t option [@default None]; + kind: int option [@default None][@key "type"]; +} [@@deriving sexp, yojson { strict = false}] + +type t = { + id: Snowflake.t; + author: User_t.t; + channel_id: Snowflake.t; + member: Member_t.partial_member option [@default None]; + guild_id: Snowflake.t option [@default None]; + content: string; + timestamp: string; + editedimestamp: string option [@default None]; + tts: bool; + mention_everyone: bool; + (* mentions: Snowflake.t list [@default []]; *) + (* role_mentions: Snowflake.t list [@default []]; *) + attachments: Attachment.t list [@default []]; + embeds: Embed.t list [@default []]; + reactions: Snowflake.t list [@default []]; + nonce: Snowflake.t option [@default None]; + pinned: bool; + webhook_id: Snowflake.t option [@default None]; + kind: int [@key "type"]; +} [@@deriving sexp, yojson { strict = false}] \ No newline at end of file diff --git a/lib/models/channel/message/reaction.ml b/lib/models/channel/message/reaction.ml new file mode 100644 index 0000000..c4ab326 --- /dev/null +++ b/lib/models/channel/message/reaction.ml @@ -0,0 +1 @@ +include Reaction_t \ No newline at end of file diff --git a/lib/models/channel/message/reaction.mli b/lib/models/channel/message/reaction.mli new file mode 100644 index 0000000..38343cb --- /dev/null +++ b/lib/models/channel/message/reaction.mli @@ -0,0 +1,6 @@ +include module type of Reaction_t + +(* val delete : Reaction_t.t -> Yojson.Safe.json Deferred.Or_error.t +val get_users : Reaction_t.t -> int -> User_t.t list Deferred.Or_error.t +val get_users_after : Reaction_t.t -> Snowflake.t -> int -> User_t.t list Deferred.Or_error.t +val get_users_before : Reaction_t.t -> Snowflake.t -> int -> User_t.t list Deferred.Or_error.t *) \ No newline at end of file diff --git a/lib/models/channel/message/reaction_t.ml b/lib/models/channel/message/reaction_t.ml new file mode 100644 index 0000000..c382b68 --- /dev/null +++ b/lib/models/channel/message/reaction_t.ml @@ -0,0 +1,14 @@ +open Core + +type reaction_event = { + user_id: Snowflake.t; + channel_id: Snowflake.t; + message_id: Snowflake.t; + guild_id: Snowflake.t option [@default None]; + emoji: Emoji.partial_emoji; +} [@@deriving sexp, yojson] + +type t = { + count: int; + emoji: Emoji.t; +} [@@deriving sexp, yojson { strict = false}] \ No newline at end of file diff --git a/lib/models/channel_t.ml b/lib/models/channel_t.ml deleted file mode 100644 index dce1d54..0000000 --- a/lib/models/channel_t.ml +++ /dev/null @@ -1,118 +0,0 @@ -open Core - -exception Invalid_channel of Yojson.Safe.json - -type group = { - id: Snowflake.t; - last_message_id: Snowflake.t option [@default None]; - last_pin_timestamp: string option [@default None]; - icon: string option [@default None]; - name: string option [@default None]; - owner_id: Snowflake.t; - recipients: User_t.t list [@default []]; -} [@@deriving sexp, yojson { strict = false}] - -type dm = { - id: Snowflake.t; - last_message_id: Snowflake.t option [@default None]; - last_pin_timestamp: string option [@default None]; -} [@@deriving sexp, yojson { strict = false}] - -type guild_text = { - id: Snowflake.t; - last_message_id: Snowflake.t option [@default None]; - last_pin_timestamp: string option [@default None]; - category_id: Snowflake.t option [@default None][@key "parent_id"]; - guild_id: Snowflake.t option [@default None]; - name: string; - position: int; - topic: string option [@default None]; - nsfw: bool; - slow_mode_timeout: int option [@default None]; -} [@@deriving sexp, yojson { strict = false}] - -type guild_voice = { - id: Snowflake.t; - category_id: Snowflake.t option [@default None][@key "parent_id"]; - guild_id: Snowflake.t option [@default None]; - name: string; - position: int; - user_limit: int [@default -1]; - bitrate: int option [@default None]; -} [@@deriving sexp, yojson { strict = false}] - -type category = { - id: Snowflake.t; - guild_id: Snowflake.t option [@default None]; - position: int; - name: string; -} [@@deriving sexp, yojson { strict = false}] - -type t = -| Group of group -| Private of dm -| GuildText of guild_text -| GuildVoice of guild_voice -| Category of category -[@@deriving sexp, yojson { strict = false}] - -type channel_wrapper = { - id: Snowflake.t; - kind: int [@key "type"]; - guild_id: Snowflake.t option [@default None]; - position: int option [@default None]; - name: string option [@default None]; - topic: string option [@default None]; - nsfw: bool option [@default None]; - last_message_id: Snowflake.t option [@default None]; - bitrate: int option [@default None]; - user_limit: int option [@default None]; - slow_mode_timeout: int option [@default None]; - recipients: User_t.t list option [@default None]; - icon: string option [@default None]; - owner_id: Snowflake.t option [@default None]; - application_id: Snowflake.t option [@default None]; - category_id: Snowflake.t option [@default None][@key "parent_id"]; - last_pin_timestamp: string option [@default None]; -} [@@deriving sexp, yojson { strict = false}] - -let unwrap_as_guild_text {id;guild_id;position;name;topic;nsfw;last_message_id;slow_mode_timeout;category_id;last_pin_timestamp;_} = - let position = Option.value_exn position in - let name = Option.value_exn name in - let nsfw = Option.value ~default:false nsfw in - { id; guild_id; position; name; topic; nsfw; last_message_id; slow_mode_timeout; category_id; last_pin_timestamp } - -let unwrap_as_guild_voice {id;guild_id;position;name;bitrate;user_limit;category_id;_} = - let position = Option.value_exn position in - let name = Option.value_exn name in - let user_limit = Option.value ~default:(-1) user_limit in - { id; guild_id; position; name; user_limit; bitrate ; category_id; } - -let unwrap_as_dm {id;last_message_id;last_pin_timestamp;_} = - { id; last_message_id; last_pin_timestamp; } - -let unwrap_as_group {id;name;last_message_id;recipients;icon;owner_id;last_pin_timestamp;_} = - let recipients = Option.value ~default:[] recipients in - let owner_id = Option.value_exn owner_id in - { id; name; last_message_id; recipients; icon; owner_id; last_pin_timestamp; } - -let unwrap_as_category {id;guild_id;position;name;_} = - let position = Option.value_exn position in - let name = Option.value_exn name in - { id; guild_id; position; name; } - -let wrap s = - match s.kind with - | 0 -> GuildText (unwrap_as_guild_text s) - | 1 -> Private (unwrap_as_dm s) - | 2 -> GuildVoice (unwrap_as_guild_voice s) - | 3 -> Group (unwrap_as_group s) - | 4 -> Category (unwrap_as_category s) - | _ -> raise (Invalid_channel (channel_wrapper_to_yojson s)) - -let get_id = function -| Group g -> g.id -| Private p -> p.id -| GuildText t -> t.id -| GuildVoice v -> v.id -| Category c -> c.id \ No newline at end of file diff --git a/lib/models/embed.ml b/lib/models/embed.ml deleted file mode 100644 index 9f9aacd..0000000 --- a/lib/models/embed.ml +++ /dev/null @@ -1,121 +0,0 @@ -open Core - -type footer = { - text: string; - icon_url: string option [@default None]; - proxy_icon_url: string option [@default None]; -} [@@deriving sexp, yojson] - -type image = { - url: string option [@default None]; - proxy_url: string option [@default None]; - height: int option [@default None]; - width: int option [@default None]; -} [@@deriving sexp, yojson] - -type video = { - url: string option [@default None]; - height: int option [@default None]; - width: int option [@default None]; -} [@@deriving sexp, yojson] - -type provider = { - name: string option [@default None]; - url: string option [@default None]; -} [@@deriving sexp, yojson] - -type author = { - name: string option [@default None]; - url: string option [@default None]; - icon_url: string option [@default None]; - proxy_icon_url: string option [@default None]; -} [@@deriving sexp, yojson] - -type field = { - name: string; - value: string; - inline: bool [@default false]; -} [@@deriving sexp, yojson] - -type t = { - title: string option [@default None]; - kind: string option [@default None][@key "type"]; - description: string option [@default None]; - url: string option [@default None]; - timestamp: string option [@default None]; - colour: int option [@default None][@key "color"]; - footer: footer option [@default None]; - image: image option [@default None]; - thumbnail: image option [@default None]; - video: video option [@default None]; - provider: provider option [@default None]; - author: author option [@default None]; - fields: field list [@default []]; -} [@@deriving sexp, yojson { strict = false }] - -let default = { - title = None; - kind = None; - description = None; - url = None; - timestamp = None; - colour = None; - footer = None; - image = None; - thumbnail = None; - video = None; - provider = None; - author = None; - fields = []; -} - -let default_footer = { - text = ""; - icon_url = None; - proxy_icon_url = None; -} - -let default_image = { - url = None; - proxy_url = None; - height = None; - width = None; -} - -let default_video = { - url = None; - width = None; - height = None; -} - -let default_provider = { - name = None; - url = None; -} - -let default_author = { - name = None; - url = None; - icon_url = None; - proxy_icon_url = None; -} - -let title v e = { e with title = Some v } -let description v e = { e with description = Some v } -let url v e = { e with url = Some v } -let timestamp v e = { e with timestamp = Some v } -let colour v e = { e with colour = Some v } -let color v e = { e with colour = Some v } -let footer f e = { e with footer = Some (f default_footer) } -let image v e = { e with image = Some { default_image with url = Some v } } -let thumbnail v e = { e with thumbnail = Some { default_image with url = Some v } } -let author f e = { e with author = Some (f default_author) } -let field (name, value, inline) e = { e with fields = { name; value; inline; }::e.fields } -let fields l e = { e with fields = List.map ~f:(fun (name, value, inline) -> { name; value; inline; }) l } - -let footer_text v f : footer = { f with text = v } -let footer_icon v f : footer = { f with icon_url = Some v } - -let author_name v a : author = { a with name = Some v } -let author_url v a : author = { a with url = Some v } -let author_icon v a : author = { a with icon_url = Some v } \ No newline at end of file diff --git a/lib/models/embed.mli b/lib/models/embed.mli deleted file mode 100644 index d15c9fd..0000000 --- a/lib/models/embed.mli +++ /dev/null @@ -1,79 +0,0 @@ -type footer = { - text: string; - icon_url: string option; - proxy_icon_url: string option; -} [@@deriving sexp, yojson] - -type image = { - url: string option; - proxy_url: string option; - height: int option; - width: int option; -} [@@deriving sexp, yojson] - -type video = { - url: string option; - height: int option; - width: int option; -} [@@deriving sexp, yojson] - -type provider = { - name: string option; - url: string option; -} [@@deriving sexp, yojson] - -type author = { - name: string option; - url: string option; - icon_url: string option; - proxy_icon_url: string option; -} [@@deriving sexp, yojson] - -type field = { - name: string; - value: string; - inline: bool; -} [@@deriving sexp, yojson] - -type t = { - title: string option; - kind: string option[@key "type"]; - description: string option; - url: string option; - timestamp: string option; - colour: int option[@key "color"]; - footer: footer option; - image: image option; - thumbnail: image option; - video: video option; - provider: provider option; - author: author option; - fields: field list [@default []]; -} [@@deriving sexp, yojson { strict = false }] - -val default : t -val default_footer : footer -val default_image : image -val default_video : video -val default_provider : provider -val default_author : author - -val title : string -> t -> t -val description : string -> t -> t -val url : string -> t -> t -val timestamp : string -> t -> t -val colour : int -> t -> t -val color : int -> t -> t -val footer : (footer -> footer) -> t -> t -val image : string -> t -> t -val thumbnail : string -> t -> t -val author : (author -> author) -> t -> t -val field : string * string * bool -> t -> t -val fields : (string * string * bool) list -> t -> t - -val footer_text : string -> footer -> footer -val footer_icon : string -> footer -> footer - -val author_name : string -> author -> author -val author_url : string -> author -> author -val author_icon : string -> author -> author \ No newline at end of file diff --git a/lib/models/guild.ml b/lib/models/guild.ml deleted file mode 100644 index c1b9925..0000000 --- a/lib/models/guild.ml +++ /dev/null @@ -1,127 +0,0 @@ -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.mli b/lib/models/guild.mli deleted file mode 100644 index e972951..0000000 --- a/lib/models/guild.mli +++ /dev/null @@ -1,35 +0,0 @@ -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/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 diff --git a/lib/models/guild_t.ml b/lib/models/guild_t.ml deleted file mode 100644 index 6bb5090..0000000 --- a/lib/models/guild_t.ml +++ /dev/null @@ -1,67 +0,0 @@ -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/member.ml b/lib/models/member.ml deleted file mode 100644 index 25f2f75..0000000 --- a/lib/models/member.ml +++ /dev/null @@ -1,43 +0,0 @@ -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/member.mli b/lib/models/member.mli deleted file mode 100644 index 3ac786c..0000000 --- a/lib/models/member.mli +++ /dev/null @@ -1,12 +0,0 @@ -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/member_t.ml b/lib/models/member_t.ml deleted file mode 100644 index e6edb61..0000000 --- a/lib/models/member_t.ml +++ /dev/null @@ -1,43 +0,0 @@ -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/message.ml b/lib/models/message.ml deleted file mode 100644 index f772c48..0000000 --- a/lib/models/message.ml +++ /dev/null @@ -1,70 +0,0 @@ -open Core -open Async -include Message_t - -let add_reaction msg (emoji:Emoji.t) = - let e = match emoji.id with - | Some i -> Printf.sprintf "%s:%d" emoji.name i - | None -> emoji.name - in - Http.create_reaction msg.channel_id msg.id e - >>| Result.map ~f:ignore - -let remove_reaction msg (emoji:Emoji.t) (user:User_t.t) = - let e = match emoji.id with - | Some i -> Printf.sprintf "%s:%d" emoji.name i - | None -> emoji.name - in - Http.delete_reaction msg.channel_id msg.id e user.id - >>| Result.map ~f:ignore - -let clear_reactions msg = - Http.delete_reactions msg.channel_id msg.id - >>| Result.map ~f:ignore - -let delete msg = - Http.delete_message msg.channel_id msg.id - >>| Result.map ~f:ignore - -let pin msg = - Http.pin_message msg.channel_id msg.id - >>| Result.map ~f:ignore - -let unpin msg = - Http.unpin_message msg.channel_id msg.id - >>| Result.map ~f:ignore - -let reply msg cont = - let rep = `Assoc [("content", `String cont)] in - Http.create_message msg.channel_id rep - >>| Result.map ~f:Message_t.of_yojson_exn - -let reply_with ?embed ?content ?file ?(tts=false) msg = - 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 Channel.Invalid_message - | _ -> () in - Http.create_message (msg.channel_id) (`Assoc [ - ("embed", embed); - ("content", content); - ("file", file); - ("tts", `Bool tts); - ]) >>| Result.map ~f:Message_t.of_yojson_exn - -let set_content msg cont = - to_yojson { msg with content = cont; } - |> Http.edit_message msg.channel_id msg.id - >>| Result.map ~f:Message_t.of_yojson_exn - -let set_embed msg embed = - to_yojson { msg with embeds = [embed]; } - |> Http.edit_message msg.channel_id msg.id - >>| Result.map ~f:Message_t.of_yojson_exn \ No newline at end of file diff --git a/lib/models/message.mli b/lib/models/message.mli deleted file mode 100644 index 09e62a4..0000000 --- a/lib/models/message.mli +++ /dev/null @@ -1,20 +0,0 @@ -open Async - -include module type of Message_t - -val add_reaction : t -> Emoji.t -> unit Deferred.Or_error.t -val remove_reaction : t -> Emoji.t -> User_t.t -> unit Deferred.Or_error.t -val clear_reactions : t -> unit Deferred.Or_error.t -val delete : t -> unit Deferred.Or_error.t -val pin : t -> unit Deferred.Or_error.t -val unpin : t -> unit Deferred.Or_error.t -val reply : t -> string -> t Deferred.Or_error.t -val reply_with : - ?embed:Embed.t -> - ?content:string -> - ?file:string -> - ?tts:bool -> - t -> - Message_t.t Deferred.Or_error.t -val set_content : t -> string -> t Deferred.Or_error.t -val set_embed : t -> Embed.t -> t Deferred.Or_error.t \ No newline at end of file diff --git a/lib/models/message_t.ml b/lib/models/message_t.ml deleted file mode 100644 index c4253d5..0000000 --- a/lib/models/message_t.ml +++ /dev/null @@ -1,45 +0,0 @@ -open Core - -type message_update = { - id: Snowflake.t; - author: User_t.t option [@default None]; - channel_id: Snowflake.t; - member: Member_t.partial_member option [@default None]; - guild_id: Snowflake.t option [@default None]; - content: string option [@default None]; - timestamp: string option [@default None]; - editedimestamp: string option [@default None]; - tts: bool option [@default None]; - mention_everyone: bool option [@default None]; - mentions: Snowflake.t list [@default []]; - role_mentions: Snowflake.t list [@default []]; - attachments: Attachment.t list [@default []]; - embeds: Embed.t list [@default []]; - reactions: Snowflake.t list [@default []]; - nonce: Snowflake.t option [@default None]; - pinned: bool option [@default None]; - webhook_id: Snowflake.t option [@default None]; - kind: int option [@default None][@key "type"]; -} [@@deriving sexp, yojson { strict = false}] - -type t = { - id: Snowflake.t; - author: User_t.t; - channel_id: Snowflake.t; - member: Member_t.partial_member option [@default None]; - guild_id: Snowflake.t option [@default None]; - content: string; - timestamp: string; - editedimestamp: string option [@default None]; - tts: bool; - mention_everyone: bool; - (* mentions: Snowflake.t list [@default []]; *) - (* role_mentions: Snowflake.t list [@default []]; *) - attachments: Attachment.t list [@default []]; - embeds: Embed.t list [@default []]; - reactions: Snowflake.t list [@default []]; - nonce: Snowflake.t option [@default None]; - pinned: bool; - webhook_id: Snowflake.t option [@default None]; - kind: int [@key "type"]; -} [@@deriving sexp, yojson { strict = false}] \ No newline at end of file diff --git a/lib/models/presence.ml b/lib/models/presence.ml deleted file mode 100644 index ab245a7..0000000 --- a/lib/models/presence.ml +++ /dev/null @@ -1,10 +0,0 @@ -open Core - -type t = { - user: User_t.partial_user; - roles: Snowflake.t list; - game: Activity.t option [@default None]; - guild_id: Snowflake.t; - status: string; - activities: Activity.t list; -} [@@deriving sexp, yojson { strict = false}] \ No newline at end of file diff --git a/lib/models/reaction.ml b/lib/models/reaction.ml deleted file mode 100644 index c4ab326..0000000 --- a/lib/models/reaction.ml +++ /dev/null @@ -1 +0,0 @@ -include Reaction_t \ No newline at end of file diff --git a/lib/models/reaction.mli b/lib/models/reaction.mli deleted file mode 100644 index 38343cb..0000000 --- a/lib/models/reaction.mli +++ /dev/null @@ -1,6 +0,0 @@ -include module type of Reaction_t - -(* val delete : Reaction_t.t -> Yojson.Safe.json Deferred.Or_error.t -val get_users : Reaction_t.t -> int -> User_t.t list Deferred.Or_error.t -val get_users_after : Reaction_t.t -> Snowflake.t -> int -> User_t.t list Deferred.Or_error.t -val get_users_before : Reaction_t.t -> Snowflake.t -> int -> User_t.t list Deferred.Or_error.t *) \ No newline at end of file diff --git a/lib/models/reaction_t.ml b/lib/models/reaction_t.ml deleted file mode 100644 index c382b68..0000000 --- a/lib/models/reaction_t.ml +++ /dev/null @@ -1,14 +0,0 @@ -open Core - -type reaction_event = { - user_id: Snowflake.t; - channel_id: Snowflake.t; - message_id: Snowflake.t; - guild_id: Snowflake.t option [@default None]; - emoji: Emoji.partial_emoji; -} [@@deriving sexp, yojson] - -type t = { - count: int; - emoji: Emoji.t; -} [@@deriving sexp, yojson { strict = false}] \ No newline at end of file diff --git a/lib/models/role.ml b/lib/models/role.ml deleted file mode 100644 index ee6bb0a..0000000 --- a/lib/models/role.ml +++ /dev/null @@ -1,23 +0,0 @@ -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/role.mli b/lib/models/role.mli deleted file mode 100644 index d37f733..0000000 --- a/lib/models/role.mli +++ /dev/null @@ -1,11 +0,0 @@ -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/role_t.ml b/lib/models/role_t.ml deleted file mode 100644 index e41f31d..0000000 --- a/lib/models/role_t.ml +++ /dev/null @@ -1,32 +0,0 @@ -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 diff --git a/lib/models/user.ml b/lib/models/user.ml deleted file mode 100644 index bd6583c..0000000 --- a/lib/models/user.ml +++ /dev/null @@ -1,20 +0,0 @@ -open Core -include User_t - -let tag user = - Printf.sprintf "%s#%s" user.username user.discriminator - -let mention user = - Printf.sprintf "<@%d>" user.id - -let default_avatar user = - let avatar = Int.of_string user.discriminator % 5 in - Endpoints.cdn_default_avatar avatar - -let face user = match user.avatar with - | Some avatar -> - let ext = if String.is_substring ~substring:"a_" avatar - then "gif" - else "png" in - Endpoints.cdn_avatar user.id avatar ext - | None -> default_avatar user \ No newline at end of file diff --git a/lib/models/user.mli b/lib/models/user.mli deleted file mode 100644 index 2cc6184..0000000 --- a/lib/models/user.mli +++ /dev/null @@ -1,8 +0,0 @@ -include module type of User_t - -val tag : t -> string -val mention : t -> string -val default_avatar : t -> string -val face : t -> string -(* val private_channel : t -> Channel_t.t *) -(* val send : t -> Yojson.Safe.json Deferred.Or_error.t *) \ No newline at end of file diff --git a/lib/models/user/activity.ml b/lib/models/user/activity.ml new file mode 100644 index 0000000..8e6ff80 --- /dev/null +++ b/lib/models/user/activity.ml @@ -0,0 +1,7 @@ +open Core + +type t = { + name: string; + kind: int [@key "type"]; + url: string [@default ""]; +} [@@deriving sexp, yojson { strict = false}] \ No newline at end of file diff --git a/lib/models/user/activity.mli b/lib/models/user/activity.mli new file mode 100644 index 0000000..53173b7 --- /dev/null +++ b/lib/models/user/activity.mli @@ -0,0 +1,5 @@ +type t = { + name: string; + kind: int; + url: string; +} [@@deriving sexp, yojson] \ No newline at end of file diff --git a/lib/models/user/presence.ml b/lib/models/user/presence.ml new file mode 100644 index 0000000..ab245a7 --- /dev/null +++ b/lib/models/user/presence.ml @@ -0,0 +1,10 @@ +open Core + +type t = { + user: User_t.partial_user; + roles: Snowflake.t list; + game: Activity.t option [@default None]; + guild_id: Snowflake.t; + status: string; + activities: Activity.t list; +} [@@deriving sexp, yojson { strict = false}] \ No newline at end of file diff --git a/lib/models/user/user.ml b/lib/models/user/user.ml new file mode 100644 index 0000000..bd6583c --- /dev/null +++ b/lib/models/user/user.ml @@ -0,0 +1,20 @@ +open Core +include User_t + +let tag user = + Printf.sprintf "%s#%s" user.username user.discriminator + +let mention user = + Printf.sprintf "<@%d>" user.id + +let default_avatar user = + let avatar = Int.of_string user.discriminator % 5 in + Endpoints.cdn_default_avatar avatar + +let face user = match user.avatar with + | Some avatar -> + let ext = if String.is_substring ~substring:"a_" avatar + then "gif" + else "png" in + Endpoints.cdn_avatar user.id avatar ext + | None -> default_avatar user \ No newline at end of file diff --git a/lib/models/user/user.mli b/lib/models/user/user.mli new file mode 100644 index 0000000..2cc6184 --- /dev/null +++ b/lib/models/user/user.mli @@ -0,0 +1,8 @@ +include module type of User_t + +val tag : t -> string +val mention : t -> string +val default_avatar : t -> string +val face : t -> string +(* val private_channel : t -> Channel_t.t *) +(* val send : t -> Yojson.Safe.json Deferred.Or_error.t *) \ No newline at end of file diff --git a/lib/models/user/user_t.ml b/lib/models/user/user_t.ml new file mode 100644 index 0000000..52dbaf4 --- /dev/null +++ b/lib/models/user/user_t.ml @@ -0,0 +1,13 @@ +open Core + +type partial_user = { + id: Snowflake.t; +} [@@deriving sexp, yojson { strict = false}] + +type t = { + id: Snowflake.t; + username: string; + discriminator: string; + avatar: string option [@default None]; + bot: bool [@default false]; +} [@@deriving sexp, yojson { strict = false }] \ No newline at end of file diff --git a/lib/models/user_t.ml b/lib/models/user_t.ml deleted file mode 100644 index 52dbaf4..0000000 --- a/lib/models/user_t.ml +++ /dev/null @@ -1,13 +0,0 @@ -open Core - -type partial_user = { - id: Snowflake.t; -} [@@deriving sexp, yojson { strict = false}] - -type t = { - id: Snowflake.t; - username: string; - discriminator: string; - avatar: string option [@default None]; - bot: bool [@default false]; -} [@@deriving sexp, yojson { strict = false }] \ No newline at end of file -- cgit v1.2.3