1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
#!
Module for handling SQL DB primitives. Note that GN queries should go into gn/data
!#
(define-module (gn db mysql)
#: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 (rnrs base)
#: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
(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)
#t
(begin
(display msg)
(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)
"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;\")
(db-check db)
(display (db-get-rows db '()))
(((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))]
(if 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)))
)
|
