lambda arg list macrology pasted by andyjpb on Tue Oct 30 13:00:38 2012
(define-syntax define-method (ir-macro-transformer (lambda (expr inject compare) (assert (pair? expr)) (let* ((proc (car expr)) (defn (cdr expr)) (_ (assert (list? defn))) (_ (assert (= 4 (length defn)))) (sig (first defn)) (name (car sig)) (args (cdr sig)) (uri/req (second defn)) (writer (third defn)) ; is a procedure of one argument (body). returns the thing to be passed to call-with-input-request : a string, an alist or a procedure (reader (fourth defn)) ) (list 'quote `(define ,name (let* ((writer ,writer) ; ensure this is eval'd only once (uri/req ,uri/req) ; ensure this is eval'd only once (uri (cond ((request? uri/req) (request-uri uri/req)) ((uri? uri/req) uri/req) (else (uri-reference uri/req)))) (method (cond ((request? uri/req) (request-method uri/req)) (writer 'POST) (else 'GET))) (args (if writer '(body #!key ,@args) '(#!key ,@args))) ) (lambda args (let ((writer (if (writer) (writer body) #f)) (req (make-request uri: uri method: method)) ; poke the args into query string. ) (call-with-input-request req writer ,reader)))) ) ) )))) ----- #;46> (pp (define-method (account/info locale) (make-request method: 'POST uri: "https://api.dropbox.com/1/account/info") #f read-json) (define account/info (let* ((writer #f) (uri/req (make-request method: 'POST uri: "https://api.dropbox.com/1/account/info")) (uri (cond ((intarweb#request? uri/req) (intarweb#request-uri uri/req)) ((uri-common#uri? uri/req) uri/req) (else (uri-common#uri-reference uri/req)))) (method (cond ((intarweb#request? uri/req) (intarweb#request-method uri/req)) (writer 'POST) (else 'GET))) (args (if writer '(body #!key locale) '(#!key locale)))) (lambda args (let ((writer (if (writer) (writer body) #f)) (req (intarweb#make-request uri: uri method: method))) (call-with-input-request req writer read-json)))))
Something like this should be closer to what you mean added by DerGuteMoritz on Tue Oct 30 13:49:10 2012
(define-syntax define-method
(ir-macro-transformer
(lambda (expr inject compare)
(assert (pair? expr))
(let* ((proc (car expr))
(defn (cdr expr))
(_ (assert (list? defn)))
(_ (assert (= 4 (length defn))))
(sig (first defn))
(name (car sig))
(uri/req (second defn))
(writer (third defn))
(args (if writer
`(body #!key . ,(cdr sig))
`(#!key . ,(cdr sig))))
(reader (fourth defn)))
(list 'quote
`(define ,name
(let* ((writer ,writer) ; ensure this is eval'd only once
(uri/req ,uri/req) ; ensure this is eval'd only once
(uri (cond ((request? uri/req) (request-uri uri/req))
((uri? uri/req) uri/req)
(else (uri-reference uri/req))))
(method (cond ((request? uri/req) (request-method uri/req))
(writer 'POST)
(else 'GET))))
(lambda ,args
(let ((writer (if (writer) (writer body) #f))
(req (make-request uri: uri method: method)) ; poke the args into query string.
)
(call-with-input-request req writer ,reader))))))))))