diff options
| -rw-r--r-- | gn/data/species.scm | 112 | ||||
| -rw-r--r-- | gn/db/sparql.scm | 14 | ||||
| -rw-r--r-- | test/runner.scm | 16 | ||||
| -rw-r--r-- | web/gn-uri.scm | 75 | ||||
| -rwxr-xr-x | web/webserver.scm | 163 |
5 files changed, 219 insertions, 161 deletions
diff --git a/gn/data/species.scm b/gn/data/species.scm new file mode 100644 index 0000000..a1eb15f --- /dev/null +++ b/gn/data/species.scm @@ -0,0 +1,112 @@ +(define-module (gn data species) + #: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 (gn db sparql) + #:use-module (web gn-uri) + + #:export ( + get-species-meta + get-species-data + get-species-shortnames + )) + +(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)) + )) + +;; 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 (expand-species rec) + (let ([wd-id (url-parse-id (assoc-ref rec "22-rdf-syntax-ns#isDefinedBy"))] + [short-name (normalize-id (assoc-ref rec "shortName"))]) + (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))))) diff --git a/gn/db/sparql.scm b/gn/db/sparql.scm index 95b4e1d..0e8c938 100644 --- a/gn/db/sparql.scm +++ b/gn/db/sparql.scm @@ -5,9 +5,11 @@ #:use-module (ice-9 iconv) #:use-module (ice-9 receive) #:use-module (ice-9 string-fun) - #:use-module (gn cache memoize) #:use-module (web client) + #:use-module (web request) #:use-module (web uri) + #:use-module (gn cache memoize) + #:use-module (web gn-uri) #:export (memo-sparql-species memo-sparql-species-meta @@ -15,9 +17,19 @@ compile-species get-rows tsv->scm + strip-lang ) ) + +(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 (gn-sparql-endpoint-url) "https://sparql.genenetwork.org/sparql") diff --git a/test/runner.scm b/test/runner.scm new file mode 100644 index 0000000..0123d9a --- /dev/null +++ b/test/runner.scm @@ -0,0 +1,16 @@ +;; Run with +;; +;; guile -L . --debug test/runner.scm + +(define-module (test-runner) + #:use-module (ice-9 match) + #:use-module (srfi srfi-64) + #:use-module (gn data species) + ) + +(test-begin "runner") + +(test-assert "Make sure species-meta contains a link to tomato" + (assoc "tomato" (cdr (assoc "links" (get-species-meta))))) + +(test-end "runner") diff --git a/web/gn-uri.scm b/web/gn-uri.scm new file mode 100644 index 0000000..a4292f0 --- /dev/null +++ b/web/gn-uri.scm @@ -0,0 +1,75 @@ +(define-module (web gn-uri) + #:use-module (ice-9 string-fun) + + #:export ( + get-version + ; url-parse-id + ; normalize-id + ; strip-lang + mk-meta + mk-data + mk-doc + prefix + url-parse-id + normalize-id + )) + + + +(define (normalize-id str) + ;; (string-replace-substring (string-downcase str) " " "_") + (string-replace-substring str " " "_") + ) + +(define (url-parse-id uri) + (if uri + (car (reverse (string-split uri #\057))) + "unknown" + )) + + +(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))) 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 |