diff options
Diffstat (limited to 'web/webserver.scm')
| -rwxr-xr-x | web/webserver.scm | 23 |
1 files changed, 16 insertions, 7 deletions
diff --git a/web/webserver.scm b/web/webserver.scm index a5671dc..537fad5 100755 --- a/web/webserver.scm +++ b/web/webserver.scm @@ -36,11 +36,17 @@ (define (base-url) "https://luna.genenetwork.org") - (define (prefix) "Build the API URL including version" (string-append (base-url) "/api/v" get-version)) +(define (base-url) + "http://localhost:8091") + +(define (prefix) + "Build the API URL including version" + (base-url)) + (define* (mk-url postfix #:optional (ext "")) "Add the path to the API URL" (string-append (prefix) "/" postfix ext)) @@ -189,11 +195,12 @@ (define (get-species-meta) (let ([recs (get-expanded-species)]) - `(("comment" . "Get information on species") + `(("info" . "Get information on species by visiting the data link or one of the individual links") ("doc" . ,(mk-doc "species")) ("meta" . ,(mk-meta "species")) - ("rec" . ,(mk-rec "species")) - ("meta" . ,(get-species-meta2 recs)) + ("data" . ,(mk-rec "species")) + ("up" . ,(string-append (prefix) "/")) + ("meta-links" . ,(get-species-meta2 recs)) ("links" . ,(get-species-links recs))))) ;; ---- REST API web server handler @@ -207,11 +214,11 @@ (list (build-response #:code 404) (string-append "Resource not found: " (uri->string uri)))) -(define* (render-doc path page #:key (extra-headers '())) +(define* (render-doc path page #:optional rec #:key (extra-headers '())) (list (append extra-headers '((content-type . (text/html)))) (lambda (port) - (sxml->html (view-doc (pk path) (pk page)) port)))) + (sxml->html (view-doc (pk path) (pk page) rec) port)))) (define (render-json json) (list '((content-type . (application/json))) @@ -231,6 +238,8 @@ (render-json info)) (('GET "version") (render-json get-version)) + (('GET "doc" "species.html") + (render-doc "doc" "species.html" (get-species-meta))) (('GET "doc" path ... page) ; serve documents from /doc/ (render-doc path page)) (('GET "species.json") @@ -255,7 +264,7 @@ (request-method request) (uri-path (request-uri request))) (apply values - ((controller request body) + ((controller (pk request) body) (cons (request-method request) (request-path-components request))))) |