blob: 933f7e5e42f88c15c8b9bd414048bc31a6cacd59 (
plain)
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
|
#lang racket/base
(require (for-syntax racket/base racket/list syntax/parse syntax/parse/lib/function-header)
irc/bot irc/users racket/format racket/string)
(provide define-command)
(struct command-registration (signature help power action))
(define current-commands (make-parameter (make-hash)))
(define (command-add signature action
#:help [help #f]
#:power [power 0])
(hash-set! (current-commands)
(car signature) (command-registration signature help power action)))
(define (sufficient-power? nick wanted)
(or (= wanted 0)
(and (is-identified? nick)
(>= (user-power nick) wanted))))
(define (command-process)
(define s-exp (safe-read-string (string-join (cdr (params)))))
(when (pair? s-exp)
(define command (hash-ref (current-commands) (car s-exp) #f))
(define required-power (command-registration-power command))
(when command
(if (sufficient-power? (source) required-power)
(apply (command-registration-action command)
(cdr s-exp))
(reply (format "Insufficient power (~a required)" required-power))))))
(on (and (command-is 'PRIVMSG)
(not (source-is (current-nick))))
(command-process))
(define-syntax (define-command stx)
(define-splicing-syntax-class single-keyword
(pattern (~seq kwname:keyword kwval:expr)))
(syntax-parse stx
[(_ (name:id fn ...)
kw:single-keyword ...
action ...)
(with-syntax ([(kw ...)
(append* (map syntax->list (syntax->list #'(kw ...))))])
#'(command-add '(name fn ...) kw ... (lambda (fn ...) action ...)))]))
(define-command (list)
#:help "List all registered commands"
(reply (~s (hash-map (current-commands)
(λ (k v) (car (command-registration-signature v)))))))
(define-command (help [command #f])
#:help "Display command argument names and description"
(if command
(let ([c (hash-ref (current-commands) command #f)])
(if c
(let* ([cr (command-registration-signature c)]
[help (command-registration-help c)])
(if help (reply (format "~s - ~a" cr help))
(reply (~s cr))))
(reply "There is no such command")))
(reply "You need to supply a command name, e.g. (help list)")))
|