(in-package :client-main-window)

(named-readtables:in-readtable nodgui.syntax:nodgui-syntax)

(defclass gemini-stream ()
  ((server-stream-handle
    :initform nil
    :initarg :server-stream-handle
    :accessor server-stream-handle)
   (status
    :initform :streaming
    :initarg :status
    :accessor status)
   (status-lock
    :initform (bt:make-lock)
    :reader status-lock)
   (fetching-thread
    :initform nil
    :initarg :fetching-thread
    :accessor fetching-thread)))

(defgeneric status (object))

(defmethod status ((object gemini-stream))
  (misc:with-lock ((status-lock object))
    (slot-value object 'status)))

(defmethod (setf status) ((object gemini-stream) val)
  (misc:with-lock ((status-lock object))
    (setf (slot-value object 'status) val)
    val))

(defparameter *gemini-streams-db* ())

(defun push-db-stream (stream-object)
  (pushnew stream-object
           *gemini-streams-db*
           :test (lambda (a b)
                   (string= (server-stream-handle a)
                            (server-stream-handle b))))
  *gemini-streams-db*)

(defun remove-db-stream (stream-object)
  (setf *gemini-streams-db*
        (remove stream-object *gemini-streams-db*))
  *gemini-streams-db*)


(defmethod abort-downloading ((object gemini-stream))
  (setf (status object) :canceled))

(defun remove-all-db-stream ()
  (map nil
       (lambda (a) (abort-downloading a))
       *gemini-streams-db*)
  (setf *gemini-streams-db* ())
  *gemini-streams-db*)

(defun find-db-stream-if (predicate)
  (find-if predicate *gemini-streams-db*))

(defun find-db-stream-url (url)
  (find-db-stream-if (lambda (a) (string= (server-stream-handle a) url))))

(defun notify-request-error (message)
  (gui-goodies:error-dialog gui-goodies:*toplevel* message))

(defmacro with-notify-errors (&body body)
  `(handler-case
       (progn ,@body)
     (comm:rpc-error-response (e)
       #+debug-mode (misc:dbg "backend comunication RPC error ~a" e)
       (notify-request-error (format nil
                                     (_ "~a: ~a")
                                     (comm:code e)
                                     (conditions:text e))))
     (error (e)
       #+debug-mode (misc:dbg "backend comunication error ~a" e)
       (notify-request-error e))))

(defun enqueue-request-notify-error (method-name id &rest args)
  (ev:with-enqueued-process-and-unblock ()
    (with-notify-errors
      (apply #'comm:make-request method-name id args))))

(defun slurp-gemini-stream (iri &key
                                  (use-cache t)
                                  (process-function  #'identity)
                                  (aborting-function (constantly nil)))
  (enqueue-request-notify-error :gemini-request 1 iri use-cache)
  (labels ((stream-exausted-p ()
             (let ((status-completed (enqueue-request-notify-error :gemini-stream-completed-p
                                                                   1
                                                                   iri)))

               status-completed))
           (loop-fetch (&optional (last-lines-fetched-count 0))
             (when (not (or (funcall aborting-function)
                            (stream-exausted-p)))
               (ev:with-enqueued-process-and-unblock ()
                 (with-notify-errors
                   (let* ((last-lines-fetched (comm:make-request :gemini-stream-parsed-line-slice
                                                                 1
                                                                 iri
                                                                 last-lines-fetched-count
                                                                 nil))
                          (next-start-fetching (length last-lines-fetched)))
                     (when last-lines-fetched
                       (funcall process-function last-lines-fetched))
                     (loop-fetch (+ last-lines-fetched-count
                                    next-start-fetching))))))))
    (loop-fetch)))

(defun start-streaming-thread (iri &key
                                     (use-cache           t)
                                     (process-function    #'identity)
                                     (status :streaming))
  (when (not (find-db-stream-url iri))
    (let ((stream-wrapper (make-instance 'gemini-stream
                                         :server-stream-handle iri
                                         :status               status)))
      (flet ((aborting-function ()
               (eq (status stream-wrapper) :canceled)))
        (let ((stream-thread (bt:make-thread (lambda ()
                                               (slurp-gemini-stream iri
                                                                    :use-cache use-cache
                                                                    :process-function
                                                                    process-function
                                                                    :aborting-function
                                                                    #'aborting-function)))))
          (setf (fetching-thread stream-wrapper) stream-thread)
          (push-db-stream stream-wrapper))))))

(defun initialize-menu (parent)
  (with-accessors ((main-window main-window)) parent
    (let* ((bar        (gui:make-menubar parent))
           (file       (gui:make-menu bar   (_ "File") :underline 0))
           (help       (gui:make-menu bar   (_ "Help") :underline 0)))
      (gui:make-menubutton file (_ "Quit")  #'menu:quit       :underline 0)
      (gui:make-menubutton help (_ "About") #'menu:help-about :underline 0))))

(defclass tool-bar (gui:frame)
  ((iri-entry
    :initform nil
    :initarg  :iri-entry
    :accessor iri-entry)
   (back-button
    :initform nil
    :initarg  :back-button
    :accessor back-button)
   (reload-button
    :initform nil
    :initarg  :reload-button
    :accessor reload-button)
   (up-button
    :initform nil
    :initarg  :up-button
    :accessor up-button)
   (go-button
    :initform nil
    :initarg  :go-button
    :accessor go-button)))

(defun autocomplete-iri-clsr (toolbar)
  (declare (ignore toolbar))
  (lambda (hint)
    (if (> (length hint) 2)
        (with-notify-errors
          (let ((match-results (cev:enqueue-request-and-wait-results :complete-net-address
                                                                     1
                                                                     ev:+maximum-event-priority+
                                                                     hint)))
            (values (getf match-results :matches)
                    (getf match-results :indices))))
        hint)))

(defmacro gen-ir-access (key)
  `(defun ,(misc:format-fn-symbol t "ir-~a" key) (line)
     (getf line ,(a:make-keyword key))))

(gen-ir-access type)

(gen-ir-access source-id)

(gen-ir-access header-group-id)

(gen-ir-access source-line)

(gen-ir-access line)

(gen-ir-access href)

(defun collect-ir-lines (main-window lines)
  (with-accessors ((ir-lines ir-lines)
                   (ir-rendered-lines ir-rendered-lines)
                   (gemtext-widget gemtext-widget)) main-window
    (labels ((push-prefixed (prefix ir)
               (let ((raw-line (format nil "~a~a" prefix (ir-line ir))))
                 (vector-push-extend raw-line ir-rendered-lines)))
             (linkify (line)
               (let* ((link-value    (ir-href line))
                      (link-name     (or (ir-line line)
                                         link-value))
                      (prefix-gemini (gui-conf:gemini-link-prefix-to-gemini))
                      (prefix-www    (gui-conf:gemini-link-prefix-to-http))
                      (prefix-other  (gui-conf:gemini-link-prefix-to-other))
                      (link-text     (if (text-utils:starting-emoji link-name)
                                         (format nil
                                                 "~a~a"
                                                 (trim-blanks prefix-other)
                                                 link-name)
                                         (cond
                                           ((gemini-parser::gemini-link-iri-p link-value)
                                            (format nil "~a~a" prefix-gemini link-name))
                                           ((html-utils::http-link-iri-p link-value)
                                            (format nil "~a~a" prefix-www link-name))
                                           (t
                                            (format nil "~a~a" prefix-other link-name))))))
                 (vector-push-extend link-text ir-rendered-lines)))
             (render-line (text)
               (gui:append-line gemtext-widget text)))
      (let ((link-font (gui-conf:gemini-link-font-configuration)))
        (multiple-value-bind (link-bg link-fg)
            (gui-conf:gemini-link-colors)
          (loop for line in lines do
            (vector-push-extend line ir-lines)
            (let ((type (ir-type line)))
              (ecase (format-keyword type)
                (:vertical-space
                 (vector-push-extend (format nil "") ir-rendered-lines)
                 (render-line (a:last-elt ir-rendered-lines)))
                (:as-is
                 (vector-push-extend (ir-line line) ir-rendered-lines)
                 (render-line (a:last-elt ir-rendered-lines)))
                (:text
                 (vector-push-extend (ir-line line) ir-rendered-lines)
                 (render-line (a:last-elt ir-rendered-lines)))
                (:h1
                 (push-prefixed (gui-conf:gemini-h1-prefix) line)
                 (render-line (a:last-elt ir-rendered-lines)))
                (:h2
                 (push-prefixed (gui-conf:gemini-h1-prefix) line)
                 (render-line (a:last-elt ir-rendered-lines)))
                (:h3
                 (push-prefixed (gui-conf:gemini-h1-prefix) line)
                 (render-line (a:last-elt ir-rendered-lines)))
                (:li
                 (push-prefixed (gui-conf:gemini-bullet-prefix) line)
                 (render-line (a:last-elt ir-rendered-lines)))
                (:quote
                 (push-prefixed (gui-conf:gemini-quote-prefix) line)
                 (render-line (a:last-elt ir-rendered-lines)))
                (:pre
                 (vector-push-extend (format nil "") ir-rendered-lines)
                 (render-line (a:last-elt ir-rendered-lines)))
                (:pre-end
                 (vector-push-extend (format nil "") ir-rendered-lines)
                 (render-line (a:last-elt ir-rendered-lines)))
                (:a
                 (linkify line)
                 (gui:append-text gemtext-widget (a:last-elt ir-rendered-lines))
                 (gui:move-cursor-to-last-line gemtext-widget)
                 (gui:make-link-button gemtext-widget
                                       (gui:raw-coordinates gemtext-widget)
                                       (gui:make-indices-end)
                                       link-font
                                       link-fg
                                       link-bg
                                       (lambda () t))
                 (gui:append-line gemtext-widget ""))))))))))

(defun displace-gemini-response (response)
  (values (getf response :status)
          (getf response :status-description)
          (getf response :meta)
          (getf response :cached)
          (getf response :iri)))

(defun start-stream-iri-clsr (main-window use-cache &optional (status :streaming))
  (lambda ()
    (with-accessors ((tool-bar tool-bar)) main-window
      (with-accessors ((iri-entry iri-entry)) tool-bar
        (let* ((iri                 (trim-blanks (gui:text iri-entry)))
               (connecting-response (cev:enqueue-request-and-wait-results :gemini-request
                                                                          1
                                                                          ev:+maximum-event-priority+
                                                                          iri
                                                                          use-cache)))
          (multiple-value-bind  (status-code
                                 status-description
                                 meta
                                 cached
                                 original-iri)
              (displace-gemini-response connecting-response)
            (cond
              ((gemini-client:header-success-p status-code)
               (start-streaming-thread iri
                                       :use-cache        nil
                                       :process-function (lambda (lines)
                                                           (collect-ir-lines main-window lines)
                                                           (misc:dbg "lines ~a" lines))
                                       :status           status)))))))))

(defun setup-main-window-events (main-window)
  (with-accessors ((tool-bar tool-bar)) main-window
    (with-accessors ((iri-entry     iri-entry)
                     (back-button   back-button)
                     (reload-button reload-button)
                     (up-button     up-button)
                     (go-button     go-button)) tool-bar
      (let ((entry-autocomplete (gui-mw:autocomplete-entry-widget iri-entry)))
        (gui:bind entry-autocomplete
                  #$<KeyPress-Return>$
                  (lambda (e)
                    (declare (ignore e))
                    (funcall (start-stream-iri-clsr main-window t)))
                  :append nil))
      (setf (gui:command go-button) (start-stream-iri-clsr main-window t)))))

(defmethod initialize-instance :after ((object tool-bar) &key &allow-other-keys)
  (with-accessors ((iri-entry     iri-entry)
                   (back-button   back-button)
                   (reload-button reload-button)
                   (up-button     up-button)
                   (go-button     go-button)) object
    (gui:configure object :relief :raised)
    (setf iri-entry (make-instance 'gui-mw:autocomplete-entry
                                   :master                object
                                   :autocomplete-function (autocomplete-iri-clsr object)))
    (setf back-button   (make-instance 'gui:button :master object :image icons:*back*))
    (setf reload-button (make-instance 'gui:button :master object :image icons:*refresh*))
    (setf go-button     (make-instance 'gui:button :master object :image icons:*open-iri*))
    (setf up-button     (make-instance 'gui:button :master object :image icons:*up*))
    (gui-goodies:attach-tooltips (back-button   (_ "go back"))
                                 (reload-button (_ "reload address"))
                                 (go-button     (_ "go to address"))
                                 (up-button     (_ "one level up")))
    (gui:grid back-button   0 1 :sticky :nsw)
    (gui:grid iri-entry     0 2 :sticky :we :padx +minimum-padding+)
    (gui:grid go-button     0 3 :sticky :e)
    (gui:grid reload-button 0 4 :sticky :e)
    (gui:grid up-button     0 5 :sticky :e)
    (gui:grid-columnconfigure object 2 :weight 2)
    object))

(defclass toc-frame (gui:frame)
  ((toc-listbox
    :initform nil
    :initarg :toc-listbox
    :accessor toc-listbox)
   (toc-data
    :initform nil
    :initarg :toc-data
    :accessor toc-data)))

(defmethod initialize-instance :after ((object toc-frame) &key &allow-other-keys)
  (with-accessors ((toc-listbox toc-listbox)
                   (toc-data    toc-data)) object
    (setf toc-listbox (make-instance 'gui:scrolled-listbox
                                     :master object
                                     :name   nil))
    (gui:grid toc-listbox 0 0
              :sticky :nswe
              :ipadx  +minimum-padding+
              :ipady  +minimum-padding+)
    (gui-goodies:gui-resize-grid-all object)
    ))


(defclass main-frame (gui:frame)
  ((main-window
    :initform nil
    :initarg :main-window
    :accessor main-window)
   (gemtext-widget
    :initform nil
    :initarg :gemtext-widget
    :accessor gemtext-widget)
   (tool-bar
    :initform nil
    :initarg  :tool-bar
    :accessor tool-bar)
   (toc-frame
    :initform nil
    :initarg  :toc-frame
    :accessor toc-frame)
   (info-frame
    :initform nil
    :initarg  :info-frame
    :accessor info-frame)
   (info-text
    :initform nil
    :initarg  :info-text
    :accessor info-text)
   (ir-rendered-lines
    :initform (misc:make-fresh-array 0)
    :initarg  :ir-rendered-lines
    :accessor ir-rendered-lines)
   (ir-lines
    :initform (misc:make-fresh-array 0)
    :initarg  :ir-lines
    :accessor ir-lines)))

(defmethod initialize-instance :after ((object main-frame) &key &allow-other-keys)
  (with-accessors ((main-window    main-window)
                   (tool-bar       tool-bar)
                   (toc-frame      toc-frame)
                   (info-frame     info-frame)
                   (info-text      info-text)
                   (gemtext-widget gemtext-widget)) object
    (setf tool-bar  (make-instance 'tool-bar :master object))
    (setf toc-frame (make-instance 'toc-frame :master object))
    (setf gemtext-widget (make-instance 'gui:scrolled-text :master object :read-only t))
    (gui:configure gemtext-widget :wrap :word)
    (setf info-frame (make-instance 'gui:frame :master object :relief :sunken :borderwidth 1))
    (setf info-text (make-instance 'gui:text :height 1 :wrap :none :master info-frame))
    (gui:configure info-text :font gui:+tk-small-caption-font+)
    (gui:grid info-text 0 0 :sticky :news)
    (gui-goodies:gui-resize-grid-all info-frame)
    (gui:grid tool-bar  0 0 :sticky :new :columnspan 2)
    (gui:grid toc-frame 1 0 :sticky :nsw)
    (gui:grid gemtext-widget 1 1 :sticky :news)
    (gui:grid info-frame     3 0 :sticky :news :columnspan 2)
    (gui:grid-columnconfigure object 1 :weight 1)
    (gui:grid-rowconfigure    object 1 :weight 1)
    (setup-main-window-events object)
    (gui:focus (nodgui.mw:autocomplete-entry-widget (iri-entry (tool-bar object))))
    object))

(defun print-info-message (message &key (color (gui-goodies:parse-color "gray")) (bold nil))
  (let ((info-widget (info-text gui-goodies:*main-frame*)))
    (setf (gui:text info-widget) message)
    (let ((color-tag (gui:tag-create info-widget
                                     (nodgui.utils:create-tag-name)
                                     (gui:make-indices-start)
                                     (gui:make-indices-end))))
      (if bold
          (gui:tag-configure info-widget
                             color-tag
                             :foreground color
                             :font "bold")
          (gui:tag-configure info-widget
                             color-tag
                             :foreground color)))))

(defun print-error-message (message)
  (print-info-message message :color (gui-goodies:parse-color "red") :bold t))

(defun init-main-window ()
  (gui:with-nodgui (:title +program-name+)
    (icons:load-icons)
    (initialize-menu gui:*tk*)
    (setf gui-goodies:*toplevel* gui:*tk*)
    (setf gui-goodies:*gui-server* gui:*wish*)
    (client-events:start-events-loop)
    (let ((main-frame (make-instance 'main-frame)))
      (setf gui-goodies:*main-frame* main-frame)
      (gui:grid main-frame 0 0 :sticky :nswe)
      (gui-goodies:gui-resize-grid-all gui-goodies:*toplevel*))))