;;;; entry.lisp

(in-package #:crud-mcclim/database)

(defun string-uuid ()
  (write-to-string (make-v1-uuid)))



(defun list-keywords-parameters (fields)
  "Return list for keywords and list for parameters."
  (loop with keys = nil
        with vals = nil
        for (k v) in fields
        unless (null v)
          do (push k keys)
             (push v vals)
        finally (return (values (reverse keys)
                                (reverse vals)))))



(defun string-insert-fields-values (&rest fields)
  "Return string for fields and string for values."
  (let ((values (make-list (length fields) :initial-element #\?)))
    (values (format nil "(~{~(~a~^, ~)~})" fields)
            (format nil "(~{~a~^, ~})" values))))

(defun format-insert-fields-values-parameters (list-name-value)
  (multiple-value-bind (keywords parameters)
      (list-keywords-parameters list-name-value)
    (multiple-value-bind (fields values)
        (apply #'string-insert-fields-values keywords)
      (values fields values parameters))))

(defun execute-insert (table fields)
  (multiple-value-bind (keys vals parameters)
      (format-insert-fields-values-parameters fields)
    (let ((sql (format nil "insert into ~a ~a values ~a" table keys vals)))
      (with-open-database (db (ensure-db-path) :busy-timeout 5000)
        (push sql parameters) (push db parameters)
        (apply #'execute-non-query parameters)))))



(defun string-update-sets (&rest fields)
  "Return string for fields."
  (format nil "~{~(~a = ?~^, ~)~}" fields))

(defun format-update-sets-where-parameters (list-name-value)
  (multiple-value-bind (keywords parameters)
      (list-keywords-parameters list-name-value)
    (let ((sets (apply #'string-update-sets (cdr keywords)))
          (where (string-update-sets (car keywords))))
      (values sets where (append (cdr parameters) (list (car parameters)))))))

(defun execute-update (table fields)
  (multiple-value-bind (sets where parameters)
      (format-update-sets-where-parameters fields)
    (let ((sql (format nil "update ~a set ~a where ~a" table sets where)))
      (with-open-database (db (ensure-db-path) :busy-timeout 5000)
        (push sql parameters) (push db parameters)
        (apply #'execute-non-query parameters)))))



(defun insert-into-groups (uuid &key name)
  (let ((fields `(("uuid" ,uuid) ("name" ,name))))
    (execute-insert "groups" fields)))

(defun insert-into-criterions (uuid &key group_uuid name code)
  (let ((fields `(("uuid" ,uuid)
                  ("group_uuid" ,group_uuid)
                  ("name" ,name)
                  ("code" ,code))))
    (execute-insert "criterions" fields)))

(defun insert-into-decisions (uuid &key group_uuid name code description)
  (let ((fields `(("uuid" ,uuid)
                  ("group_uuid" ,group_uuid)
                  ("name" ,name)
                  ("code" ,code)
                  ("description" ,description))))
    (execute-insert "decisions" fields)))

(defun insert-into-relations (uuid &key decision_uuid criteria_uuid)
  (let ((fields `(("uuid" ,uuid)
                  ("decision_uuid" ,decision_uuid)
                  ("criteria_uuid" ,criteria_uuid))))
    (execute-insert "relations" fields)))



(defun update-groups (uuid &key name)
  (let ((fields `(("uuid" ,uuid) ("name" ,name))))
    (execute-update "groups" fields)))

(defun update-criterions (uuid &key group_uuid name code)
  (let ((fields `(("uuid" ,uuid)
                  ("group_uuid" ,group_uuid)
                  ("name" ,name)
                  ("code" ,code))))
    (execute-update "criterions" fields)))

(defun update-decisions (uuid &key group_uuid name code description)
  (let ((fields `(("uuid" ,uuid)
                  ("group_uuid" ,group_uuid)
                  ("name" ,name)
                  ("code" ,code)
                  ("description" ,description))))
    (execute-update "decisions" fields)))

(defun update-relations (uuid &key decision_uuid criteria_uuid)
  (let ((fields `(("uuid" ,uuid)
                  ("decision_uuid" ,decision_uuid)
                  ("criteria_uuid" ,criteria_uuid))))
    (execute-update "relations" fields)))



;; TODO