#lang racket
(require json
"main.rkt"
)
(provide discovery-document->racket-code)
(define/contract (discovery-document->racket-code root)
(jsexpr? . -> . any)
(do-intro root)
(do-api-parameters root)
(do-resources root root))
(define (do-intro j)
(displayln #reader scribble/reader
@string-append{
#lang racket
(require net/url net/uri-codec json)
})
(pretty-print-code
`(define (read-api-key [file (build-path (find-system-path 'home-dir)
".google-api-key")])
(match (file->string file #:mode 'text)
[(regexp "^\\s*(.*?)\\s*(?:[\r\n]*)$" (list _ k)) k]
[else (error 'read-api-key "Bad format for ~a" file)])))
(pretty-print-code
`(define api-key (make-parameter (read-api-key))))
(pretty-print-code
`(provide api-key))
)
(define (do-api-parameters j)
(define (cat ss)
(apply string-append ss))
(displayln #reader scribble/reader
@string-append{
}))
(define (do-resources root j)
(for ([(k v) (in-hash j)]
#:when (eq? k 'resources))
(newline)
(for ([(rn rv) v])
(displayln (make-string 78 #\;))
(printf ";; Functions for the `~a' resource:\n" rn)
(for ([(k v) (in-hash rv)])
(match k
['methods (for ([(mn mv) (in-hash v)])
(do-method root mn mv))]
['resources (do-resources root v)] [else (cond [(string? v) (printf "~a: ~a\n" k v)]
[else (displayln k)])])))))
(define (do-method root mn mv)
(define name (string->symbol
(regexp-replace* #rx"\\." (hash-ref mv 'id) "-")))
(define api-param-names (hash-keys (hash-ref root 'parameters)))
(define params (hash-ref mv 'parameters (hash)))
(define (required? x)
(and (hash-has-key? x 'required)
(hash-ref x 'required)))
(define req-params (for/hasheq ([(k v) params]
#:when (required? v))
(values k v)))
(define opt-params (for/hasheq ([(k v) params]
#:when (not (required? v)))
(values k v)))
(define req-param-names (hash-keys req-params))
(define opt-param-names (hash-keys opt-params))
(define body-params
(hash-ref (hash-ref (hash-ref root 'schemas)
(string->symbol
(hash-ref (hash-ref mv 'request (hash)) '$ref ""))
(hash))
'properties
(hash)))
(define body-param-names (hash-keys body-params))
(define all-opt-param-names (append opt-param-names
body-param-names
api-param-names))
(newline)
(displayln "#|")
(displayln name)
(newline)
(displayln (hash-ref mv 'description ""))
(newline)
(displayln "Arguments:")
(for ([(k v) req-params])
(newline)
(printf "~a\n" k)
(for ([(k v) v])
(displayln (wrap (format "~a: ~a" k v)))))
(for ([(k v) opt-params])
(newline)
(printf "#:~a\n" k)
(for ([(k v) v])
(displayln (wrap (format "~a: ~a" k v)))))
(for ([(k v) body-params])
(newline)
(printf "#:~a\n" k)
(for ([(k v) v])
(displayln (wrap (format "~a: ~a" k v)))))
(displayln "|#")
(define qps (append req-param-names opt-param-names api-param-names))
(pretty-print-code
`(provide ,name))
(pretty-print-code
`(define (,name
,@req-param-names
,@(append* (map (lambda (x)
(list (string->keyword (symbol->string x))
(list x ''NONE)))
all-opt-param-names)))
(define base-uri ,(hash-ref root 'baseUrl))
(define res-path ,(hash-ref mv 'path))
(define _qpstr (alist->form-urlencoded
(filter-map
(lambda (k v)
(cond [(eq? v 'NONE) #f]
[else (cons (string->symbol k) v)]))
(list ,@(map symbol->string qps))
(list ,@qps))))
(define qpstr (cond [(equal? _qpstr "") ""]
[else (string-append "?" _qpstr)]))
(define url (string->url (string-append base-uri res-path qpstr)))
(define h (list "Content-Type: application/json"))
(define body (jsexpr->bytes
(for/hasheq ([k (list ,@(map symbol->string body-param-names))]
[v (list ,@body-param-names)]
#:when (not (eq? v 'NONE)))
(values (string->symbol k) v))))
(define in
,(match (hash-ref mv 'httpMethod)
["GET" `(get-pure-port url h)]
["POST" `(post-pure-port url body h)]
["PUT" `(put-pure-port url body h)]
[else `(error ',name "TO-DO")]))
(define js (bytes->jsexpr (port->bytes in)))
(close-input-port in)
js))
(newline))
(define (pretty-print-code x) (display (substring (with-output-to-string (lambda () (pretty-print x))) 1)))
(define (wrap s [right 70] [indent 2])
s)
(with-output-to-file "code-gen-examples/urlshortener.rkt"
(lambda ()
(discovery-document->racket-code
(load-discovery-document "vendor/urlshortener.v1.js")))
#:mode 'text
#:exists 'replace)