#! 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 get-row get-rows get-rows-apply has-result? ensure ;db-open ;db-query ;db-get-row ;db-display-rows ;db-get-rows-apply )) (define (db-open) (begin ;; (display "===> OPENING DB") ;; (newline) (let [(db (dbi-open "mysql" "webqtlout:webqtlout:db_webqtl:tcp:127.0.0.1:3306"))] (ensure db) db ))) (define (call-with-db thunk) (thunk (db-open))) (define (ensure 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 (has-result? db) "Return #t or #f if result is valid" (match (dbi-get_status db) ((stat . msg) (= stat 0)))) (define (get-row db) "Return record and #f is it was the last one" (dbi-get_row db)) (define (get-rows db list) "After running dbi-query we can fetch all rows and return them as a list of records, which is an alist: (dbi-query db \"SELECT StrainId,Strain.Name FROM Strain, StrainXRef WHERE StrainXRef.StrainId = Strain.Id AND StrainXRef.InbredSetId = 1 ORDER BY StrainId;\") (ensure db) (display (get-rows db '())) (((StrainId . 4) (Name . BXD1)) ((StrainId . 5) (Name . BXD2))... " (let [(row (dbi-get_row db))] (if row (get-rows db (append list `(,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))) )