aboutsummaryrefslogtreecommitdiff
path: root/web
diff options
context:
space:
mode:
Diffstat (limited to 'web')
-rw-r--r--web/.guix-shell8
-rw-r--r--web/css/gn-template-style.css39
-rw-r--r--web/templates/genenetwork.scm18
-rw-r--r--web/view/view.scm4
-rw-r--r--web/webserver.scm34
5 files changed, 78 insertions, 25 deletions
diff --git a/web/.guix-shell b/web/.guix-shell
deleted file mode 100644
index b4aee2a..0000000
--- a/web/.guix-shell
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/bin/bash
-#
-# run with options '-- ./webserver.scm 8091' e.g.
-# . .guix-shell -- guile -L .. --fresh-auto-compile --listen=1970 -e main ./webserver.scm 8091
-
-echo "Note run: running web-server"
-
-guix shell guile guile-commonmark guile-fibers guile-json guile-gnutls guile-readline guile-redis openssl nss-certs $*
diff --git a/web/css/gn-template-style.css b/web/css/gn-template-style.css
new file mode 100644
index 0000000..38893c6
--- /dev/null
+++ b/web/css/gn-template-style.css
@@ -0,0 +1,39 @@
+* {
+ box-sizing: border-box;
+}
+
+body {
+ margin: 0.7em;
+ display: grid;
+ grid-template-columns: 9fr 1fr;
+ grid-gap: 20px;
+
+ font-family: "Helvetica Neue", Helvetica, Arial, sans-serif;
+ font-style: normal;
+ font-size: 20px;
+}
+
+#header {
+ grid-column-start: 1;
+ grid-column-end: 3;
+
+ background-color: #336699;
+ color: #FFFFFF;
+ border-radius: 3px;
+ min-height: 30px;
+}
+
+#header #header-text {
+ padding-left: 0.2em;
+}
+
+#main {
+ grid-column-start: 1;
+ grid-column-end: 2;
+
+ max-width: 650px;
+}
+
+#main img {
+ max-width: 650px;
+}
diff --git a/web/templates/genenetwork.scm b/web/templates/genenetwork.scm
new file mode 100644
index 0000000..64e9852
--- /dev/null
+++ b/web/templates/genenetwork.scm
@@ -0,0 +1,18 @@
+(define-module (web templates genenetwork)
+ #:use-module (web view markdown)
+
+ #:export (default-gn-template))
+
+(define* (default-gn-template path #:optional (title "Default Page Template"))
+ "Render `PATH' with a default template and styling that fits in with
+ GeneNetwork's look and feel."
+ `(html
+ (head
+ (meta (@ (charset "UTF-8")))
+ (meta (@ (name "viewport") (content "width=device-width, initial-scale=1.0")))
+ (title ,title)
+ (link (@ (rel "stylesheet") (type "text/css")
+ (href "/css/gn-template-style.css"))))
+ (body
+ (header (@ (id "header")) (span (@ (id "header-text")) "GeneNetwork"))
+ (main (@ (id "main")) ,(markdown-github->sxml path)))))
diff --git a/web/view/view.scm b/web/view/view.scm
index 4584cf8..4300863 100644
--- a/web/view/view.scm
+++ b/web/view/view.scm
@@ -10,6 +10,7 @@
#:use-module (web view markdown)
#:use-module (web view brand msk)
#:use-module (web view brand aging)
+ #:use-module (web templates genenetwork)
#:export (view-brand))
@@ -45,6 +46,9 @@ data to benefit from the power of integrated datasets, please contact:")
(define* (view-brand path)
(match path
("aging" (view-aging))
+ ("gnqa" (default-gn-template
+ "genenetwork/gn-docs/general/brand/gnqa/gnqa.md"
+ "GeneNetwork Question and Answer System"))
( _ (msk-html #:info
`(
,(markdown-github->sxml "genenetwork/gn-docs/general/brand/msk/home.md")
diff --git a/web/webserver.scm b/web/webserver.scm
index c0fb9a1..d2a8c8d 100644
--- a/web/webserver.scm
+++ b/web/webserver.scm
@@ -34,14 +34,14 @@
(getenv "CGIT_REPO_PATH"))
(define +info+
- `(("name" . "GeneNetwork REST API") ("version" ,get-version)
+ `(("name" . "GeneNetwork REST API") ("version" . ,get-version)
("comment" . "This is the official REST API for the GeneNetwork service hosted at https://genenetwork.org/")
("license"
("source code (unless otherwise specified)" . "Affero GNU Public License 3.0 (AGPL3)")
("data (unless otherwise specified)" . "Attribution-NonCommercial-NoDerivatives 4.0 International (CC BY-NC-ND 4.0)"))
("note" . "This is work in progress (WIP). Note that the final base URL will change! The temporary prefix is:")
- ("prefix" ,(prefix))
- ("links" ("species" ,(mk-meta "species")))))
+ ("prefix" . ,(prefix))
+ ("links" ("species" . ,(mk-meta "species")))))
(define +info-meta+
`(("doc" ,(mk-html "info"))
@@ -87,9 +87,9 @@ otherwise search for set/group data"
(modified (and stat
(make-time time-utc 0
(stat:mtime stat)))))
- (list `((content-type ,(assoc-ref file-mime-types
- (file-extension file-name)))
- (last-modified ,(time-utc->date modified)))
+ (list `((content-type . ,(assoc-ref file-mime-types
+ (file-extension file-name)))
+ (last-modified . ,(time-utc->date modified)))
(call-with-input-file file-name
get-bytevector-all))))
@@ -100,9 +100,9 @@ otherwise search for set/group data"
(modified (and stat
(make-time time-utc 0
(stat:mtime stat)))))
- (list `((content-type ,(assoc-ref file-mime-types
- (file-extension path)))
- (last-modified ,(time-utc->date modified)))
+ (list `((content-type . ,(assoc-ref file-mime-types
+ (file-extension path)))
+ (last-modified . ,(time-utc->date modified)))
(call-with-input-file path
get-bytevector-all))))
@@ -172,8 +172,8 @@ otherwise search for set/group data"
(lambda (key . args)
(let ((msg (car args)))
(build-json-response 400
- `(("error" ,key)
- ("msg" ,msg)))))))
+ `(("error" . ,key)
+ ("msg" . ,msg)))))))
(define (invalid-data? data target)
(if (string? (assoc-ref data target))
@@ -214,8 +214,8 @@ otherwise search for set/group data"
(lambda (key . args)
(let ((msg (car args)))
(build-json-response 400
- `(("error" ,key)
- ("msg" ,msg)))))))
+ `(("error" . ,key)
+ ("msg" . ,msg)))))))
(define (controller request body)
(match-lambda
@@ -224,13 +224,13 @@ otherwise search for set/group data"
(('GET "version")
(render-json get-version))
(('GET "css" fn)
- (render-static-file (string-append "css/" fn)))
+ (render-static-file (string-append (dirname (current-filename)) "/css/" fn)))
(('GET "map" fn)
- (render-static-file (string-append "css/" fn)))
+ (render-static-file (string-append (dirname (current-filename)) "/css/" fn)))
(('GET "static" "images" fn)
- (render-static-image (string-append "static/images/" fn)))
+ (render-static-image (string-append (dirname (current-filename)) "/static/images/" fn)))
(('GET "home" path)
- (render-brand path))
+ (render-brand path)) ; branding route for /home/aging, /home/msk etc
(('GET "doc" "species.html")
(render-doc "doc" "species.html"
(get-species-meta)))
generated by cgit v1.2.3 (git 2.47.1) at 2025-07-07 12:44:13 +0000