(module flickr mzscheme
(provide (all-defined)
(all-from "method.ss"))
(require-for-syntax "flickr-reflection.ss"
"method.ss"
(lib "list.ss")
(lib "match.ss"))
(define-syntax (bind-flickr stx)
(define all-method-names
(parameterize ((non-text-tags (list* 'methods (non-text-tags))))
(match (flickr.reflection.getMethods)
((('methods _ ('method _ method-name) ...)) method-name))))
(define (get-method-info method-name) (parameterize ((non-text-tags (list* 'method 'arguments 'errors (non-text-tags))))
(match (flickr.reflection.getMethodInfo #:method_name method-name)
((('method (('name name)
('needslogin needs-login)
('needssigning needs-signing)
('requiredperms _)) . method-specs)
('arguments () . argument-specs)
('errors () . error-specs))
(make-method-info
name
(flickr-true? needs-login)
(flickr-true? needs-signing)
#f #f
#f
#f
(map (match-lambda
(('argument (('name name) (optional opt)) . description)
(make-argument-info name (flickr-true? opt) description)))
argument-specs))))))
(define (make-method-provide/contract mi)
(let ((method-name (string->symbol (method-info-name mi))))
`(provide/contract
(,method-name (->* () (required-keywords ,@(map (lambda (ai) (string->keyword (argument-info-name)))
(filter (lambda (x) (not (argument-info-optional? x)))
(method-info-arguments mi)))) any)))))
(define (make-method-definition mi)
(let ((method-name (string->symbol (method-info-name mi))))
`(begin
(define ,method-name
(lambda/kw (#:key
,@(map
(lambda (ai) (string->symbol (argument-info-name ai)))
(method-info-arguments mi))
#:all-keys ak)
(apply ,(if (method-info-needs-signing? mi) 'invoke-method-signed 'invoke-method)
#:method ,(method-info-name mi)
#:api_key (or api_key (current-api-key))
ak))))))
(datum->syntax-object
stx
(list* 'begin
'(require (lib "kw.ss") "method.ss")
(map make-method-definition (map get-method-info all-method-names)))))
(bind-flickr))