aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPjotr Prins2023-11-17 11:09:17 +0100
committerPjotr Prins2023-11-17 11:09:17 +0100
commitc401f66de2dbcbc41dd9551490563543092de242 (patch)
tree8e9eab92738389a8e4e73280a52ec5f11ea6f45b
parent678d976260c6f566166e0459a425d5ef296b002f (diff)
downloadgn-guile-c401f66de2dbcbc41dd9551490563543092de242.tar.gz
First implementation of DB handler
-rw-r--r--gn/data/strains.scm22
-rw-r--r--gn/db/mysql.scm78
-rwxr-xr-xscripts/precompute/precompute-hits.scm55
3 files changed, 131 insertions, 24 deletions
diff --git a/gn/data/strains.scm b/gn/data/strains.scm
new file mode 100644
index 0000000..275c4cd
--- /dev/null
+++ b/gn/data/strains.scm
@@ -0,0 +1,22 @@
+(define-module (gn data strains)
+ #: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 (
+ strain-names
+ ))
+
+(define (strain-names)
+ (call-with-db
+ (lambda (db)
+ (dbi-query db "SELECT StrainId,Strain.Name FROM Strain, StrainXRef WHERE StrainXRef.StrainId = Strain.Id AND StrainXRef.InbredSetId = 1 AND Used_for_mapping='Y' ORDER BY StrainId;")
+ (get-rows-apply db (lambda (r) `(,(assoc-ref r "StrainId") . ,(assoc-ref r "Name"))) '()))))
diff --git a/gn/db/mysql.scm b/gn/db/mysql.scm
index f6513af..4c6b35e 100644
--- a/gn/db/mysql.scm
+++ b/gn/db/mysql.scm
@@ -13,13 +13,50 @@
#:use-module (dbi dbi)
#: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-apply
))
-(define (db-check db)
+(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)
+ (dbi-open "mysql" "webqtlout:webqtlout:db_webqtl:tcp:127.0.0.1:3306")
+ ))
+
+(define (call-with-db thunk)
+ (thunk (db-open2)))
+
+(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)
"Use DBI-style handle to report an error. On error the program will stop."
(match (dbi-get_status db)
((stat . msg) (if (= stat 0)
@@ -29,16 +66,25 @@
(newline)
(assert stat))))))
-(define (db-display-rows db)
+(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)
+ (get-rows DB)
)
#t)))
-(define (db-get-rows db list)
+(define (db-get-rows 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;\")
@@ -47,18 +93,32 @@
(((StrainId . 4) (Name . BXD1)) ((StrainId . 5) (Name . BXD2))...
"
- (let [(row (dbi-get_row db))]
+ (let [(row (dbi-get_row DB))]
(if row
- (db-get-rows db (append list `(,row)))
+ (db-get-rows (append list `(,row)))
list)))
-(define (db-get-rows-apply db func 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 db func (append list `(,(func row))))
+ (db-get-rows-apply func (append list `(,(func row))))
list)))
+
+(define (get-rows-apply db func lst)
+ "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))]
+ (begin
+ (display row)
+ (if row
+ (get-rows-apply db func (append lst `(,(func row))))
+ lst)))
+)
diff --git a/scripts/precompute/precompute-hits.scm b/scripts/precompute/precompute-hits.scm
index cc26a9a..5955fb1 100755
--- a/scripts/precompute/precompute-hits.scm
+++ b/scripts/precompute/precompute-hits.scm
@@ -6,6 +6,7 @@
(use-modules (dbi dbi)
(gn db mysql)
+ (gn data strains)
(rnrs base)
(ice-9 match)
)
@@ -14,22 +15,46 @@
;;
;; mysql -uwebqtlout -pwebqtlout -A -h 127.0.0.1 -P 3306 db_webqtl -e "show tables;"
;;
-(define db (dbi-open "mysql" "webqtlout:webqtlout:db_webqtl:tcp:127.0.0.1:3306"))
-(db-check db)
-(dbi-query db "SELECT * FROM ProbeSetXRef LIMIT 3")
-(db-check db)
-; (display (dbi-get_status db_webqtl))
-(let [(row (dbi-get_row db))]
+
+#!
+(db-query "SELECT * FROM ProbeSetXRef LIMIT 3")
+(db-check)
+(let [(row (db-get-row))]
(display row)
)
+!#
-(dbi-query db "SELECT StrainId,Strain.Name FROM Strain, StrainXRef WHERE StrainXRef.StrainId = Strain.Id AND StrainXRef.InbredSetId = 1 AND Used_for_mapping='Y' ORDER BY StrainId;")
-(db-check db)
-
-(define ids (db-get-rows-apply db (lambda (r) `(,(assoc-ref r "StrainId") . ,(assoc-ref r "Name"))) '()))
+(call-with-db
+ (lambda (db)
+ (begin
+ (dbi-query db "SELECT * FROM ProbeSetXRef LIMIT 3")
+ (let [(row (get-row db))]
+ (display row)
+ )
+ (newline)
+ (dbi-query db "SELECT * FROM ProbeSetXRef LIMIT 3")
+ (let [(row (get-row db))]
+ (display row)
+ )
+ (newline)
+ (dbi-query db "SELECT StrainId,Strain.Name FROM Strain, StrainXRef WHERE StrainXRef.StrainId = Strain.Id AND StrainXRef.InbredSetId = 1 AND Used_for_mapping='Y' ORDER BY StrainId;")
+ (let [(row (get-row db))]
+ (display row)
+ )
+ (let [(result (get-rows-apply db (lambda (r) `(,(assoc-ref r "StrainId") . ,(assoc-ref r "Name"))) '()))]
+ (display (car result)))
-(newline)
-(display (car ids))
-(newline)
-(display (assoc 5 ids))
-(newline)
+ (newline)
+ (display (strain-names))
+ ; (display (car ids))
+ (newline)
+ ; (display (assoc 5 ids))
+ (newline)
+ (newline)
+ (dbi-query db "SELECT * FROM ProbeSetXRef LIMIT 3")
+ (let [(row (get-row db))]
+ (display row)
+ )
+ (db-check2 db)
+ (newline)
+)))