diff options
Diffstat (limited to 'web')
| -rw-r--r-- | web/static/images/CMOR.jpg | bin | 0 -> 161664 bytes | |||
| -rw-r--r-- | web/view/brand/msk.scm | 44 | ||||
| -rw-r--r-- | web/view/view.scm | 18 | ||||
| -rwxr-xr-x | web/webserver.scm | 44 |
4 files changed, 106 insertions, 0 deletions
diff --git a/web/static/images/CMOR.jpg b/web/static/images/CMOR.jpg Binary files differnew file mode 100644 index 0000000..7a97885 --- /dev/null +++ b/web/static/images/CMOR.jpg diff --git a/web/view/brand/msk.scm b/web/view/brand/msk.scm new file mode 100644 index 0000000..9215c20 --- /dev/null +++ b/web/view/brand/msk.scm @@ -0,0 +1,44 @@ +;; Branding module for MSK +(define-module (web view brand msk) + #:use-module (json) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:use-module (ice-9 iconv) + #:use-module (ice-9 receive) + #:use-module (ice-9 string-fun) + #:use-module (sxml simple) + #:use-module (web sxml) + #:export (msk-html)) + + +(define* (msk-html #:key + (head '()) + (body '()) + (title "GN4MSK: GeneNetwork for Musculoskeletal Genetics") + (info "") + (meta "") + (data "") + (back "") + ) + `((doctype "html") + (html (@ (lang "en")) + (head + (title ,title) + (meta (@ (http-equiv "Content-Type") (content "text/html; charset=UTF-8"))) + (meta (@ (name "author") (content "GN4MSK team (https://msk.genenetwork.org/)"))) + (meta (@ (name "viewport") + (content "width=device-width, initial-scale=1"))) + (link + (@ (rel "stylesheet") + (media "screen") + (type "text/css") + (href "./css/gn-doc.css"))) + ,@head) + (body (h1 ,title) + (p ,info) + (footer + (p "Copyright © 2005—2023 by the GeneNetwork community with a touch of " (span (@ (class "lambda")) "λ") "!") + (p "This is free software. Download the " + (a (@ (href "https://ci.genenetwork.org/")) + "source code") ".")) + )))) diff --git a/web/view/view.scm b/web/view/view.scm new file mode 100644 index 0000000..e3b4ee1 --- /dev/null +++ b/web/view/view.scm @@ -0,0 +1,18 @@ +(define-module (web view view) + #:use-module (json) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:use-module (ice-9 iconv) + #:use-module (ice-9 receive) + #:use-module (ice-9 string-fun) + #:use-module (sxml simple) + #:use-module (web sxml) + #:use-module (web view brand msk) + + #:export (view-brand)) + +(define* (view-brand path) + (msk-html #:info + '((h2 "HI") + (img (@ (src "static/images/CMOR.jpg")) + )))) diff --git a/web/webserver.scm b/web/webserver.scm index a60f477..91ff6d6 100755 --- a/web/webserver.scm +++ b/web/webserver.scm @@ -19,6 +19,7 @@ (srfi srfi-1) (srfi srfi-11) ; let-values (srfi srfi-26) + (rnrs io ports) ; bytevector-all (web http) (web client) (web request) @@ -31,6 +32,7 @@ (gn data species) (gn data group) (web sxml) + (web view view) (web view doc)) @@ -71,12 +73,50 @@ otherwise search for set/group data" (list (build-response #:code 404) (string-append "Resource not found: " (uri->string uri)))) + +(define file-mime-types + '(("css" . (text/css)) + ("js" . (text/javascript)) + ("svg" . (image/svg+xml)) + ("png" . (image/png)) + ("gif" . (image/gif)) + ("jpg" . (image/jpg)) + ("woff" . (application/font-woff)) + ("ttf" . (application/octet-stream)) + ("html" . (text/html)))) + +(define (file-extension file-name) + (last (string-split file-name #\.))) + +(define* (render-static-image path #:key (extra-headers '())) + (list `((content-type + . ,(assoc-ref file-mime-types + (file-extension "CMOR.jpg"))) ; (last-modified . ,(time-utc->date modified)) + ) + (call-with-input-file "./static/images/CMOR.jpg" get-bytevector-all))) + +#! +(call-with-input-file "./static/images/CMOR.jpg" get-bytevector-all) +(list (append extra-headers + '((content-type . (application/octet-stream))) + (lambda (port) + (put-bytevector port + (call-with-input-file "./static/images/CMOR.jpg" get-bytevector-all) + ) +!# + (define* (render-doc path page #:optional rec #:key (extra-headers '())) (list (append extra-headers '((content-type . (text/html)))) (lambda (port) (sxml->html (view-doc path page rec) port)))) +(define* (render-brand path #:optional rec #:key (extra-headers '())) + (list (append extra-headers + '((content-type . (text/html)))) + (lambda (port) + (sxml->html (view-brand path) port)))) + (define (render-json json) (list '((content-type . (application/json))) (lambda (port) @@ -95,6 +135,10 @@ otherwise search for set/group data" (render-json info)) (('GET "version") (render-json get-version)) + (('GET "static" "images" path) + (render-static-image path)) + (('GET "brand" path) + (render-brand path)) (('GET "doc" "species.html") (render-doc "doc" "species.html" (get-species-meta))) (('GET "doc" taxon) |
