#! 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))) )