(in-package :myoji-accent/entry)

(defapp entry
  :prefix "/entry"
  :name "苗字アクセントを入力")

(defparameter *entries-per-page* 2
  "The number of entries to be shown per page.")

(defwidget myoji-list-entry ()
  ((parent :initarg :parent
           :accessor myoji-list-entry-parent
           :documentation "The parent list of this entry.")
   (id :initarg :id
       :type (integer 1)
       :accessor myoji-list-entry-id
       :documentation "The ID of the myoji object for this entry.")
   (myoji :initarg :myoji
          :type myoji
          :accessor myoji-list-entry-myoji
          :documentation "The myoji object for this entry.")
   (edit-mode :initform nil
              :type boolean
              :accessor myoji-list-entry-edit-mode-p
              :documentation "Weather we are in edit mode or not.")
   (err-msg :initform nil
            :type (or null string)
            :accessor myoji-list-entry-error
            :documentation "An error message to show to the user.")))

(define-condition accent-error (error)
  ((message :initarg :message
            :accessor accent-error-message
            :type string
            :documentation "A description of what went wrong."))
  (:report
   (lambda (err stream)
     (format stream "~a" (accent-error-message err)))))

(defmethod update-db-entry ((widget myoji-list-entry) new-kanji new-reading
                            new-accent)
  "Update the entry WIDGET with some new values provided by the user."
  (handler-case
      (progn
        (setf (slot-value widget 'edit-mode) nil)
        (let ((obj))
          (handler-case
              (let ((accent-point (parse-integer new-accent)))
                (when (> accent-point (count-word-mora new-reading))
                  (signal
                   'accent-error
                   :message
                   (format nil "Accent point too bit for word: ~a" new-accent)))
                (setq obj (make-myoji new-reading new-kanji
                                      :accent-point accent-point)))
            (parse-error ()
              (if (valid-accent-string-p new-accent)
                  (setq obj (make-myoji new-reading new-kanji
                                        :accent-string new-accent))
                  (signal
                   'accent-error
                   :message
                   (format nil "Not a valid accent string or number: ~a" new-accent)))))
          (mito:insert-dao obj)
          (mito:delete-dao (myoji-list-entry-myoji widget))))
    (accent-error (e)
      (setf (slot-value widget 'err-msg) (format nil "~a" e)))
    (error ()
      (setf (slot-value widget 'err-msg) "An internal error occured.")))
  (reblocks/widget:update widget))

(defmethod reblocks/widget:render ((widget myoji-list-entry))
  (with-slots (myoji edit-mode err-msg) widget
    (with-html
      (if (or edit-mode err-msg)
          (with-html-form (:POST #'(lambda (&key kanji reading accent
                                            &allow-other-keys)
                                     (update-db-entry widget kanji reading accent)))
            (:tr
             (:td (:input :type "text"
                          :name "kanji"
                          :value (myoji-kanji myoji)))
             (:td (:input :type "text"
                          :name "reading"
                          :value (myoji-reading myoji)))
             (:td :class "accented"
                  (:raw (myoji-accent-html myoji)))
             (:td (:input :type "text"
                          :name "accent"
                          :value (myoji-accent-point myoji)))
             (:td (myoji-accent-name myoji))
             (:td (:input :type "submit"
                          :value "編集")
                  (:button "削除")
                  (when err-msg
                    (:br)
                    (:p :class "insert-error"
                        err-msg)))))
          (:tr
           (:td (myoji-kanji myoji))
           (:td (myoji-reading myoji))
           (:td :class "accented"
                (:raw (myoji-accent-html myoji)))
           (:td (myoji-accent-point myoji))
           (:td (myoji-accent-name myoji))
           (:td
            (:button :onclick
                     (when (boundp 'reblocks/page::*current-page*)
                       (reblocks/actions:make-js-action
                        (lambda (&key &allow-other-keys)
                          (setf (slot-value widget 'edit-mode) t)
                          (reblocks/widget:update (myoji-list-entry-parent widget)))))
                     "編集")
            (:button :onclick
                     (when (boundp 'reblocks/page::*current-page*)
                       (reblocks/actions:make-js-action
                        (lambda (&key &allow-other-keys)
                          ())))
                     "削除")))))))

(defwidget myoji-list ()
  ((page-num :initform 0
             :type '(integer 0)
             :accessor entry-page-page-num
             :documentation "The index of the displayed page.")
   (last-low-id :initform 0
                :type '(integer  0)
                :accessor entry-page-last-low-id
                :documentation "The lowest ID from the last SQL query.")
   (last-high-id :initform 0
                 :type '(integer 0)
                 :accessor entry-page-last-high-id
                 :documentation "The highest ID from the last SQL query.")
   (page-entries :initform nil
                 :type 'list
                 :accessor entry-page-page-entries
                 :documentation "The myoji entries for the current page.")))

(defmethod initialize-instance :after
    ((widget myoji-list) &key &allow-other-keys)
  ;; get the first page
  (next-page widget))

(defmethod reblocks/dependencies:get-dependencies ((widget myoji-list))
  (append
   (list
    (reblocks-lass:make-dependency
      `(.myoji-list
        :margin-left auto
        :margin-right auto
        :width "90%"
        :border "1px" "black" solid
        (table
         :width "100%"
         :height "100%"
         :font-size larger
         :border-collapse collapse
         :border "1px" "black" solid
         ((:or th td)
          :border "1px" "black" solid)
         ((:or th td)
          :padding "5px"))
        (|#selector-wrapper|
         :width "100%"
         :display flex
         :justify-content center
         (span
          :margin-left "5px"
          :margin-right "5px")))))
   (call-next-method)))

(defmethod has-next-page-p ((widget myoji-list))
  "Return non-nil if WIDGET can be paged forward."
  (with-slots (page-num page-entries last-high-id) widget
    (or (zerop page-num)
        (and (= (length page-entries) *entries-per-page*)
             (mito:retrieve-by-sql
              (sxql:select (:myoji.*)
                (sxql:from :myoji)
                (sxql:where (:> :id last-high-id))))))))

(defmethod has-previous-page-p ((widget myoji-list))
  "Return non-nil if WIDGET can be paged back."
  (> (slot-value widget 'page-num) 1))

(defmethod reblocks/widget:render ((widget myoji-list))
  (with-slots (page-num page-entries) widget
    (with-html
      (:table
       (:tr (dolist (header '("漢字" "読み方" "アクセント" "アクセントポイント"
                              "タイプ" ""))
              (:th header)))
       (dolist (entry page-entries)
         (reblocks/widget:render entry)))
      (:div :id "selector-wrapper"
            (when (boundp 'reblocks/page::*current-page*)
              (if (has-previous-page-p widget)
                  (:button :onclick (reblocks/actions:make-js-action
                                     (lambda (&key &allow-other-keys)
                                       (next-page widget :previous t)))
                           "<")
                  (:button :disabled "disabled"
                           "<"))
              (:span (format nil "~a" page-num))
              (if (has-next-page-p widget)
                  (:button :onclick (reblocks/actions:make-js-action
                                     (lambda (&key &allow-other-keys)
                                       (next-page widget)))
                           ">")
                  (:button :disabled "disabled"
                           ">")))))))

(defmethod update-page-from-query-results ((widget myoji-list) results)
  "Update the content of the current page of WIDGET with the RESULTS, which are
SQL query results."
  (with-slots (page-num last-low-id last-high-id page-entries) widget
    (loop for entry in results
          for id = (getf entry :id)
          maximize id into new-high
          minimize id into new-low
          collect
          (make-instance 'myoji-list-entry
                         :parent widget
                         :id id
                         :myoji (apply #'mito:make-dao-instance
                                       'myoji-accent/accent:myoji
                                       entry))
            into entry-objects
          finally
             (setf last-low-id new-low
                   last-high-id new-high
                   page-entries entry-objects))))

(defmethod reload-page ((widget myoji-list))
  "Reload the current page for WIDGET."
  (with-slots (last-low-id last-high-id) widget
    (update-page-from-query-results
     widget
     (mito:retrieve-by-sql
      (sxql:select (:myoji.*)
        (sxql:from :myoji)
        (sxql:where (:>= :id last-low-id))
        (sxql:order-by (:asc :id))
        (sxql:limit *entries-per-page*))))
    (reblocks/widget:update widget)))

(defmethod next-page ((widget myoji-list) &key previous)
  "Display the next page for WIDGET."
  (if (or (and (has-next-page-p widget) (not previous))
          (and (has-previous-page-p widget) previous))
      (with-slots (page-num last-low-id last-high-id) widget
        (update-page-from-query-results
         widget
         (mito:retrieve-by-sql
          (sxql:select (:myoji.*)
            (sxql:from :myoji)
            (if previous
                (sxql:where (:< :id last-low-id))
                (sxql:where (:> :id last-high-id)))
            (if previous
                (sxql:order-by (:desc :id))
                (sxql:order-by (:asc :id)))
            (sxql:limit *entries-per-page*))))
        (setf page-num (if previous (1- page-num) (1+ page-num)))
        (reblocks/widget:update widget))))

(defwidget entry-page ()
  ((list :initform (make-instance 'myoji-list)
         :type 'myoji-list
         :documentation "The list of already existing entries.")))

(defmethod reblocks/dependencies:get-dependencies ((widget entry-page))
  (append
   (list
    (reblocks-lass:make-dependency
      `(.entry-page
        :width "100%"
        (|#add-form|
         :margin-top "20px"
         :display "flex"
         :justify-content center
         ((:or (:and span (:not :first-of-type)) |#submit-button|)
          :margin-left "10px")
         (span
          :margin-right "5px"))
        (.accented
         (span.tone-h
          :border-top "1px" solid ,*pitch-color*)
         (span.tone-l
          :border-bottom "1px" solid ,*pitch-color*)
         (span.tone-h-change
          :border solid ,*pitch-color*
          :border-width "1px" "1px" "0px" "0px")
         (span.tone-l-change
          :border solid ,*pitch-color*
          :border-width "0px" "1px" "1px" "0px")
         (span.tone-end-change
          :border-right "1px")))))
   (call-next-method)))

(defun string-integer-p (str)
  "Return non-nil if STR is all digits."
  (every #'digit-char-p str))

(defmethod handle-add-myoji ((widget entry-page) reading kanji accent)
  "Add a new myoji to the database."
  (let ((mora (count-word-mora reading)))
    (cond
      ((string-integer-p accent)
       (mito:insert-dao (make-myoji reading kanji
                                    :accent-point (parse-integer accent))))
      ((valid-accent-string-p accent mora)
       (mito:insert-dao (make-myoji reading kanji
                                    :accent-string accent)))
      (t ;; TODO error
       ))
    (reblocks/widget:update widget)))

(defmethod reblocks/widget:render ((widget entry-page))
  (with-html
    (reblocks/widget:render (slot-value widget 'list))
    (with-html-form (:POST #'(lambda (&key reading kanji accent
                                      &allow-other-keys)
                               (handle-add-myoji widget reading kanji accent))
                     :id "add-form")
      (:span "読み方：")
      (:input :type "text"
              :name "reading")
      (:span "漢字：")
      (:input :type "text"
              :name "kanji")
      (:span "アクセント：")
      (:input :type "text"
              :name "accent")
      (:input :id "submit-button"
              :type "submit"
              :value "追加"))))

(defmethod reblocks/page:init-page ((app entry) (url-path string) expire-at)
  (declare (ignorable url-path expire-at))
  (setf (reblocks/page:get-title) "苗字アクセントを入力")
  (make-instance 'entry-page))