aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPjotr Prins2023-08-10 13:43:46 +0200
committerPjotr Prins2023-08-10 13:43:46 +0200
commit7851b6408e4954e7b2ebce500de8734b246ee439 (patch)
treea2fd0e28c0707798b478365d50392023030483dd
parentff21db13b3243c31a52462aad4e0faaefc55a239 (diff)
downloadgn-guile-7851b6408e4954e7b2ebce500de8734b246ee439.tar.gz
Render HTML on species
-rw-r--r--web/view/doc.scm20
-rwxr-xr-xweb/webserver.scm23
2 files changed, 31 insertions, 12 deletions
diff --git a/web/view/doc.scm b/web/view/doc.scm
index 1125147..71112eb 100644
--- a/web/view/doc.scm
+++ b/web/view/doc.scm
@@ -15,7 +15,12 @@
(define* (layout #:key
(head '())
(body '())
- (title "GeneNetwork.org API"))
+ (title "GeneNetwork.org API")
+ (info "")
+ (meta "")
+ (data "")
+ (back "")
+ )
`((doctype "html")
(html (@ (lang "en"))
(head
@@ -30,8 +35,13 @@
(type "text/css")
(href "./css/gn-doc.css")))
,@head)
- (body (h1 ,body)
- ; ,body
+ (body (h1 ,title)
+ (p ,info)
+ (p "JSON API: " (a (@ (href ,meta)) "meta") " | "
+ (a (@ (href ,data)) "data") " | "
+ (a (@ (href ,back)) "back"))
+ (pre
+ ,(scm->json-string body #:pretty #t))
; (p ,(parse-html "<b>some raw really <i>text</i> here</b>"))
(footer
(p "Copyright © 2005—2023 by the GeneNetwork community with a touch of " (span (@ (class "lambda")) "λ") "!")
@@ -40,5 +50,5 @@
"source code") "."))
))))
-(define (view-doc path page)
- (layout #:body page))
+(define* (view-doc path page #:optional rec)
+ (layout #:title page #:info (assoc-ref rec "info") #:meta (assoc-ref rec "meta") #:data (assoc-ref rec "data") #:back (assoc-ref rec "up") #:body rec))
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)))))