(in-package #:myoji-accent/index)

(defapp index
  :prefix "/"
  :name "苗字アクセント辞典")

(defwidget index-page ()
  ((last-search :initform nil
                :type '(or string null)
                :documentation "The last received query.")
   (myoji-list :initform nil
               :type 'list
               :documentation "List of myoji that where returned by the last
search.")))

(defparameter *pitch-color* "red"
  "The color of pitch accent lines.")

(defmethod reblocks/dependencies:get-dependencies ((widget index-page))
  (append
   (list
    (reblocks-lass:make-dependency
      `(.index-page
        :width "50%"
        :margin auto
        :margin-top "15%"
        (|#page-title|
         :text-align "center"
         :font-size xxx-large
         :margin-bottom "30px")
        (|#search-form|
         :margin auto
         :width "70%"
         :display flex
         (|#query-input|
          :font-size xx-large
          :flex auto)
         (|#submit-button|
          :margin-left "5px"
          :font-size xx-large))
        (|#error-message|
         :margin-top "20px"
         :font-size xx-large
         :text-align center
         :color "red")
        (|#entry-list|
         :margin-top "20px"
         (.myoji-entry
          :font-size xx-large
          :text-align center
          ((:parent (:not :first-child))
           :margin-top "10px")))
        (.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 empty-query-p (query)
  "Return non-nil if QUERY is empty or contains only spaces."
  (null (set-difference (coerce query 'list) '(#\Ideographic_Space #\Space
                                               #\No-break_Space #\Tab)
                        :test 'eql)))

(defmethod handle-search ((widget index-page) &key query)
  (if (empty-query-p query)
      (setf (slot-value widget 'last-search) nil
            (slot-value widget 'myoji-list) nil)
      (let ((myoji-list
              (union (mito:retrieve-dao 'myoji-accent/accent:myoji :kanji query)
                     (mito:retrieve-dao 'myoji-accent/accent:myoji :reading query))))
        (setf (slot-value widget 'last-search) query
              (slot-value widget 'myoji-list) myoji-list)))
  (reblocks/widget:update widget))

(defmethod reblocks/widget:render ((widget index-page))
  (with-slots (last-search myoji-list) widget
    (with-html
      (:div :id "page-title"
            "苗字アクセント辞典")
      (with-html-form (:POST #'(lambda (&key query &allow-other-keys)
                                 (handle-search widget :query query))
                       :id "search-form")
        (:input :id "query-input"
                :type "text"
                :name "query"
                :placeholder "苗字を入力して検索する"
                :value (or (slot-value widget 'last-search) ""))
        (:input :id "submit-button"
                :type "submit"
                :value "検索"))
      (cond
        (myoji-list
         (:div :id "entry-list"
               (dolist (myoji myoji-list)
                 (with-accessors ((kanji myoji-kanji)
                                  (accent-point myoji-accent-point)
                                  (accent-name myoji-accent-name)
                                  (accent-html myoji-accent-html))
                     myoji
                   (:div :class "myoji-entry"
                         (format nil "~a " kanji)
                         (:raw (format nil "&rarr; <span class=accented>~a</span>"
                                       accent-html))
                         (format nil " [~a] (~a)" accent-point accent-name))))))
        (last-search
         (:div :id "error-message"
               "該当する苗字がみつかりませんでした。"))))))

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