Write gemma trait values (pheno file)

2 files changed, 46 insertions, 9 deletions

diff --git a/gn/data/dataset.scm b/gn/data/dataset.scm
index c21a663..f099171 100644
--- a/gn/data/dataset.scm
+++ b/gn/data/dataset.scm
@@ -7,15 +7,18 @@
   #:use-module (srfi srfi-1)
   #:use-module (dbi dbi)
   #:use-module (gn db mysql)
+  #:use-module (gn data genotype)
   #:use-module (gn data group)
   #:use-module (gn util convert)
   #:use-module (web gn-uri)
+  #:use-module (rnrs base) ; for assert
 
   #:export (
             dataset-name
             get-bxd-publish-list
             get-bxd-publish-values-list
             get-bxd-publish-name-value-dict
+            write-pheno-file
             ))
 
 (define (get-dataset db probesetfreeze-id)
@@ -68,3 +71,28 @@
                                                `(,(assoc-ref r "Name") . ,(assoc-ref r "value"))
                                                ) '())))
            )))))
+
+
+(define (write-pheno-file fn traits)
+  (define bxd-inds (geno-inds-bxd (pk "BXD.json")))
+  (assert (= 235 (length bxd-inds)))
+  (display bxd-inds)
+  (call-with-output-file fn
+    (lambda (port)
+      (for-each
+       (lambda (ind)
+         (begin
+           (let* [(value (assoc-ref traits ind))
+                  (outvalue (if value
+                                value
+                                "NA"))]
+             (if value
+                 (begin
+                   (format #t "~s ~s" ind outvalue)
+                   (newline)))
+             (display outvalue port)
+             (newline port))))
+       bxd-inds)
+      (close port)
+      ))
+)
diff --git a/web/webserver.scm b/web/webserver.scm
index b0070c3..c242b9d 100644
--- a/web/webserver.scm
+++ b/web/webserver.scm
@@ -7,6 +7,7 @@
              (ice-9 exceptions)
              (srfi srfi-1)
              (srfi srfi-11)
+             (srfi srfi-13)
              (srfi srfi-19)
              (srfi srfi-26)
              (rnrs io ports)
@@ -28,6 +29,11 @@
              (web view doc)
              (web view markdown))
 
+(define (get-extension filename)
+  (let ((dot-pos (string-rindex filename #\.)))
+    (if dot-pos
+        (substring filename dot-pos) "")))
+
 (define +current-repo-path+
   (getenv "CURRENT_REPO_PATH"))
 
@@ -91,7 +97,7 @@ otherwise search for set/group data"
     ("html" text/html)))
 
 (define (file-extension file-name)
-  (last (string-split file-name #\.)))
+  (last (string-split file-name #\.))) ;; FIXME: does not handle files with multiple dots
 
 (define* (render-static-image file-name
                               #:key (extra-headers '()))
@@ -135,6 +141,11 @@ otherwise search for set/group data"
         (lambda (port)
           (sxml->html (view-brand path) port))))
 
+(define (render-string str)
+  (list '((content-type application/txt))
+        (lambda (port)
+          (put-string port str))))
+
 (define (render-json json)
   (list '((content-type application/json))
         (lambda (port)
@@ -246,14 +257,12 @@ otherwise search for set/group data"
     (('GET "dataset" "bxd-publish" "list")
      (render-json (get-bxd-publish)))
     (('GET "dataset" "bxd-publish" "values" page)
-           (match (string->list page)
-             ((dataid ...
-                      #\.
-                      #\j
-                      #\s
-                      #\o
-                      #\n)
-              (render-json (get-bxd-publish-values (list->string dataid))))))
+     (match (get-extension page)
+       (".json"
+        (render-json (get-bxd-publish-values (basename page ".json"))))
+       (".tsv"  (render-string "TEST1\nTEST2"))
+       (".gemma" (write-pheno-file page (get-bxd-publish-values (basename page ".gemma"))))
+       (else    (display "ERROR: unknown file type"))))
     (('GET "dataset" "bxd-publish" "mapping" "values" (string-append dataid ".json"))
      (render-json (get-bxd-publish-values dataid  #:used-for-mapping? #t)))
     (('GET "doc" "species.html")