(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)))

(defun start-stream-iri-clsr (widget use-cache)
  (lambda ()
    (with-accessors ((iri-entry iri-entry)) widget
      (let ((iri (gui:text iri-entry)))
        (slurp-gemini-stream iri
                             :use-cache use-cache
                             :process-function (lambda (lines)
                                                 (misc:dbg "lines ~a" lines)))))))

(defun setup-main-window-events (main-window)
  (with-accessors ((iri-entry     iri-entry)
                   (back-button   back-button)
                   (reload-button reload-button)
                   (up-button     up-button)
                   (go-button     go-button)) main-window
    (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)
    (setup-main-window-events object)
    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)))

(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))
    (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: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)
    object))

(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)))
      (gui:grid main-frame 0 0 :sticky :nswe)
      (gui-goodies:gui-resize-grid-all gui-goodies:*toplevel*))))