(module (wald nstore)

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

(import scheme)
(import (chicken base))
(import (chicken condition))
(import (srfi 1))
(import (srfi 69))
(import (srfi 146 hash))
(import (srfi 158))
(import (srfi 167 engine))
(import (only (srfi 167 lmdb) make-default-engine make-default-state))
(import (srfi 168))

(define-record connection path config store db)
(define-record transaction connection tx)

(define engine (make-default-engine))

(define (open-connection path #!optional (config '()))
  (let* ((store (nstore engine '(0) '(subject predicate object)))
         (read-only? (alist-ref 'read-only? config))
         (options `((no-subdirectory? . #t)
                    (read-only? . ,read-only?)))
         (db (engine-open engine path options)))
    (make-connection path config store db)))

(define (call-with-transaction connection proc)
  (let* ((config (connection-config connection))
         (read-only? (alist-ref 'read-only? config))
         (options `((read-only? . ,read-only?)))
         (store (connection-store connection))
         (db (connection-db connection))
         (state make-default-state))
    (engine-in-transaction engine db
                           (lambda (tx)
                             (proc (make-transaction connection tx)))
                           signal values state options)))

(define (close-connection connection)
  (engine-close engine (connection-db connection)))

;; https://hyper.dev/blog/sparql-to-nstore.html
(define (query-filters tx)
  (let ((ht (make-hash-table)))
    (generator-for-each
     (lambda (x)
       (let ((key (hashmap-ref x 'key))
             (value (hashmap-ref x 'value)))
         (when (not (memv key '(name title)))
           (hash-table-set! ht (cons key value) #t))))
     (let ((store (connection-store (transaction-connection tx)))
           (tx (transaction-tx tx)))
       (nstore-from tx store
                    (list (nstore-var 'id)
                          (nstore-var 'key)
                          (nstore-var 'value)))))
    (map (lambda (item)
           (let ((kv (car item)))
             (list (symbol->string (car kv)) (cdr kv))))
         (hash-table->alist ht))))

(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)
  (let ((grouped (group-by car filters))
        (ht (make-hash-table)))
    (generator-for-each
     (lambda (mapping)
       (let ((key (hashmap-ref mapping 'key))
             (value (hashmap-ref mapping 'value))
             (id (hashmap-ref mapping 'id)))
         (hash-table-update! ht
                             id
                             (lambda (l) (cons (cons key value) l))
                             list)))
     (let ((store (connection-store (transaction-connection tx)))
           (tx (transaction-tx tx)))
       (nstore-from tx store
                    (list (nstore-var 'id)
                          (nstore-var 'key)
                          (nstore-var 'value)))))
    (hash-table-fold
     ht
     (lambda (id meta knil)
       (if (every (lambda (group)
                    (let* ((key (string->symbol (car group)))
                           (values (map cadr (cdr group)))
                           (match (filter-map (lambda (item)
                                                (and (eqv? (car item) key)
                                                     (cdr item)))
                                              meta)))
                      (and match
                           (any (lambda (value)
                                  (member value values))
                                match))))
                  grouped)
           (cons (alist-ref 'title meta) knil)
           knil))
     '())))

)