From 06f941636a99904671c89916e17f28de4b2cd07e Mon Sep 17 00:00:00 2001
From: Pjotr Prins
Date: Sat, 18 Nov 2023 11:33:24 +0100
Subject: Reorganize DB handler and fetch first dataset

---
 gn/db/mysql.scm | 72 +++++++++++----------------------------------------------
 1 file changed, 13 insertions(+), 59 deletions(-)

(limited to 'gn/db/mysql.scm')

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)))
-- 
cgit v1.2.3