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
169
170
171
172
173
174
|
module Channel(T : S.Has_snowflake) : S.ChannelImpl with type t := T.t = struct
open Async
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);
]) >>| Result.map ~f:Message_t.of_yojson_exn
let say content ch =
send_message ~content ch
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)
end
module Guild(T : S.Has_snowflake) : S.GuildImpl with type t := T.t = struct
open Core
open Async
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);
]) >>| Result.map ~f:ignore
let create_emoji ~name ~image guild =
Http.create_emoji (get_id guild) (`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 (get_id guild) (`Assoc payload)
>>| Result.map ~f:(fun r -> Role_t.role_of_yojson_exn r |> Role_t.wrap ~guild_id:(get_id guild))
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);
]) >>| Result.map ~f:Channel_t.of_yojson_exn
let delete guild =
Http.delete_guild (get_id guild) >>| Result.map ~f:ignore
let get_ban ~id guild =
Http.get_ban (get_id guild) id >>| Result.map ~f:Ban_t.of_yojson_exn
let get_bans guild =
Http.get_bans (get_id guild) >>| Result.map ~f:(fun bans ->
Yojson.Safe.Util.to_list bans
|> List.map ~f:Ban_t.of_yojson_exn)
let get_emoji ~id guild =
Http.get_emoji (get_id guild) id >>| Result.map ~f:Emoji.of_yojson_exn
(* 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 >>| Result.map ~f:(fun prune ->
Yojson.Safe.Util.(member "pruned" prune |> to_int))
(* 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 >>| Result.map ~f:ignore
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 >>| Result.map ~f:(fun prune ->
Yojson.Safe.Util.(member "pruned" prune |> to_int))
let request_members guild =
Http.get_members (get_id guild) >>| 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 (get_id guild) (`Assoc [
("afk_channel_id", `Int id);
]) >>| Result.map ~f:of_yojson_exn
let set_afk_timeout ~timeout guild = Http.edit_guild (get_id guild) (`Assoc [
("afk_timeout", `Int timeout);
]) >>| Result.map ~f:of_yojson_exn
let set_name ~name guild = Http.edit_guild (get_id guild) (`Assoc [
("name", `String name);
]) >>| Result.map ~f:of_yojson_exn
let set_icon ~icon guild = Http.edit_guild (get_id guild) (`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 (get_id guild) id payload >>| Result.map ~f:ignore
end
|