diff options
Diffstat (limited to 'web/webserver.scm')
| -rwxr-xr-x | web/webserver.scm | 163 |
1 files changed, 3 insertions, 160 deletions
diff --git a/web/webserver.scm b/web/webserver.scm index 0f733d3..26b4a75 100755 --- a/web/webserver.scm +++ b/web/webserver.scm @@ -23,59 +23,15 @@ (web client) (web request) (web response) - (web uri) +; (web uri) (fibers web server) (gn cache memoize) + (web gn-uri) (gn db sparql) + (gn data species) (web sxml) (web view doc)) -(define get-version - "2.0") - -(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)) - -(define (mk-html path) - "Create a pointer to HTML documentation" - (string-append (base-url) "/" path ".html")) - -(define (mk-doc path) - "Create a pointer to HTML documentation" - (mk-html (string-append "doc/" path))) - -(define (mk-meta path) - "Create a meta URL for the API path" - (mk-url path ".meta.json")) - -(define (mk-data path) - "Create a JSON URL for the API path" - (mk-url path ".json")) - -(define (mk-term postfix) - (mk-html (string-append "term" "/" postfix))) - -(define (mk-id postfix) - (mk-html (string-append "id" "/" postfix))) - -(define (mk-predicate postfix) - (mk-html (string-append "predicate" "/" postfix))) - (define info `( ("name" . "GeneNetwork REST API") @@ -95,46 +51,10 @@ (,(mk-url "datasets")."Get a list of datasets"))))) -;; result should be a vector of list of pair -(define (species-digest recs) - (map (lambda (r) - (let* ([k (car r)] - [v (cdr r)]) - ; with key use (cons k (map (lambda (i) (cons (car i) (car (cdr i)))) v)) - (map (lambda (i) (cons (url-parse-id (car i)) (car (cdr i)))) v) - )) - recs ) - ) - -(define (get-species) - (receive (names res) (memo-sparql-species-meta) - (let* ([table (get-rows names res)] - [recs '()] - [h (compile-species recs table)]) - (species-digest h)) - )) ; (define (wd-species-info wd) ; ) -(define (url-parse-id uri) - (if uri - (car (reverse (string-split uri #\057))) - "unknown" - )) - -(define (strip-lang s) - "Strip quotes and language tag (@en) from RDF entries" - (list->string (match (string->list s) - [(#\"rest ... #\") rest] - [(#\"rest ... #\" #\@ #\e #\n) rest] - [rest rest])) - ) - -(define (normalize-id str) - ;; (string-replace-substring (string-downcase str) " " "_") - (string-replace-substring str " " "_") - ) (define (get-expanded-taxon-meta id) "Get information on a specific species, e.g. mouse" @@ -145,83 +65,6 @@ ("up" . ,(mk-meta "species")) )) -(define (expand-species rec) - (let ([wd-id (url-parse-id (assoc-ref rec "22-rdf-syntax-ns#isDefinedBy"))] - [short-name (normalize-id (assoc-ref rec "name"))]) - (if (string=? wd-id "unknown") - rec - ; wikidata query: - (receive (names row) (tsv->scm (memo-sparql-wd-species-info wd-id)) - (match (pk (car row)) - ((taxonomy-name ncbi descr) - (let ([ncbi-id (strip-lang ncbi)] - [taxonomy-lnk (string-replace-substring (strip-lang taxonomy-name) " " "_")]) - (cons `("id" . ,short-name) - (cons `("wikidata" . ,wd-id) - (cons `("taxonomy-id" . ,ncbi-id) - (cons `("ncbi-url" . ,(string-append "https://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?mode=Info&id=" ncbi-id)) - (cons `("uniprot-url" . ,(string-append "https://www.uniprot.org/taxonomy/" ncbi-id)) - (cons `("wikidata-url" . ,(string-append "http://www.wikidata.org/entity/" wd-id)) - (cons `("wikispecies-url" . ,(string-append "https://species.wikimedia.org/wiki/" taxonomy-lnk)) - (cons `("taxonomy-name" . ,(strip-lang taxonomy-name)) - (cons `("meta" . ,(mk-meta short-name)) - (cons `("description" . ,(strip-lang descr)) - rec)))))))))))) - ) - ))) - ) - - -(define (get-expanded-species) - "Here we add information related to each species" - (map (lambda (rec) - (expand-species rec) - ) (get-species) -)) - -(define (get-expanded-species1 short-name) - "Here we add information related to one taxonomy species" - (call/cc (lambda (return) - (for-each (lambda (rec) - (if (string=? (assoc-ref rec "shortName") short-name) - (return (expand-species rec)))) - (get-species)) - (return #f) -))) - -(define (get-species-api-str) - (scm->json-string #("https://genenetwork.org/api/v2/mouse/" - "https://genenetwork.org/api/v2/rat/"))) - -(define (get-species-shortnames recs) - (map (lambda r (assoc-ref (car r) "shortName")) recs)) - -(define (get-species-meta2 recs) - "Return a list of short names and expand them to URIs" - (map (lambda r - (let ([shortname (assoc-ref (car r) "shortName")]) - (cons shortname (mk-meta shortname)))) recs) - ) - -(define (get-species-links recs) - "Return a list of short names and expand them to URIs" - (map (lambda r - (let ([shortname (assoc-ref (car r) "shortName")]) - (cons shortname (mk-data shortname)))) recs) - ) - -(define (get-species-data) - (list->vector (get-expanded-species))) - -(define (get-species-meta) - (let ([recs (get-expanded-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")) - ("data" . ,(mk-data "species")) - ("up" . ,(string-append (prefix) "/")) - ("meta-links" . ,(get-species-meta2 recs)) - ("links" . ,(get-species-links recs))))) ;; ---- REST API web server handler |