diff options
author | Pjotr Prins | 2023-11-16 10:37:49 +0100 |
---|---|---|
committer | Pjotr Prins | 2023-11-16 10:37:49 +0100 |
commit | 678d976260c6f566166e0459a425d5ef296b002f (patch) | |
tree | 3b14aee7d57a7c27b901627fbcff984abe15468c /gn | |
parent | d0761ae4837e15419bda1faf1b19ee6823335f3f (diff) | |
download | gn-guile-678d976260c6f566166e0459a425d5ef296b002f.tar.gz |
Move procedures into mysql.scm and add documentation
Diffstat (limited to 'gn')
-rw-r--r-- | gn/db/mysql.scm | 39 |
1 files changed, 38 insertions, 1 deletions
diff --git a/gn/db/mysql.scm b/gn/db/mysql.scm index e35cc69..f6513af 100644 --- a/gn/db/mysql.scm +++ b/gn/db/mysql.scm @@ -14,10 +14,13 @@ #:export ( db-check + db-display-rows + db-get-rows + db-get-rows-apply )) (define (db-check db) - "Use DBI-style handle to report an error" + "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 @@ -25,3 +28,37 @@ (display msg) (newline) (assert stat)))))) + +(define (db-display-rows db) + (let [(row (dbi-get_row db))] + (if row + (begin + (display row) + (get-rows db) + ) + #t))) + +(define (db-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;\") + (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 db (append list `(,row))) + list))) + +(define (db-get-rows-apply db 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 db func (append list `(,(func row)))) + list))) |