(in-package :panettone.model)
(declaim (optimize (safety 3)))

(defun connect-postgres (&key
                           (host (or (uiop:getenvp "PGHOST") "localhost"))
                           (user (or (uiop:getenvp "PGUSER") "panettone"))
                           (password (or (uiop:getenvp "PGPASSWORD") "password"))
                           (database (or (uiop:getenvp "PGDATABASE") "panettone"))
                           (port (or (integer-env "PGPORT") 5432)))
  "Initialize the global postgresql connection for Panettone"
  (postmodern:connect-toplevel database user password host :port port))

;;;
;;; Schema
;;;

(defclass user-settings ()
  ((user-dn :col-type string :initarg :user-dn :accessor user-dn)
   (enable-email-notifications
    :col-type boolean
    :initarg :enable-email-notifications
    :accessor enable-email-notifications-p
    :initform t
    :col-default t))
  (:metaclass dao-class)
  (:keys user-dn)
  (:table-name user_settings)
  (:documentation
   "Panettone settings for an individual user DN"))

(deftable (user-settings "user_settings")
  (!dao-def))

(defun settings-for-user (dn)
  "Retrieve the settings for the user with the given DN, creating a new row in
  the database if not yet present"
  (or
   (car
    (query-dao
     'user-settings
     (:select '* :from 'user-settings :where (:= 'user-dn dn))))
   (insert-dao (make-instance 'user-settings :user-dn dn))))


(define-constant +issue-statuses+ '(:open :closed)
  :test #'equal)

(deftype issue-status ()
  "Type specifier for the status of an `issue'"
  (cons 'member +issue-statuses+))

(defun ddl/create-issue-status ()
  "Issue DDL to create the `issue-status' type, if it doesn't exist"
  (unless (query (:select (:exists (:select 1
                                    :from 'pg_type
                                    :where (:= 'typname "issue_status"))))
                 :single)
    (query (sql-compile
            `(:create-enum issue-status ,+issue-statuses+)))))

(defclass has-created-at ()
  ((created-at :col-type timestamp
               :col-default (local-time:now)
               :initarg :created-at
               :accessor created-at))
  (:metaclass dao-class))

(defun created-at->timestamp (object)
  (assert (slot-exists-p object 'created-at))
  (unless (or (not (slot-boundp object 'created-at))
              (typep (slot-value object 'created-at) 'local-time:timestamp))
    (setf (slot-value object 'created-at)
          (local-time:universal-to-timestamp (created-at object)))))

(defmethod initialize-instance :after
    ((obj has-created-at) &rest initargs &key &allow-other-keys)
  (declare (ignore initargs))
  (created-at->timestamp obj))

(defclass issue (has-created-at)
  ((id :col-type serial :initarg :id :accessor id)
   (subject :col-type string :initarg :subject :accessor subject)
   (body :col-type string :initarg :body :accessor body :col-default "")
   (author-dn :col-type string :initarg :author-dn :accessor author-dn)
   (comments :type list :accessor issue-comments)
   (events :type list :accessor issue-events)
   (num-comments :type integer :accessor num-comments)
   (status :col-type issue_status
           :initarg :status
           :accessor status
           :initform :open
           :col-default "open"))
  (:metaclass dao-class)
  (:keys id)
  (:table-name issues)
  (:documentation
   "Issues are the primary entity in the Panettone database. An issue is
   reported by a user, has a subject and an optional body, and can be either
   open or closed"))

(defmethod cl-postgres:to-sql-string ((kw (eql :open)))
  (cl-postgres:to-sql-string "open"))
(defmethod cl-postgres:to-sql-string ((kw (eql :closed)))
  (cl-postgres:to-sql-string "closed"))
(defmethod cl-postgres:to-sql-string ((ts local-time:timestamp))
  (cl-postgres:to-sql-string
   (local-time:timestamp-to-unix ts)))

(defmethod initialize-instance :after
    ((issue issue) &rest initargs &key &allow-other-keys)
  (declare (ignore initargs))
  (unless (symbolp (status issue))
    (setf (status issue)
          (intern (string-upcase (status issue))
                  "KEYWORD"))))

(deftable issue (!dao-def))

(defclass issue-comment (has-created-at)
  ((id :col-type integer :col-identity t :initarg :id :accessor id)
   (body :col-type string :initarg :body :accessor body)
   (author-dn :col-type string :initarg :author-dn :accessor author-dn)
   (issue-id :col-type integer :initarg :issue-id :accessor :user-id))
  (:metaclass dao-class)
  (:keys id)
  (:table-name issue_comments)
  (:documentation "Comments on an `issue'"))
(deftable (issue-comment "issue_comments")
  (!dao-def)
  (!foreign 'issues 'issue-id 'id :on-delete :cascade :on-update :cascade))

(defclass issue-event (has-created-at)
  ((id :col-type integer :col-identity t :initarg :id :accessor id)
   (issue-id :col-type integer
             :initarg :issue-id
             :accessor issue-id)
   (acting-user-dn :col-type string
                   :initarg :acting-user-dn
                   :accessor acting-user-dn)
   (field :col-type (or string db-null)
          :initarg :field
          :accessor field)
   (previous-value :col-type (or string db-null)
                   :initarg :previous-value
                   :accessor previous-value)
   (new-value :col-type (or string db-null)
              :initarg :new-value
              :accessor new-value))
  (:metaclass dao-class)
  (:keys id)
  (:table-name issue_events)
  (:documentation "Events that have occurred for an issue.

If a field has been changed on an issue, the SYMBOL-NAME of that slot will be in
FIELD, its previous value will be formatted using ~A into PREVIOUS-VALUE, and
its new value will be formatted using ~A into NEW-VALUE"))

(deftable (issue-event "issue_events")
  (!dao-def)
  (!foreign 'issues 'issue-id 'id :on-delete :cascade :on-update :cascade))

(define-constant +all-tables+
    '(issue
      issue-comment
      issue-event
      user-settings)
  :test #'equal)

(defun ddl/create-tables ()
  "Issue DDL to create all tables, if they don't already exist."
  (dolist (table +all-tables+)
    (unless (table-exists-p (dao-table-name table))
      (create-table table))))

(defun ddl/init ()
  "Idempotently initialize the full database schema for Panettone"
  (ddl/create-issue-status)
  (ddl/create-tables))

;;;
;;; Querying
;;;

(define-condition issue-not-found (error)
  ((id :type integer
       :initarg :id
       :reader not-found-id
       :documentation "ID of the issue that was not found"))
  (:documentation
   "Error condition for when an issue requested by ID is not found"))

(defun get-issue (id)
  "Look up the 'issue with the given ID and return it, or signal a condition of
type `ISSUE-NOT-FOUND'."
  (restart-case
      (or (get-dao 'issue id)
          (error 'issue-not-found :id id))
    (different-id (new-id)
      :report "Use a different issue ID"
      :interactive (lambda ()
                     (format t "Enter a new ID: ")
                     (multiple-value-list (eval (read))))
      (get-issue new-id))))

(defun issue-exists-p (id)
  "Returns `T' if an issue with the given ID exists"
  (query
   (:select (:exists (:select 1
                      :from 'issues
                      :where (:= 'id id))))
   :single))

(defun list-issues (&key status (with '(:num-comments)))
  "Return a list of all issues with the given STATUS (or all if nil), ordered by
  ID descending. If WITH contains `:NUM-COMMENTS' (the default) each issue will
  have the `num-comments' slot filled with the number of comments on that issue
  (to avoid N+1 queries)."
  (let* ((condition (unless (null status)
                      `(:where (:= status $1))))
         (select (if (find :num-comments with)
                     `(:select issues.* (:as (:count issue-comments.id)
                                             num-comments)
                               :from issues
                               :left-join issue-comments
                               :on (:= issues.id issue-comments.issue-id)
                               ,@condition
                               :group-by issues.id)
                     `(:select * :from issues ,@condition)))
         (query (sql-compile
                 `(:order-by ,select (:desc id)))))
    (with-column-writers ('num_comments 'num-comments)
      (query-dao 'issue query status))))

(defmethod num-comments ((issue-id integer))
  "Return the number of comments for the given ISSUE-ID."
  (query
   (:select (:count '*)
    :from 'issue-comments
    :where (:= 'issue-id issue-id))
   :single))

(defmethod slot-unbound (cls (issue issue) (slot (eql 'comments)))
  (declare (ignore cls) (ignore slot))
  (setf (issue-comments issue) (issue-comments (id issue))))

(defmethod issue-comments ((issue-id integer))
  "Return a list of all comments with the given ISSUE-ID, sorted oldest first.
NOTE: This makes a database query, so be wary of N+1 queries"
  (query-dao
   'issue-comment
   (:order-by
    (:select '*
     :from 'issue-comments
     :where (:= 'issue-id issue-id))
    (:asc 'created-at))))

(defmethod slot-unbound (cls (issue issue) (slot (eql 'events)))
  (declare (ignore cls) (ignore slot))
  (setf (issue-events issue) (issue-events (id issue))))

(defmethod issue-events ((issue-id integer))
  "Return a list of all events with the given ISSUE-ID, sorted oldest first.
NOTE: This makes a database query, so be wary of N+1 queries"
  (query-dao
   'issue-event
   (:order-by
    (:select '*
     :from 'issue-events
     :where (:= 'issue-id issue-id))
    (:asc 'created-at))))


;;;
;;; Writing
;;;

(defun record-issue-event
    (issue-id &key
                field
                previous-value
                new-value)
  "Record in the database that the user identified by `AUTHN:*USER*' updated
ISSUE-ID, and return the resulting `ISSUE-EVENT'. If no user is currently
authenticated, warn and no-op"
  (check-type issue-id (integer))
  (check-type field (or null symbol))
  (if authn:*user*
      (insert-dao
       (make-instance 'issue-event
                      :issue-id issue-id
                      :acting-user-dn (authn:dn authn:*user*)
                      :field (symbol-name field)
                      :previous-value (when previous-value
                                        (format nil "~A" previous-value))
                      :new-value (when new-value
                                   (format nil "~A" new-value))))
      (warn "Performing operation as unauthenticated user")))

(defun create-issue (&rest attrs)
  "Insert a new issue into the database with the given ATTRS, which should be
a plist of initforms, and return an instance of `issue'"
  (insert-dao (apply #'make-instance 'issue attrs)))

(defun delete-issue (issue)
  (delete-dao issue))

(defun set-issue-status (issue-id status)
  "Set the status of the issue with the given ISSUE-ID to STATUS in the db. If
the issue doesn't exist, signals `issue-not-found'"
  (check-type issue-id integer)
  (check-type status issue-status)
  (let ((original-status (query (:select 'status
                                 :from 'issues
                                 :where (:= 'id issue-id))
                                :single)))
    (when (zerop (execute (:update 'issues
                           :set 'status (cl-postgres:to-sql-string status)
                           :where (:= 'id issue-id))))
      (error 'issue-not-found :id issue-id))
    (record-issue-event
     issue-id
     :field 'status
     :previous-value (string-upcase original-status)
     :new-value status)
    (values)))

(defun update-issue (issue &rest attrs)
  "Update the fields of ISSUE with the given ATTRS, which is a plist of slot and
value, and record events for the updates"
  (let ((set-fields
          (iter (for slot in '(subject body))
            (for new-value = (getf attrs slot))
            (appending
             (let ((previous-value (slot-value issue slot)))
               (when (and new-value (not (equalp
                                          new-value
                                          previous-value)))
                 (record-issue-event (id issue)
                                     :field slot
                                     :previous-value previous-value
                                     :new-value new-value)
                 (setf (slot-value issue slot) new-value)
                 (list slot new-value)))))))
    (execute
     (sql-compile
      `(:update issues
        :set ,@set-fields
        :where (:= id ,(id issue)))))))

(defun create-issue-comment (&rest attrs &key issue-id &allow-other-keys)
  "Insert a new issue comment into the database with the given ATTRS and
ISSUE-ID, which should be a plist of initforms, and return an instance of
`issue-comment'. If no issue exists with `ID' ISSUE-ID, signals
`issue-not-found'."
  (unless (issue-exists-p issue-id)
    (error 'issue-not-found :id issue-id))
  (insert-dao (apply #'make-instance 'issue-comment :issue-id issue-id attrs)))

(comment
 (connect-postgres)
 (ddl/init)
 (make-instance 'issue :subject "test")
 (create-issue :subject "test"
               :author-dn "cn=glittershark,ou=users,dc=tvl,dc=fyi")
 )