diff options
Diffstat (limited to 'gn')
| -rw-r--r-- | gn/data/hits.scm | 15 | ||||
| -rw-r--r-- | gn/data/strains.scm | 5 | ||||
| -rw-r--r-- | gn/db/mysql.scm | 72 |
3 files changed, 31 insertions, 61 deletions
diff --git a/gn/data/hits.scm b/gn/data/hits.scm new file mode 100644 index 0000000..91be81f --- /dev/null +++ b/gn/data/hits.scm @@ -0,0 +1,15 @@ +(define-module (gn data hits) + #: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 (dbi dbi) + #:use-module (gn db mysql) + #:use-module (gn data group) + #:use-module (web gn-uri) + + #:export ( + )) diff --git a/gn/data/strains.scm b/gn/data/strains.scm index b3e6744..241ecda 100644 --- a/gn/data/strains.scm +++ b/gn/data/strains.scm @@ -17,9 +17,10 @@ )) (define* (strain-id-names inbred-set #:key (map? #f)) - "Return assoc list of tuples of strain id+names, e.g. - + "Return assoc list of tuples of strain id+names: ((4 . BXD1) (5 . BXD2) (6 . BXD5) (7 . BXD6)... + +map? will say whether the strains/individuals are used for mapping. " (call-with-db (lambda (db) diff --git a/gn/db/mysql.scm b/gn/db/mysql.scm index 4c6b35e..4e2b280 100644 --- a/gn/db/mysql.scm +++ b/gn/db/mysql.scm @@ -15,29 +15,18 @@ #:export ( ;; DB <- don't export call-with-db - db-open - db-check - db-check2 - db-query - db-get-row get-row - db-display-rows - db-get-rows - db-get-rows-apply + get-rows get-rows-apply + check + ;db-open + ;db-query + ;db-get-row + ;db-display-rows + ;db-get-rows-apply )) -(define DB - (begin - (display "===> OPENING DB") - (newline) - (dbi-open "mysql" "webqtlout:webqtlout:db_webqtl:tcp:127.0.0.1:3306") - )) - (define (db-open) - DB) - -(define (db-open2) (begin (display "===> OPENING DB") (newline) @@ -45,18 +34,9 @@ )) (define (call-with-db thunk) - (thunk (db-open2))) + (thunk (db-open))) -(define (db-check) - "Use DBI-style handle to report an error. On error the program will stop." - (match (dbi-get_status DB) - ((stat . msg) (if (= stat 0) - #t - (begin - (display msg) - (newline) - (assert stat)))))) -(define (db-check2 db) +(define (check db) "Use DBI-style handle to report an error. On error the program will stop." (match (dbi-get_status db) ((stat . msg) (if (= stat 0) @@ -66,25 +46,10 @@ (newline) (assert stat)))))) -(define (db-query str) - (dbi-query (pk DB) str)) - -(define (db-get-row) - (dbi-get_row DB)) - (define (get-row db) (dbi-get_row db)) -(define (db-display-rows) - (let [(row (dbi-get_row db))] - (if row - (begin - (display row) - (get-rows DB) - ) - #t))) - -(define (db-get-rows list) +(define (get-rows db list) "After running dbi-query we can fetch all rows and return them as a list of records, which are assoc list: (dbi-query db \"SELECT StrainId,Strain.Name FROM Strain, StrainXRef WHERE StrainXRef.StrainId = Strain.Id AND StrainXRef.InbredSetId = 1 ORDER BY StrainId;\") @@ -93,20 +58,9 @@ (((StrainId . 4) (Name . BXD1)) ((StrainId . 5) (Name . BXD2))... " - (let [(row (dbi-get_row DB))] - (if row - (db-get-rows (append list `(,row))) - list))) - -(define (db-get-rows-apply func list) - "Similar to db-get-rows with a function that gets applied on every record, e.g. - - (define ids (db-get-rows-apply db (lambda (r) `(,(assoc-ref r \"StrainId\") . ,(assoc-ref r \"Name\"))) '())) - -" - (let [(row (dbi-get_row DB))] + (let [(row (dbi-get_row db))] (if row - (db-get-rows-apply func (append list `(,(func row)))) + (get-rows db (append list `(,row))) list))) (define (get-rows-apply db func lst) @@ -117,7 +71,7 @@ " (let [(row (dbi-get_row db))] (begin - (display row) + ; (display row) (if row (get-rows-apply db func (append lst `(,(func row)))) lst))) |