diff options
| -rw-r--r-- | irc/command.rkt | 62 |
1 files changed, 62 insertions, 0 deletions
diff --git a/irc/command.rkt b/irc/command.rkt new file mode 100644 index 0000000..933f7e5 --- /dev/null +++ b/irc/command.rkt @@ -0,0 +1,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)"))) |