aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/dune39
-rw-r--r--lib/event.ml23
-rw-r--r--lib/member.atd12
-rw-r--r--lib/models/guild.ml4
-rw-r--r--lib/models/role.ml4
-rw-r--r--lib/role.atd2
6 files changed, 42 insertions, 42 deletions
diff --git a/lib/dune b/lib/dune
index 4ce6b27..667d021 100644
--- a/lib/dune
+++ b/lib/dune
@@ -116,30 +116,21 @@
(public_name disml)
(synopsis "An OCaml library for interfacing with the Discord API")
(modules
- activity activity_t activity_j
- attachment attachment_t attachment_j
- ban ban_t ban_j
- channel channel_t channel_j
- embed embed_t embed_j
- emoji emoji_t emoji_j
- guild guild_t guild_j
- member member_t member_j
- message message_t message_j
- presence presence_t presence_j
- reaction reaction_t reaction_j
- role role_t role_j
- snowflake snowflake_t snowflake_j
- user user_t user_j
- client
- dispatch
- endpoints
- event
- http
- models
- opcode
- rl
- s
- sharder
+ activity_t activity_j
+ attachment_t attachment_j
+ ban_t ban_j
+ channel_t channel_j
+ embed_t embed_j
+ emoji_t emoji_j
+ guild_t guild_j
+ member_t member_j
+ message_t message_j
+ presence_t presence_j
+ reaction_t reaction_j
+ role_t role_j
+ snowflake_t snowflake_j
+ user_t user_j
+ activity attachment ban channel embed emoji guild member message presence reaction role snowflake user client dispatch endpoints event http models opcode rl s sharder
)
(libraries core async_ssl cohttp-async yojson websocket-async zlib atdgen)
(preprocess (pps ppx_jane))
diff --git a/lib/event.ml b/lib/event.ml
index 988e017..6796ef5 100644
--- a/lib/event.ml
+++ b/lib/event.ml
@@ -39,16 +39,15 @@ type t =
exception Invalid_event of string
-let wrap_role_update Role_t.{ id; role; } =
+let wrap_role ~guild_id role =
let open Role_t in
- let guild_id = id in
let {id;name;colour;hoist;position;permissions;managed;mentionable} = role in
{id;name;colour;hoist;position;permissions;managed;mentionable;guild_id}
-let wrap_role_with_id ~guild_id role =
- let open Role_t in
- let {id;name;colour;hoist;position;permissions;managed;mentionable} = role in
- {id;name;colour;hoist;position;permissions;managed;mentionable;guild_id}
+let wrap_member ~guild_id member =
+ let open Member_t in
+ let {nick;roles;joined_at;deaf;mute;user} = member in
+ {nick;roles;joined_at;deaf;mute;user;guild_id}
let event_of_string ~contents t = match t with
| "HELLO" -> HELLO (Yojson.Safe.from_string contents)
@@ -66,13 +65,13 @@ let event_of_string ~contents t = match t with
| "GUILD_BAN_REMOVE" -> GUILD_BAN_REMOVE (Ban_j.t_of_string contents)
| "GUILD_EMOJIS_UPDATE" -> GUILD_EMOJIS_UPDATE (Yojson.Safe.from_string contents)
| "GUILD_INTEGRATIONS_UPDATE" -> GUILD_INTEGRATIONS_UPDATE (Yojson.Safe.from_string contents)
- | "GUILD_MEMBER_ADD" -> GUILD_MEMBER_ADD (Member_j.t_of_string contents)
- | "GUILD_MEMBER_REMOVE" -> GUILD_MEMBER_REMOVE (Member_j.t_of_string contents)
- | "GUILD_MEMBER_UPDATE" -> GUILD_MEMBER_UPDATE (Member_j.t_of_string contents)
+ | "GUILD_MEMBER_ADD" -> GUILD_MEMBER_ADD (let Member_t.{guild_id;member} = Member_j.member_update_of_string contents in wrap_member ~guild_id member)
+ | "GUILD_MEMBER_REMOVE" -> GUILD_MEMBER_REMOVE (let Member_t.{guild_id;member} = Member_j.member_update_of_string contents in wrap_member ~guild_id member)
+ | "GUILD_MEMBER_UPDATE" -> GUILD_MEMBER_UPDATE (let Member_t.{guild_id;member} = Member_j.member_update_of_string contents in wrap_member ~guild_id member)
| "GUILD_MEMBERS_CHUNK" -> GUILD_MEMBERS_CHUNK (Yojson.Safe.(from_string contents |> Util.to_list) |> List.map ~f:(fun m -> Yojson.Safe.to_string m |> Member_j.t_of_string))
- | "GUILD_ROLE_CREATE" -> GUILD_ROLE_CREATE (Role_j.role_update_of_string contents |> wrap_role_update)
- | "GUILD_ROLE_UPDATE" -> GUILD_ROLE_UPDATE (Role_j.role_update_of_string contents |> wrap_role_update)
- | "GUILD_ROLE_DELETE" -> GUILD_ROLE_DELETE (Role_j.role_update_of_string contents |> wrap_role_update)
+ | "GUILD_ROLE_CREATE" -> GUILD_ROLE_CREATE (let Role_t.{guild_id;role} = Role_j.role_update_of_string contents in wrap_role ~guild_id role)
+ | "GUILD_ROLE_UPDATE" -> GUILD_ROLE_UPDATE (let Role_t.{guild_id;role} = Role_j.role_update_of_string contents in wrap_role ~guild_id role)
+ | "GUILD_ROLE_DELETE" -> GUILD_ROLE_DELETE (let Role_t.{guild_id;role} = Role_j.role_update_of_string contents in wrap_role ~guild_id role)
| "MESSAGE_CREATE" -> MESSAGE_CREATE (Message_j.t_of_string contents)
| "MESSAGE_UPDATE" -> MESSAGE_UPDATE (Message_j.t_of_string contents)
| "MESSAGE_DELETE" -> MESSAGE_DELETE (Message_j.t_of_string contents)
diff --git a/lib/member.atd b/lib/member.atd
index 11d8b62..c87e40c 100644
--- a/lib/member.atd
+++ b/lib/member.atd
@@ -9,7 +9,17 @@ type partial_member = {
mute: bool;
}
-type t = {
+type member = {
inherit partial_member;
user: user;
+}
+
+type member_update = {
+ guild_id <json name="id">: snowflake;
+ member: member;
+}
+
+type t = {
+ inherit member;
+ guild_id: snowflake;
} \ No newline at end of file
diff --git a/lib/models/guild.ml b/lib/models/guild.ml
index 1e870f9..a10cd6c 100644
--- a/lib/models/guild.ml
+++ b/lib/models/guild.ml
@@ -35,7 +35,7 @@ module Make(Http : S.Http) = struct
in Http.guild_role_add guild.id (`Assoc payload)
>>| Result.map ~f:(fun r ->
Role_j.role_of_string r
- |> Event.wrap_role_with_id ~guild_id:guild.id)
+ |> Event.wrap_role ~guild_id:guild.id)
let create_channel ~mode ~name guild =
let kind = match mode with
@@ -87,7 +87,7 @@ module Make(Http : S.Http) = struct
(* TODO add HTTP fallback *)
let get_role ~id guild =
let role = List.find ~f:(fun r -> r.id = id) guild.roles in
- Option.(role >>| Event.wrap_role_with_id ~guild_id:guild.id)
+ Option.(role >>| Event.wrap_role ~guild_id:guild.id)
(* TODO add webhook abstraction? *)
let get_webhooks guild =
diff --git a/lib/models/role.ml b/lib/models/role.ml
index 5a3701c..aa931d6 100644
--- a/lib/models/role.ml
+++ b/lib/models/role.ml
@@ -3,12 +3,12 @@ module Make(Http : S.Http) = struct
type t = Role_t.t
- let edit_role ~body role = Http.guild_role_edit role.guild_id role.id body
+ 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 = Http.guild_role_remove role.guild_id role.id
+ 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
diff --git a/lib/role.atd b/lib/role.atd
index 5b4431e..d442a92 100644
--- a/lib/role.atd
+++ b/lib/role.atd
@@ -13,7 +13,7 @@ type role = {
type role_update = {
role: role;
- id <json name="guild_id">: snowflake;
+ guild_id: snowflake;
}
type t = {