1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
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)
let bulk_delete msgs ch =
let msgs = `List (List.map ~f:(fun id -> `Int id) msgs) in
Http.bulk_delete (get_id ch) msgs
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
|