aboutsummaryrefslogtreecommitdiff
path: root/web/webserver.scm
diff options
context:
space:
mode:
authorPjotr Prins2023-08-10 13:43:46 +0200
committerPjotr Prins2023-08-10 13:43:46 +0200
commit7851b6408e4954e7b2ebce500de8734b246ee439 (patch)
treea2fd0e28c0707798b478365d50392023030483dd /web/webserver.scm
parentff21db13b3243c31a52462aad4e0faaefc55a239 (diff)
downloadgn-guile-7851b6408e4954e7b2ebce500de8734b246ee439.tar.gz
Render HTML on species
Diffstat (limited to 'web/webserver.scm')
-rwxr-xr-xweb/webserver.scm23
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)))))