#lang racket/base

(require racket/contract
         racket/serialize
         racket/port
         db
         )

(provide ks-open
         ks-set!
         ks-get
         ks-drop!
         ks-exists?
         ks-keys
         ks-keys-glob
         ks-key-values-glob
         ks-key-values
         ks-key-values-raw
         ks-keys-raw
         )

(define-struct keystore
  (file path dbh)
  #:transparent
  )

(define/contract (ks-open file)
  (-> (or/c path? string? symbol?) keystore?)
  (let ((path (if (symbol? file)
                  (build-path (find-system-path 'cache-dir) (format "ks-~a.db" file))
                  (build-path file))))
    (let ((dbh (sqlite3-connect #:database path #:mode 'create)))
      (query-exec dbh "CREATE TABLE IF NOT EXISTS keystore(key varchar primary key, value varchar, str_key varchar);")
      (query-exec dbh "CREATE INDEX IF NOT EXISTS keystore_idx on keystore(str_key);")
      (make-keystore file path dbh))))

(define/contract (ks-set! ksh key value)
  (-> keystore? any/c any/c boolean?)
   (ks-set!* (keystore-dbh ksh) (value->string key) (format "~a" key) (value->string value)))

(define/contract (ks-exists? ksh key)
  (-> keystore? any/c boolean?)
  (ks-exists?* (keystore-dbh ksh) (value->string key)))

(define/contract (ks-get ksh key . default-value)
  (-> keystore? any/c ... any/c any/c)
  (ks-get* (keystore-dbh ksh) (value->string key) default-value))

(define/contract (ks-drop! ksh key)
  (-> keystore? any/c boolean?)
  (ks-drop!* (keystore-dbh ksh) (value->string key)))

(define/contract (ks-key-values-glob ksh gl)
  (-> keystore? string? list?)
  (map (λ (row)
         (cons (string->value (vector-ref row 0)) (string->value (vector-ref row 1))))
       (query-rows (keystore-dbh ksh)
                   "SELECT key, value FROM keystore WHERE str_key GLOB $1"
                   (string-downcase gl))))

(define/contract (ks-keys-glob ksh sqlite-like)
  (-> keystore? string? list?)
  (map (λ (row)
         (string->value (vector-ref row 0)))
       (query-rows (keystore-dbh ksh)
                   "SELECT key FROM keystore WHERE str_key GLOB $1"
                   (string-downcase sqlite-like))))

(define/contract (ks-keys ksh)
  (-> keystore? list?)
  (ks-keys* (keystore-dbh ksh)))

(define/contract (ks-key-values ksh)
  (-> keystore? list?)
  (ks-key-values* (keystore-dbh ksh)))

(define/contract (ks-keys-raw ksh)
  (-> keystore? list?)
  (map vector->list 
       (query-rows (keystore-dbh ksh) "SELECT key, str_key FROM keystore")))

(define/contract (ks-key-values-raw ksh)
  (-> keystore? list?)
  (map vector->list 
       (query-rows (keystore-dbh ksh) "SELECT key, str_key, value FROM keystore")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal working
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define (ks-set!* dbh key str-key value)
  (query-exec dbh "INSERT OR REPLACE INTO keystore VALUES($1, $2, $3)"
              key value (string-downcase str-key))
  #t)

(define (ks-exists?* dbh key)
  (> (query-value dbh "SELECT COUNT(*) FROM keystore WHERE key = $1" key) 0))

(define (ks-get* dbh key default-value)
  (if (ks-exists?* dbh key)
      (string->value (query-value dbh "SELECT value FROM keystore WHERE key = $1" key))
      (if (null? default-value)
          'ks-nil
          (car default-value))
      )
  )

(define (ks-drop!* dbh key)
  (query-exec dbh "DELETE FROM keystore WHERE key = $1" key)
  #t)

(define (ks-keys* dbh)
  (map (λ (row)
         (string->value (vector-ref row 0)))
       (query-rows dbh "SELECT key FROM keystore")))

(define (ks-key-values* dbh)
  (map (λ (row)
         (cons (string->value (vector-ref row 0))
               (string->value (vector-ref row 1))))
       (query-rows dbh "SELECT key, value FROM keystore")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; serialization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (value->string v)
  (call-with-output-string
   (λ (out) (write (serialize v) out))))

(define (string->value v)
  (deserialize
   (call-with-input-string v (λ (in) (read in)))))