aboutsummaryrefslogtreecommitdiff
path: root/web
diff options
context:
space:
mode:
Diffstat (limited to 'web')
-rw-r--r--web/static/images/CMOR.jpgbin0 -> 161664 bytes
-rw-r--r--web/view/brand/msk.scm44
-rw-r--r--web/view/view.scm18
-rwxr-xr-xweb/webserver.scm44
4 files changed, 106 insertions, 0 deletions
diff --git a/web/static/images/CMOR.jpg b/web/static/images/CMOR.jpg
new file mode 100644
index 0000000..7a97885
--- /dev/null
+++ b/web/static/images/CMOR.jpg
Binary files differ
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)