From 0720d433de118f9bd4ca73e1e4a07eb287152e87 Mon Sep 17 00:00:00 2001 From: Pjotr Prins Date: Sun, 27 Aug 2023 17:52:35 +0200 Subject: Started on branding --- README.md | 4 ++++ doc/branding.md | 3 +++ doc/gn-guile.md | 7 +++++++ web/static/images/CMOR.jpg | Bin 0 -> 161664 bytes web/view/brand/msk.scm | 44 ++++++++++++++++++++++++++++++++++++++++++++ web/view/view.scm | 18 ++++++++++++++++++ web/webserver.scm | 44 ++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 120 insertions(+) create mode 100644 doc/branding.md create mode 100644 doc/gn-guile.md create mode 100644 web/static/images/CMOR.jpg create mode 100644 web/view/brand/msk.scm create mode 100644 web/view/view.scm diff --git a/README.md b/README.md index 12f3050..908509c 100644 --- a/README.md +++ b/README.md @@ -2,6 +2,10 @@ This directory provides a Guile web service incl. the new REST API. It is used in conjunction with the Python web services and (very much) WIP. +# Documentation + +Start with this file and then the documentation in [doc](./doc/gn-guile.md). + # Development The current repository lives at diff --git a/doc/branding.md b/doc/branding.md new file mode 100644 index 0000000..416a08b --- /dev/null +++ b/doc/branding.md @@ -0,0 +1,3 @@ +# Branding for GeneNetwork + +GN Guile provides a branding mechanism for GN. diff --git a/doc/gn-guile.md b/doc/gn-guile.md new file mode 100644 index 0000000..7a86c13 --- /dev/null +++ b/doc/gn-guile.md @@ -0,0 +1,7 @@ +# GN Guile Documentation + +The GeneNetwork Guile web server serves an exploratory REST API as well as HTML using [htmx](https://htmx.org/) components that are served and used. + +Topics are: + +* [Branding GN](./branding.md) diff --git a/web/static/images/CMOR.jpg b/web/static/images/CMOR.jpg new file mode 100644 index 0000000..7a97885 Binary files /dev/null and b/web/static/images/CMOR.jpg 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) -- cgit v1.2.3