#lang racket/base
(require (for-syntax racket/base racket/list syntax/parse syntax/parse/lib/function-header)
         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]
                     #:min-interval [interv 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)
    (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)))
         (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
    [(_ fn:function-header
        kw:single-keyword ...
        action ...)
     (with-syntax ([(kw ...)
                    (append* (map syntax->list (syntax->list #'(kw ...))))])
       #'(command-add 'fn kw ... (lambda fn.args action ...)))]))

(define-command (list)
  #: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"
  (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)")))

(define-command (ignore-add nick)
  #:power 2
  (hash-set! (network-storage "ignore") nick #t)
  (persist-network "ignore"))

(define-command (ignore-del nick)
  #:power 2
  (hash-remove! (network-storage "ignore") nick)
  (persist-network "ignore"))

(define (ignored? nick)
  (hash-has-key? (network-storage "ignore") nick))