aboutsummaryrefslogtreecommitdiff
path: root/gn
diff options
context:
space:
mode:
Diffstat (limited to 'gn')
-rw-r--r--gn/data/hits.scm15
-rw-r--r--gn/data/strains.scm5
-rw-r--r--gn/db/mysql.scm72
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)))