#lang scheme
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
;; A server request interface
;; We only want to ever call commands in the registered requests,
;; and generally need to be a tad careful in these parts - never
;; executing data from external sources directly...

(provide (all-defined-out))

;; an argument is just a token/value pair
(define (arg token value) (cons token value))
(define (arg-token arg) (car arg))
(define (arg-value arg) (cdr arg))

;; a request is a name and a list of arguments
(define (req name args) (list name args))
(define (req-name r) (list-ref r 0))
(define (req-args r) (list-ref r 1))  

;; get the argument by name from the request
(define (req-arg r n)
  (let ((kv (assq n (req-args r))))
    (cond
     (kv (cdr kv))
     (else
      (printf "unknown arg ~a on request ~a~n" n (req-name r))))))

;; check for the existance of an argument
(define (req-has-arg? r n)
  (foldl
   (lambda (arg r)
     (if (eq? (arg-token arg) n) #t r))
   #f
   (req-args r)))

;; a register is a request and the procedure to call
(define (register req proc) (list req proc))
(define (register-req r) (list-ref r 0))
(define (register-proc r) (list-ref r 1))

; builds the argument list from the resistered requests
(define (request-run reg req)
  (apply (register-proc reg)
         (map
          (lambda (arg)
            (if (req-has-arg? req (arg-token arg))
                (req-arg req (arg-token arg)) ; use the passed in value
                (arg-value arg))) ; use the default
          (req-args (register-req reg)))))

;; look up this request in the registry and run it
(define (request-dispatch reg req)
  (cond
   ((null? reg) (printf "unknown command ~a~n" (req-name req))
    (string-append "unknown command "
                   (symbol->string (req-name req))))
   ((eq? (req-name (register-req (car reg))) (req-name req))
    (request-run (car reg) req))
   (else
    (request-dispatch (cdr reg) req))))