-
Notifications
You must be signed in to change notification settings - Fork 14
/
bot.clj
424 lines (370 loc) · 18.1 KB
/
bot.clj
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
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
(ns discord.bot
(:require [clojure.string :refer [starts-with? ends-with?] :as s]
[clojure.java.io :as io]
[clojure.core.async :refer [go >!] :as async]
[taoensso.timbre :as timbre]
[discord.client :as client]
[discord.config :as config]
[discord.embeds :as embeds]
[discord.http :as http]
[discord.permissions :as perm]
[discord.utils :as utils]
[discord.types :as types]))
;;; Defining what an Extension and a Bot is
(defrecord Extension [command handler options])
(defrecord DiscordBot [bot-name extensions prefix client]
java.io.Closeable
(close [this]
(.close (:client this))))
;;; Helper functions
(defn- trim-message-command
"Trims the prefix and command from the helper function."
[message command]
(assoc message :content (-> message :content (s/replace-first command "") s/triml)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Custom Discord message handlers
;;;
;;; This allows the creation of more advanced plugins that directly intercept messages that in a
;;; way that allows for more customized handling than what is available through extensions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defonce message-handlers (atom []))
(defn add-handler! [handler]
(swap! message-handlers conj handler))
(defn get-handlers [] @message-handlers)
(defmacro defhandler
"This is used to create custom message handlers, for which all messages received by the bot will
be passed through. This is used f or the creation of advanced bot functionality such as automatic
moderation, alias creation, etc."
[handler-name [prefix-param client-param message-param] & body]
(let [handler-fn-name (gensym (name handler-name))]
`(do
(timbre/infof "Register custom message handler: %s" ~(name handler-name))
(defn ~handler-fn-name [~prefix-param ~client-param ~message-param] ~@body)
(add-handler! ~handler-fn-name))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Patch functions exposed to bot developers:
;;;
;;; Patch functions that get exposed dynamically to clients within bot handler functions. These
;;; functions are nil unless invoked within the context of a function called from within a
;;; build-handler-fn.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn ^:dynamic say [message])
(defn ^:dynamic pm [message])
(defn ^:dynamic delete [message])
;;; These functions locally patch the above functions based on context supplied by the handler
(defn- say*
[send-channel channel message]
(if (embeds/embed? message)
(go (>! send-channel {:channel channel :content "" :embed message}))
(go (>! send-channel {:channel channel :content message}))))
(defn- pm* [auth send-channel user message]
;; Open up a DM channel with the recipient and then send them the message
(let [dm-channel (http/create-dm-channel auth user)]
(if (embeds/embed? message)
(go (>! send-channel {:channel dm-channel :content "" :embed message}))
(go (>! send-channel {:channel dm-channel :content message})))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; General bot definition and extension/extension dispatch building
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- dispatch-to-handlers
"Dispatches to the currently registered user message handlers."
[prefix client message]
(let [handlers (get-handlers)]
(doseq [handler handlers]
(handler prefix client message))))
(defn- dispatch-to-extensions
"Dispatches to the supplied extensions."
[client message prefix extensions]
(doseq [{:keys [command handler] :as ext} extensions]
(let [command-string (str prefix (name command))]
(if (starts-with? (:content message) command-string)
(handler client (trim-message-command message command-string))))))
(defn- build-handler-fn
"Builds a handler around a set of extensions and rebinds 'say' to send to the message source"
[prefix extensions]
;; Builds a handler function for a bot that will dispatch messages matching the supplied prefix
;; to the handlers of any extensions whose "command" is present immediately after the prefix
(fn [client message]
;; First we'll partially apply our helper functions based on the incoming client and message.
(binding [say (partial say* (:send-channel client) (:channel message))
delete (partial http/delete-message client (:channel message))
pm (partial pm* client (:send-channel client) (get-in message [:author :id]))]
;; If the message starts with the bot prefix, we'll dispatch to any extension extensions that
;; have been installed
(if (-> message :content (starts-with? prefix))
(go
(dispatch-to-extensions client message prefix extensions)))
;; For every message, we'll dispatch to the handlers. This allows for more sophisticated
;; handling of messages that don't necessarily match the prefix (i.e. matching & deleting
;; messages with swear words).
(go
(dispatch-to-handlers prefix client message)))))
;;; General bot creation
(defn create-bot
"Creates a bot that will dynamically dispatch to different extensions based on <prefix><command>
style messages."
([bot-name extensions]
(create-bot bot-name extensions (config/get-prefix) (types/configuration-auth)))
([bot-name extensions prefix]
(create-bot bot-name extensions prefix (types/configuration-auth)))
([bot-name extensions prefix auth]
(let [handler (build-handler-fn prefix extensions)
discord-client (client/create-discord-client auth handler)]
(timbre/infof "Creating bot with prefix: %s" prefix)
(DiscordBot. bot-name extensions prefix discord-client))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Defining a bot and its extensions inline
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn build-inline-extensions
([key-func-pairs]
(into [] (map (partial apply build-inline-extensions)
(partition 2 key-func-pairs))))
([fn-key fn-body]
`(map->Extension {:command ~fn-key
:handler ~fn-body}))
([fn-key fn-body command-options]
`(map->Extension {:command ~fn-key
:handler ~fn-body
:options ~command-options})))
(defmacro with-extensions
"Given a name, prefix and series of :keyword-function pairs, builds a new bot inside of a
with-open block that will sleep the while background threads manage the bot."
[bot-name prefix & key-func-pairs]
`(with-open [bot# (create-bot ~bot-name ~(build-inline-extensions key-func-pairs) ~prefix)]
(while true (Thread/sleep 3000))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Defining global extensions and commands that get loaded dynamically on bot startup
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defonce extension-registry (atom (list)))
(defonce extension-docs (atom {}))
(defn register-extension!
"Creates a mapping between the supplied extension name and the handler function in the global
extension registry."
;; extension without options
([extension-name extension-function]
(let [extension-map {:command extension-name
:handler extension-function
:options nil}]
(swap! extension-registry conj extension-map)))
;; extension with options
([extension-name extension-function extension-options]
(let [extension-map {:command extension-name
:handler extension-function
:options extension-options}]
(swap! extension-registry conj extension-map))))
(defn register-extension-docs!
"Add the documentation for this particular extension to the global extension documentation
registry."
[extension-name documentation]
(if (seq documentation)
(swap! extension-docs assoc extension-name documentation)))
(defn- emit-subcommand-error
"This function adds a catch-all error handling function for the extension to handle invalid
subcommand input."
[extension-name]
`(defmethod ~extension-name :default [_# message#]
(say (format "Unrecognized subcommand: %s"
~(name extension-name)
(-> message# :content utils/words first)))))
(defn- emit-subcommand
"For each of the defined subcommands, we need to define a multimethod that handles that
particular subcommand. We also want to add the documentation for that subcommand to the
documentation for the overall command."
[extension-name client-param message-param dispatch-val & body]
(let [body body
;; Check for documentation at the top of the subcommand
command-doc (if (string? (first body))
(format "\t%s: %s\n" (name dispatch-val) (first body))
(format "\t%s\n" (name dispatch-val)))
body (if (string? (first body))
(rest body)
body)
;; Check for options at the top of the subcommand
options (if (map? (first body))
(first body)
{})
body (if (map? (first body))
(rest body)
body)
;; Extract the permissions option
permissions (get options :requires)]
`(do
;; Add documentation for this command to the multimethod documentation
(alter-meta!
(var ~extension-name)
(fn [current-val#]
(let [current-doc# (:doc current-val#)]
(assoc current-val# :doc (str current-doc# ~command-doc)))))
;; Define the method for this particular dispatch value
(defmethod ~extension-name ~dispatch-val [~client-param ~message-param]
;; If docstring is provided to the command, we need to skip the first argument in
;; the implementation
~(if permissions
`(if (perm/has-permissions? ~client-param ~message-param ~permissions)
(do ~@body)
(say "You do not have permission to run that command!"))
`(do ~@body))))))
(defmacro defextension
"Defines a multi-method with the supplied name with a 2-arity dispatch function which dispatches
based upon the first word in the message. It also defines a :default which responds back with an
error.
Example:
(defextension test-extension [client message]
\"Optional global extension documentation\"
(:say
\"Optional command documentation\"
(say message))
(:greet
(say \"Hello Everyone!\"))
(:kick
(doseq [user (:user-mentions message)]
(let [guild-id (get-in message [:channel :guild-id] message)]
(http/kick client guild-id user)))))
Arguments:
extension-name :: String -- The name of the extension, and subsequent multi-method being defined.
arg-vector :: Vector -- A 2-element vector defining the argument vector for the extension. The
first argument is the client being passed to the message
docstring? :: String -- Optional documentation that can be supplied for this extension.
impls :: Forms -- A sequence of lists, each representing a command implementation. The
first argument to each implementation is a keyword representing the command being implemented.
Optionally, the first argument in the implementation can be documentation for this particular
command."
{:arglists '([extension-name [client-param message-param] docstring? & impls])}
[extension-name [client-param message-param :as arg-vector] & impls]
;; Verify that the argument vector supplied to defextension is a list of 2
{:pre [(or (= 2 (count arg-vector))
(throw (ex-info "Extension definition arg vector needs 2 args (client & message)."
{:len (count arg-vector) :curr arg-vector})))]}
;; Parse out some of the possible optional arguments
(let [docstring? (if (string? (first impls))
(first impls)
"")
m (if (string? (first impls))
{:doc (first impls)}
{})
impls (if (string? (first impls))
(rest impls)
impls)
options (if (map? (first impls))
(first impls)
{})
impls (if (map? (first impls))
(rest impls)
impls)
;; The last thing that we want to do is gensym on the extension name. This will prevent the
;; defined extensions from overshadowing existing functions and causing problems down the
;; line.
extension-fn-name (gensym extension-name)]
`(do
;; Define the multimethod
(defmulti ~(with-meta extension-fn-name m)
(fn [client# message#]
(-> message# :content utils/words first keyword)))
;; Register the extension with the global extension hierarchy
(register-extension! ~(keyword extension-name) ~extension-fn-name ~options)
;; Supply a "default" error message responding back with an unknown command message
~(emit-subcommand-error extension-fn-name)
;; Add the docstring and the arglist to this command
(alter-meta! (var ~extension-fn-name) assoc
:doc (str ~docstring? "\n\nAvailable Subcommands:\n")
:arglists (quote ([~client-param ~message-param])))
;; Build the method implementations
~@(for [[dispatch-val & body] impls]
(apply emit-subcommand extension-fn-name client-param message-param dispatch-val body))
;; Register the documentation for the extension
(register-extension-docs!
~(keyword extension-name)
(-> (var ~extension-fn-name) meta :doc)))))
(defmacro defcommand
"Defines a one-off command and adds that to the global extension registry. This is a single
function that will respond to commands and is not a part of a larger command infrastructure.
Example:
(defcommand botsay [client message]
\t(say (:content message))
\t(delete message))
The above code expands into the following:
(do
\t(defn botsay [client message]
\t\t(say (:content message))
\t\t(delete message))
\t(register-extension! :botsay botsay))
"
{:arglists '([command [client-param message-param] docstring? options? & command-body])}
[command [client-param message-param :as arg-vector] & command-body]
;; Try and parse out some of the options that can be supplied to the command
(let [m (if (string? (first command-body))
{:doc (first command-body)}
{})
command-body (if (string? (first command-body))
(rest command-body)
command-body)
options (if (map? (first command-body))
(first command-body)
{})
command-body (if (map? (first command-body))
(rest command-body)
command-body)
command-fn-name (gensym command)]
`(do
(defn ~(with-meta command-fn-name m) [~client-param ~message-param] ~@command-body)
(register-extension! ~(keyword command) ~command-fn-name ~options)
(if (:doc ~m)
(register-extension-docs! ~(keyword command) ~(:doc m))))))
;;; Loading extensions from other files
(defn get-clojure-files
"Given a directory, returns all '.clj' files in that folder."
[folder]
(->> folder
(io/file)
(file-seq)
(filter (fn [f] (ends-with? f ".clj")))
(map (fn [f] (.getAbsolutePath f)))))
(defn load-clojure-files-in-folder!
"Given a directory, loads all of the .clj files in that directory tree. This can be used to
dynamically load extensions defined with defextension or manually calling register-extension!
out of a folder."
[folder]
(let [clojure-files (get-clojure-files folder)]
(doseq [filename clojure-files]
(timbre/infof "Loading extensions from: %s" filename)
(load-file filename))))
(defn create-extension
[command handler]
(map->Extension {:command (name command)
:handler handler}))
(defn build-extensions [key-func-pairs]
(into [] (map (partial apply create-extension) key-func-pairs)))
(defn get-registered-extensions
"Returns the current extension-registry as a list of Extensions."
[]
(map map->Extension @extension-registry))
(defmacro from-files
"Creates a bot where the extensions are those present in all Clojure files present in the
directories supplied. This allows you to dynamically add files to a extensions/ directory and
have them get automatically loaded by the bot when it starts up."
[bot-name prefix folders]
`(do
;; Loads all the clojure files in the folders supplied
(doseq [folder# ~folders]
(load-clojure-files-in-folder! folder#))
;; Opens a bot with those extensions
(let [extensions# (get-registered-extensions)]
(timbre/infof "Loaded %d extensions: %s."
(count extensions#)
(s/join ", " (map :command extensions#)))
(with-open [discord-bot# (create-bot ~bot-name extensions# ~prefix)]
(while true (Thread/sleep 3000))))))
;;; Builtin bot commands
(defonce doc-separator (s/join (repeat 100 "-")))
(defn- generate-doc-embed []
(loop [docs @extension-docs
embed (embeds/create-embed :title "Available commands:")]
(if-let [[command doc] (first docs)]
(recur (rest docs)
(embeds/+field embed command doc))
embed)))
(defcommand help
[_ _]
"Look at help information for the available extensions."
(let [doc-embed (generate-doc-embed)]
(pm doc-embed)))