#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)")))