From 566537f47eff45f17e0da9c28ca965f600b6b9a9 Mon Sep 17 00:00:00 2001
From: Pjotr Prins
Date: Fri, 11 Aug 2023 10:37:05 +0200
Subject: Get expanded species1

---
 web/webserver.scm | 64 ++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 40 insertions(+), 24 deletions(-)

(limited to 'web')

diff --git a/web/webserver.scm b/web/webserver.scm
index 771bebd..7690159 100755
--- a/web/webserver.scm
+++ b/web/webserver.scm
@@ -144,35 +144,50 @@
     ("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)
-	 (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 `("shortname" . ,shortname) - problematic
-		      (cons `("description" . ,(strip-lang descr))
-			    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/")))
@@ -260,7 +275,8 @@
      (let ([names (get-species-shortnames (get-expanded-species))])
        (match (string->list id)
 	 [(name ... #\. #\m #\e #\t #\a #\. #\j #\s #\o #\n) (render-json (get-expanded-taxon-meta (list->string name)))]
-	 [rest (render-json "WIP")])))
+	 [(name ... #\. #\j #\s #\o #\n) (render-json (get-expanded-species1 (list->string name)))]
+	 [rest (render-json "NOP")])))
     (_ (not-found (request-uri request)))
     ))
 
-- 
cgit v1.2.3