From c401f66de2dbcbc41dd9551490563543092de242 Mon Sep 17 00:00:00 2001
From: Pjotr Prins
Date: Fri, 17 Nov 2023 11:09:17 +0100
Subject: First implementation of DB handler

---
 gn/data/strains.scm | 22 +++++++++++++++
 gn/db/mysql.scm     | 78 ++++++++++++++++++++++++++++++++++++++++++++++-------
 2 files changed, 91 insertions(+), 9 deletions(-)
 create mode 100644 gn/data/strains.scm

(limited to 'gn')

diff --git a/gn/data/strains.scm b/gn/data/strains.scm
new file mode 100644
index 0000000..275c4cd
--- /dev/null
+++ b/gn/data/strains.scm
@@ -0,0 +1,22 @@
+(define-module (gn data strains)
+  #: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 (gn db sparql)
+  #:use-module (dbi dbi)
+  #:use-module (gn db mysql)
+  #:use-module (gn data group)
+  #:use-module (web gn-uri)
+
+  #:export (
+            strain-names
+            ))
+
+(define (strain-names)
+  (call-with-db
+   (lambda (db)
+      (dbi-query db "SELECT StrainId,Strain.Name FROM Strain, StrainXRef WHERE StrainXRef.StrainId = Strain.Id AND StrainXRef.InbredSetId = 1 AND Used_for_mapping='Y' ORDER BY StrainId;")
+      (get-rows-apply db (lambda (r) `(,(assoc-ref r "StrainId") . ,(assoc-ref r "Name"))) '()))))
diff --git a/gn/db/mysql.scm b/gn/db/mysql.scm
index f6513af..4c6b35e 100644
--- a/gn/db/mysql.scm
+++ b/gn/db/mysql.scm
@@ -13,13 +13,50 @@
   #: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-check db)
+(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)
@@ -29,16 +66,25 @@
                        (newline)
                        (assert stat))))))
 
-(define (db-display-rows db)
+(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)
+          (get-rows DB)
           )
         #t)))
 
-(define (db-get-rows db list)
+(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;\")
@@ -47,18 +93,32 @@
 
     (((StrainId . 4) (Name . BXD1)) ((StrainId . 5) (Name . BXD2))...
 "
-  (let [(row (dbi-get_row db))]
+  (let [(row (dbi-get_row DB))]
     (if row
-        (db-get-rows db (append list `(,row)))
+        (db-get-rows (append list `(,row)))
         list)))
 
-(define (db-get-rows-apply db func 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 db func (append list `(,(func 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)))
+)
-- 
cgit v1.2.3