Improve command error handling

1 files changed, 30 insertions, 17 deletions

diff --git a/irc/command.rkt b/irc/command.rkt
index 933f7e5..30f9830 100644
--- a/irc/command.rkt
+++ b/irc/command.rkt
@@ -1,14 +1,16 @@
 #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)
+         irc/core irc/bot irc/users irc/storage racket/format racket/string racket/exn)
+(provide define-command error-user)
 
 (struct command-registration (signature help power action))
 (define current-commands (make-parameter (make-hash)))
+(define current-command-name (make-parameter #f))
 
 (define (command-add signature action
                      #:help [help #f]
-                     #:power [power 0])
+                     #:power [power 0]
+                     #:min-interval [interv 0])
   (hash-set! (current-commands)
     (car signature) (command-registration signature help power action)))
 
@@ -20,34 +22,45 @@
 (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))))))
+    (parameterize ([current-command-name (car s-exp)])
+      (define command (hash-ref (current-commands) (current-command-name) #f))
+      (define required-power (command-registration-power command))
+      (when command
+        (if (sufficient-power? (source) required-power)
+          (begin
+            (log-irc-info "Executing ~a" (current-command-name))
+            (apply (command-registration-action command)
+                   (cdr s-exp)))
+          (error-user "Insufficient power (~a required)" required-power))))))
+
+(define (error-user . args)
+  (raise-user-error (current-command-name) (apply format args)))
 
 (on (and (command-is 'PRIVMSG)
-         (not (source-is (current-nick))))
-    (command-process))
+         (not (source-is (current-nick)))
+         (not (ignored? (source))))
+    (with-handlers
+      ([exn:fail:user? (λ (e) (privmsg (source) (exn->string e)))])
+      (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 ...)
+    [(_ fn:function-header
         kw:single-keyword ...
         action ...)
      (with-syntax ([(kw ...)
                     (append* (map syntax->list (syntax->list #'(kw ...))))])
-       #'(command-add '(name fn ...) kw ... (lambda (fn ...) action ...)))]))
+       #'(command-add 'fn kw ... (lambda fn.args action ...)))]))
 
 (define-command (list)
-  #:help "List all registered commands"
-  (reply (~s (hash-map (current-commands)
-                       (λ (k v) (car (command-registration-signature v)))))))
+  #:help "List all registered commands accessible to you"
+  (reply (~s
+    (for/list ([(k v) (current-commands)]
+               #:when (sufficient-power? (source) (command-registration-power v)))
+      (car (command-registration-signature v))))))
 
 (define-command (help [command #f])
   #:help "Display command argument names and description"