(module (wald sqlite)

(open-connection close-connection call-with-transaction
 query-filters query-species)

(import scheme)
(import (chicken base))
(import (chicken format))
(import (chicken string))
(import (srfi 1))
(import (srfi 69))
(import sql-de-lite)

(define-record connection path config)
(define-record transaction connection)

(define (open-connection path #!optional (config '()))
  (make-connection path config))

(define (call-with-transaction connection proc)
  (call-with-database (connection-path connection) proc))

(define (close-connection connection) #f)

(define select-filters-query
  "SELECT key, value FROM attrs WHERE key <> 'name'")
(define select-filter-query
  "SELECT id FROM attrs WHERE key = ? AND value = ?")

(define (query-filters tx)
  (query fetch-rows (sql tx select-filters-query)))

(define (group-by key-proc items)
  (define (make-cons value)
    (lambda (values)
      (cons value values)))
  (let ((grouped (make-hash-table)))
    (for-each
     (lambda (item)
       (let ((key (key-proc item)))
         (hash-table-update!/default grouped key (make-cons item) '())))
     items)
    (hash-table->alist grouped)))

(define (query-species tx filters)
  (define (placeholders-string n)
    (string-intersperse (make-list n "?") ","))
  (define (filter->id filter)
    (let ((key (car filter))
          (value (cadr filter)))
      (or (query fetch-value (sql tx select-filter-query) key value)
          (error "Invalid filter" filter))))
  (let* ((select-q "SELECT title FROM species WHERE ")
         (cond-q "id IN (SELECT species_id
                           FROM species_attrs
                          WHERE attr_id IN (~a))")
         (grouped (group-by car filters))
         (cond-qs (map (lambda (group)
                         (format cond-q
                                 (placeholders-string (length (cdr group)))))
                       grouped))
         (cond-args (append-map (lambda (group)
                                  (map filter->id (cdr group)))
                                grouped))
         (q (string-append select-q (string-intersperse cond-qs " AND "))))
    (apply query fetch-column (sql tx q) cond-args)))

)