aboutsummaryrefslogtreecommitdiff
path: root/lib/impl.ml
diff options
context:
space:
mode:
authorAdelyn Breedlove <[email protected]>2019-01-28 10:31:51 -0700
committerAdelyn Breedlove <[email protected]>2019-01-28 10:31:51 -0700
commit8662e92987c437f59d09896a247ec2b5d82c4528 (patch)
treef004cc14598351d4ad6b19d8e993d2f629c5e738 /lib/impl.ml
parentAdd more docs (diff)
downloaddisml-8662e92987c437f59d09896a247ec2b5d82c4528.tar.xz
disml-8662e92987c437f59d09896a247ec2b5d82c4528.zip
Publish docs updates
Diffstat (limited to 'lib/impl.ml')
-rw-r--r--lib/impl.ml326
1 files changed, 163 insertions, 163 deletions
diff --git a/lib/impl.ml b/lib/impl.ml
index cc0f050..5fd7680 100644
--- a/lib/impl.ml
+++ b/lib/impl.ml
@@ -1,164 +1,164 @@
-module Channel(T : S.HasSnowflake) : S.ChannelImpl with type t := T.t = struct
- open Core
- include T
-
- 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)
-end
-
-module Guild(T : S.HasSnowflake) : S.GuildImpl with type t := T.t = struct
- include T
-
- let ban_user ~id ?(reason="") ?(days=0) guild =
- Http.guild_ban_add (get_id guild) id (`Assoc [
- ("delete-message-days", `Int days);
- ("reason", `String reason);
- ])
-
- let create_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
-end
-
-module User(T : S.HasSnowflake) : S.UserImpl with type t := T.t = struct
- include T
+module Channel(T : S.HasSnowflake) : S.ChannelImpl with type t := T.t = struct
+ open Core
+ include T
+
+ 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)
+end
+
+module Guild(T : S.HasSnowflake) : S.GuildImpl with type t := T.t = struct
+ include T
+
+ let ban_user ~id ?(reason="") ?(days=0) guild =
+ Http.guild_ban_add (get_id guild) id (`Assoc [
+ ("delete-message-days", `Int days);
+ ("reason", `String reason);
+ ])
+
+ let create_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
+end
+
+module User(T : S.HasSnowflake) : S.UserImpl with type t := T.t = struct
+ include T
end \ No newline at end of file
generated by cgit v1.2.3 (git 2.25.1) at 2026-04-25 15:19:35 +0000