Welcome to the CHICKEN Scheme pasting service

(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)))))

(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))))))))))