diff options
| -rw-r--r-- | gn/data/dataset.scm | 28 | ||||
| -rw-r--r-- | web/webserver.scm | 27 |
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") |