#!
  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
            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
  (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)
                     #t
                     (begin
                       (display msg)
                       (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)
  "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 (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))]
    (if 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)))
)