Getting group info

4 files changed, 64 insertions, 4 deletions

diff --git a/gn/data/group.scm b/gn/data/group.scm
new file mode 100644
index 0000000..003ac11
--- /dev/null
+++ b/gn/data/group.scm
@@ -0,0 +1,23 @@
+(define-module (gn data group)
+  #:use-module (srfi srfi-1)
+  #: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-group-links
+            ))
+
+(define (get-group-links gnid)
+  "Return all the URIs that link to group info, e.g. for Mus_musculus"
+  (let ([recs (car (cdr (compile-groups-meta)))]
+        [uri (mk-gnid gnid)])
+    (filter-map
+     (lambda (r) (if (string=? (second r) uri)
+                     (list ("ref" . (car r)))
+                     #f)) recs)
+  ))
diff --git a/gn/data/species.scm b/gn/data/species.scm
index 72ab7cf..ca3bb05 100644
--- a/gn/data/species.scm
+++ b/gn/data/species.scm
@@ -6,9 +6,11 @@
   #:use-module (ice-9 receive)
   #:use-module (ice-9 string-fun)
   #:use-module (gn db sparql)
+  #:use-module (gn data group)
   #:use-module (web gn-uri)
 
   #:export (
+            gnid-species
             get-species-meta
             get-species-data
             get-species-shortnames
@@ -17,10 +19,10 @@
             get-expanded-taxon-data
             ))
 
-(define (gn-species short-name)
-  "Find the GN identifier from shortname"
+(define (gnid-species short-name)
+  "Find the GN identifier from shortname, e.g. Mus_musculus"
   (let ([rec (get-expanded-taxon-data short-name)])
-    rec
+    (url-parse-id (assoc-ref rec "gnid"))
   ))
 
 (define (get-species)
@@ -128,5 +130,5 @@
     ("meta" . ,(mk-meta id))
     ("data" . ,(mk-data id))
     ("up" . ,(mk-meta "species"))
-    ("links" . "test") ; ,(get-group-links (gn-species id)))
+    ("links" . ,(list->vector (get-group-links (gnid-species id))))
   ))
diff --git a/gn/db/sparql.scm b/gn/db/sparql.scm
index fd779c6..2665235 100644
--- a/gn/db/sparql.scm
+++ b/gn/db/sparql.scm
@@ -14,8 +14,10 @@
   #:export (memo-sparql-species
             memo-sparql-species-meta
             sparql-species-meta
+            sparql-groups-meta
             memo-sparql-wd-species-info
             compile-species
+            compile-groups-meta
             get-rows
             tsv->scm
             strip-lang
@@ -218,3 +220,23 @@ dump-species-metadata.ttl:gn:Axbxa gnt:belongsToSpecies gn:Mus_musculus .
 		  ))
 		rows)
   recs)
+
+;; ------------------------------------------------------------------------------
+
+(define (sparql-groups-meta)
+  "Return values names recs"
+  (sparql-scm (gn-sparql-endpoint-url) "
+       SELECT DISTINCT ?set ?species ?descr WHERE {
+            ?set rdf:type gnc:inbredSet ;
+                 gnt:belongsToSpecies ?species .
+            OPTIONAL {?set rdfs:label ?descr } .
+   }"))
+
+(define memo-sparql-groups-meta
+  (memoize2 sparql-groups-meta))
+
+(define (compile-groups-meta)
+  "Return tuple of names and rows containing #(set species descr)"
+  (receive (names res) (memo-sparql-groups-meta)
+    (let ([rows (get-rows names res)])
+      (list names rows))))
diff --git a/web/gn-uri.scm b/web/gn-uri.scm
index c52066d..c0a440a 100644
--- a/web/gn-uri.scm
+++ b/web/gn-uri.scm
@@ -11,6 +11,9 @@
             mk-doc
             mk-html
             mk-url
+            mk-id
+            mk-gnid
+            mk-predicate
             prefix
             url-parse-id
             normalize-id
@@ -43,6 +46,9 @@
 (define (base-url)
   "http://localhost:8091")
 
+(define uri-base-url
+  "http://genenetwork.org")
+
 (define (prefix)
   "Build the API URL including version"
   (base-url))
@@ -51,6 +57,10 @@
   "Add the path to the API URL"
   (string-append (prefix) "/" postfix ext))
 
+(define* (mk-uri postfix)
+  "Add the path to the GN URI"
+  (string-append uri-base-url "/" postfix))
+
 (define (mk-html path)
   "Create a pointer to HTML documentation"
   (string-append (base-url) "/" path ".html"))
@@ -73,5 +83,8 @@
 (define (mk-id postfix)
   (mk-html (string-append "id" "/" postfix)))
 
+(define (mk-gnid postfix)
+  (mk-uri (string-append "id" "/" postfix)))
+
 (define (mk-predicate postfix)
   (mk-html (string-append "predicate" "/" postfix)))