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
|
open Async
open Core
open Disml
open Models
(* Client object will be stored here after creation. *)
let client = Ivar.create ()
(* Define a function to handle message_create *)
let check_command (message:Message.t) =
(* Simple example of command parsing. *)
let cmd, rest = match String.split ~on:' ' message.content with
| hd::tl -> hd, tl
| [] -> "", []
in match cmd with
| "!ping" -> (* Example ping command with REST round trip time edited into the response. *)
Message.reply message "Pong!" >>> begin function
| Ok message ->
let diff = Time.diff (Time.now ()) (Time.of_string message.timestamp) in
Message.set_content message (Printf.sprintf "Pong! `%d ms`" (Time.Span.to_ms diff |> Float.abs |> Float.to_int)) >>> ignore
| Error e -> Error.raise e
end
| "!spam" -> (* Send a list of consecutive integers of N size with 1 message per list item. *)
let count = Option.((List.hd rest >>| Int.of_string) |> value ~default:0) in
List.range 0 count
|> List.iter ~f:(fun i -> Message.reply message (string_of_int i) >>> ignore)
| "!list" -> (* Send a list of consecutive integers of N size in a single message. *)
let count = Option.((List.hd rest >>| Int.of_string) |> value ~default:0) in
let list = List.range 0 count
|> List.sexp_of_t Int.sexp_of_t
|> Sexp.to_string_hum in
Message.reply message list >>> begin function
| Ok msg -> print_endline msg.content
| Error err -> print_endline (Error.to_string_hum err)
end
| "!fold" -> (* Sum a consecutive list of integers of N size and send the result. *)
let count = Option.((List.hd rest >>| Int.of_string) |> value ~default:0) in
let list = List.range 0 count
|> List.fold ~init:0 ~f:(+)
|> Int.to_string in
Message.reply message list >>> ignore
| "!embed" -> (* Example of setting pretty much everything in an embed using the Embed module builders *)
let image_url = "https://cdn.discordapp.com/avatars/345316276098433025/17ccdc992814cc6e21a9e7d743a30e37.png" in
let embed = Embed.(default
|> title "Foo"
|> description "Bar"
|> url "https://gitlab.com/Mishio595/disml"
|> timestamp Time.(now () |> to_string_iso8601_basic ~zone:Time.Zone.utc)
|> colour 0xff
|> footer (fun f -> footer_text "boop" f)
|> image image_url
|> thumbnail image_url
|> author (fun a -> a
|> author_name "Adelyn"
|> author_icon image_url
|> author_url "https://gitlab.com/Mishio595/disml")
|> field ("field 3", "test", true)
|> field ("field 2", "test", true)
|> field ("field 1", "test", true)
) in
Message.reply_with ~embed message >>> ignore
| "!status" -> (* Set the status of all shards to a given string. *)
let status = List.fold ~init:"" ~f:(fun a v -> a ^ " " ^ v) rest in
Ivar.read client >>> fun client ->
Client.set_status ~status:(`String status) client
>>> fun _ ->
Message.reply message "Updated status" >>> ignore
| "!test" -> (* Basic send message to channel ID, can use any ID as `Channel_id some_snowflake *)
Channel_id.say "Testing..." message.channel_id >>> ignore
| "!echo" -> (* Fetches a message by ID in the current channel, defaulting to the sent message, and prints in s-expr form. *)
let `Message_id id = message.id in
let id = Option.((List.hd rest >>| Int.of_string) |> value ~default:id) in
Channel_id.get_message ~id message.channel_id >>> begin function
| Ok msg ->
let str = Message.sexp_of_t msg |> Sexp.to_string_hum in
print_endline str;
Message.reply message (Printf.sprintf "```lisp\n%s```" str) >>> ignore
| _ -> ()
end
| "!cache" -> (* Output cache counts as a a basic embed. *)
let module C = Cache.ChannelMap in
let module G = Cache.GuildMap in
let module U = Cache.UserMap in
let cache = Mvar.peek_exn Cache.cache in
let gc = G.length cache.guilds in
let tc = C.length cache.text_channels in
let vc = C.length cache.voice_channels in
let cs = C.length cache.categories in
let gr = C.length cache.groups in
let pr = C.length cache.private_channels in
let uc = U.length cache.users in
let pre = U.length cache.presences in
let user = Option.(value ~default:"None" (cache.user >>| User.tag)) in
let embed = Embed.(default
|> description (Printf.sprintf "Guilds: %d\nText Channels: %d\nVoice Channels: %d\nCategories: %d\nGroups: %d\nPrivate Channels: %d\nUsers: %d\nPresences: %d\nCurrent User: %s" gc tc vc cs gr pr uc pre user)) in
Message.reply_with ~embed message >>> ignore
| "!shutdown" -> (* Issue a shutdown to all shards. It is expected that they will restart if `?restart` is not false. *)
Ivar.read client >>> fun client ->
Sharder.shutdown_all client.sharder >>> ignore
| "!rgm" -> (* Request guild members to be sent over the gateway for the guild the command is run in. This will cause multiple GUILD_MEMBERS_CHUNK events. *)
Ivar.read client >>> fun client ->
(match message.guild_id with
| Some guild -> Client.request_guild_members ~guild client >>> ignore
| None -> ())
| "!rep" ->
let input = Option.(List.hd rest |> value ~default:"a") in
let list = List.(range 0 2000 >>| (fun _ -> input) |> fold ~init:"" ~f:(^)) in
Message.reply message list >>= begin function
| Ok m ->
String.length m.content
|> Int.to_string
|> (^) "Bytes: "
|> Message.reply m
| Error e -> Message.reply message (Error.to_string_hum e)
end >>> ignore
| "!new" -> (* Creates a guild named testing *)
Guild.create [ "name", `String "testing" ] >>= begin function
| Ok _ -> Message.reply message "Guild created"
| Error e -> Message.reply message (Printf.sprintf "Failed to create guild. Error: %s" (Error.to_string_hum e))
end >>> ignore
| "!delall" -> (* Deletes all guilds named testing *)
let cache = Mvar.peek_exn Cache.cache in
let guilds = Cache.GuildMap.filter cache.guilds ~f:(fun g -> g.name = "testing") in
let _ = Cache.GuildMap.map guilds ~f:Guild.delete in ()
| _ -> () (* Fallback case, no matched command. *)
(* Example logs setup *)
let setup_logger () =
Logs.set_reporter (Logs_fmt.reporter ());
Logs.set_level ~all:true (Some Logs.Debug)
let main () =
setup_logger ();
(* Register some event handlers *)
Client.message_create := check_command;
Client.ready := (fun ready -> Logs.info (fun m -> m "Logged in as %s" (User.tag ready.user)));
Client.guild_create := (fun guild -> Logs.info (fun m -> m "Joined guild %s" guild.name));
Client.guild_delete := (fun {id;_} -> let `Guild_id id = id in Logs.info (fun m -> m "Left guild %d" id));
(* Pull token from env var. It is not recommended to hardcode your token. *)
let token = match Sys.getenv "DISCORD_TOKEN" with
| Some t -> t
| None -> failwith "No token in env"
in
(* Start client. *)
Client.start ~large:250 ~compress:true token
(* Fill that ivar once its done *)
>>> Ivar.fill client
(* Lastly, we have to register this to the Async Scheduler for anything to work *)
let _ =
Scheduler.go_main ~main ()
|