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/data/hits.scm    | 15 +++++++++++
 gn/data/strains.scm |  5 ++--
 gn/db/mysql.scm     | 72 ++++++++++-------------------------------------------
 3 files changed, 31 insertions(+), 61 deletions(-)
 create mode 100644 gn/data/hits.scm

(limited to 'gn')

diff --git a/gn/data/hits.scm b/gn/data/hits.scm
new file mode 100644
index 0000000..91be81f
--- /dev/null
+++ b/gn/data/hits.scm
@@ -0,0 +1,15 @@
+(define-module (gn data hits)
+  #: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 (
+            ))
diff --git a/gn/data/strains.scm b/gn/data/strains.scm
index b3e6744..241ecda 100644
--- a/gn/data/strains.scm
+++ b/gn/data/strains.scm
@@ -17,9 +17,10 @@
             ))
 
 (define* (strain-id-names inbred-set #:key (map? #f))
-  "Return assoc list of tuples of strain id+names, e.g.
-
+  "Return assoc list of tuples of strain id+names:
    ((4 . BXD1) (5 . BXD2) (6 . BXD5) (7 . BXD6)...
+
+map? will say whether the strains/individuals are used for mapping.
 "
   (call-with-db
    (lambda (db)
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