Adding test infrastructure and reorganizing modules - still not happy with (web uri)

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