diff options
Diffstat (limited to 'gn/db/mysql.scm')
| -rw-r--r-- | gn/db/mysql.scm | 72 |
1 files changed, 13 insertions, 59 deletions
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))) |