phpinspect.el/phpinspect-worker.el

;;; phpinspect-worker.el --- PHP parsing and completion package  -*- lexical-binding: t; -*-

;; Copyright (C) 2021  Free Software Foundation, Inc

;; Author: Hugo Thunnissen <devel@hugot.nl>
;; Keywords: php, languages, tools, convenience
;; Version: 0

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(require 'cl-lib)
(require 'phpinspect-project)
(require 'phpinspect-index)
(require 'phpinspect-class)

(defvar phpinspect-worker nil
  "Contains the phpinspect worker that is used by all projects.")

(cl-defstruct (phpinspect-index-task
               (:constructor phpinspect-make-index-task-generated))
  "Represents an index task that can be executed by a `phpinspect-worker`."
  (project nil
           :type phpinspect--project
           :documentation
           "The project that the task should be executed for.")
  (type nil
        :type phpinspect--type
        :documentation
        "The type whose file should be indexed."))

(cl-defstruct (phpinspect-queue-item
               (:constructor phpinspect-make-queue-item))
  (next nil
        :type phpinspect-queue-item
        :documentation
        "The next item in the queue")
  (thing nil
         :type any
         :documentation
         "The thing stored in the queue")
  (previous nil
            :type phpinspect-queue-item
            :documentation
            "The previous item in the queue")
  (subscription nil
                :type function
                :read-only t
                :documentation
                "A function that should be called when items are
                enqueued."))

(defsubst phpinspect-make-queue (&optional subscription)
  (phpinspect-make-queue-item :subscription subscription))

;; Recursion causes max-eval-depth error here for long queues. Hence the loop
;; implementation for these two functions.
(cl-defmethod phpinspect-queue-last ((item phpinspect-queue-item))
  "Get the last item in the queue that ITEM is part of."
  (while (phpinspect-queue-item-next item)
    (setq item (phpinspect-queue-item-next item)))
  item)

(cl-defmethod phpinspect-queue-first ((item phpinspect-queue-item))
  "Get the first item in the queue that ITEM is part of."
  (while (phpinspect-queue-item-previous item)
      (setq item (phpinspect-queue-item-previous item)))
  item)

(cl-defmethod phpinspect-queue-enqueue ((item phpinspect-queue-item) thing)
  "Add THING to the end of the queue that ITEM is part of."
  (let ((last (phpinspect-queue-last item)))
    (if (not (phpinspect-queue-item-thing last))
        (setf (phpinspect-queue-item-thing last) thing)
      (setf (phpinspect-queue-item-next last)
            (phpinspect-make-queue-item
             :previous last
             :thing thing
             :subscription (phpinspect-queue-item-subscription item)))))
  (when (phpinspect-queue-item-subscription item)
    (funcall (phpinspect-queue-item-subscription item))))

(cl-defmethod phpinspect-queue-dequeue ((item phpinspect-queue-item))
  "Remove the thing at the front of the queue that ITEM is part of an return it."
  (let* ((first (phpinspect-queue-first item))
         (thing (phpinspect-queue-item-thing first))
         (next (phpinspect-queue-item-next first)))
    (when next (setf (phpinspect-queue-item-previous next) nil))
    (cond ((and (eq item first) (not next))
           (setf (phpinspect-queue-item-thing item)
                 nil))
          ((eq item first)
           (setf (phpinspect-queue-item-thing item)
                 (phpinspect-queue-item-thing next))
           (setf (phpinspect-queue-item-next item)
                 (phpinspect-queue-item-next next))))
    thing))

(defmacro phpinspect-doqueue (place-and-queue &rest body)
  "Loop over queue defined in PLACE-AND-QUEUE executing BODY.

PLACE-AND-QUEUE is a two-member list. The first item should be
the place that the current thing in the queue should be assigned
to upon each iteration. The second item should be a queue-item
belonging to the queue that must be iterated over.

BODY can be any form."
  (declare (indent defun))
  (let ((item-sym (gensym))
        (place (car place-and-queue))
        (queue (cadr place-and-queue)))
    `(let* ((,item-sym (phpinspect-queue-first ,queue))
            (,place (phpinspect-queue-item-thing ,item-sym)))
       (when ,place
         ,@body
         (while (setq ,item-sym (phpinspect-queue-item-next ,item-sym))
           (setq ,place (phpinspect-queue-item-thing ,item-sym))
           ,@body)))))

(cl-defmethod phpinspect-queue-find
  ((item phpinspect-queue-item) thing comparison-func)
  "Find THING in the queue that ITEM is part of using COMPARISON-FUNC."
  (catch 'found
    (phpinspect-doqueue (current-thing item)
      (when (funcall comparison-func current-thing thing)
        (throw 'found current-thing)))))

(cl-defmethod phpinspect-queue-enqueue-noduplicate
  ((item phpinspect-queue-item) thing comparison-func)

  (when (not (phpinspect-queue-find item thing comparison-func))
    (phpinspect-queue-enqueue item thing)))

(cl-defmethod phpinspect-queue-await-insert ((item phpinspect-queue-item))
  (condition-wait (phpinspect-queue-item-insert item)))

(cl-defstruct (phpinspect-worker
               (:constructor phpinspect-make-worker-generated))
  (queue nil
         :type phpinspect-queue-item
         :documentation
         "The queue of tasks that are pending")
  (thread nil
          :type thread
          :documentation
          "The thread of this worker")
  (continue-running nil
                    :type bool
                    :documentation
                    "Whether or not the thread should continue
running. If this is nil, the thread isstopped.")
  (skip-next-pause nil
                   :type bool
                   :documentation
                   "Whether or not the thread should skip its next scheduled pause."))

(cl-defstruct (phpinspect-dynamic-worker
               (:constructor phpinspect-make-dynamic-worker-generated))
  "A dynamic worker is nothing other than an object that is
supported by all of the same methods as a `phpinspect-worker`,
but relies on an underlying, global worker to actually do the
work. The reason for its implementation is to allow users to
manage phpinspect's worker thread centrally in a dynamic
variable, while also making the behaviour of objects that depend
on the worker independent of dynamic variables during testing.")

(cl-defmethod phpinspect-resolve-dynamic-worker ((worker phpinspect-dynamic-worker))
  phpinspect-worker)

(defsubst phpinspect-make-dynamic-worker ()
  (phpinspect-make-dynamic-worker-generated))

(defsubst phpinspect-make-worker ()
  "Create a new worker object."
  (let ((worker (phpinspect-make-worker-generated)))
    (setf (phpinspect-worker-queue worker)
          (phpinspect-make-queue (phpinspect-worker-make-wakeup-function worker)))
    worker))

(define-error 'phpinspect-wakeup-thread
  "This error is used to wakeup the index thread")

(cl-defgeneric phpinspect-worker-make-wakeup-function (worker)
  "Create a function that can be used to wake up WORKER's thread.")

(cl-defmethod phpinspect-worker-make-wakeup-function ((worker phpinspect-worker))
  (lambda ()
    (when (eq main-thread (thread--blocker (phpinspect-worker-thread worker)))
      (thread-signal (phpinspect-worker-thread worker)
                     'phpinspect-wakeup-thread nil))))

(cl-defmethod phpinspect-worker-make-wakeup-function ((worker phpinspect-dynamic-worker))
  (phpinspect-worker-make-wakeup-function (phpinspect-resolve-dynamic-worker worker)))

(cl-defgeneric phpinspect-worker-live-p (worker)
  "Just a shorthand to check whether or not the WORKER's thread is running.")

(cl-defmethod phpinspect-worker-live-p ((worker phpinspect-worker))
  (when (phpinspect-worker-thread worker)
    (thread-live-p (phpinspect-worker-thread worker))))

(cl-defmethod phpinspect-worker-live-p ((worker phpinspect-dynamic-worker))
  (phpinspect-worker-live-p (phpinspect-resolve-dynamic-worker worker)))

(cl-defgeneric phpinspect-worker-enqueue (worker task)
  "Enqueue a TASK to be executed by WORKER.")

(cl-defmethod phpinspect-worker-enqueue ((worker phpinspect-worker) task)
  (phpinspect-queue-enqueue (phpinspect-worker-queue worker) task))

(cl-defmethod phpinspect-worker-enqueue ((worker phpinspect-worker)
                                         (task phpinspect-index-task))
  "Specialized enqueuement method for index tasks. Prevents
indexation tasks from being added when there are identical tasks
already present in the queue."
  (phpinspect-queue-enqueue-noduplicate (phpinspect-worker-queue worker) task #'phpinspect-index-task=))

(cl-defmethod phpinspect-index-task= ((task1 phpinspect-index-task) (task2 phpinspect-index-task))
  (and (eq (phpinspect-index-task-project task1)
           (phpinspect-index-task-project task2))
       (phpinspect--type= (phpinspect-index-task-type task1) (phpinspect-index-task-type task2))))

(cl-defmethod phpinspect-worker-enqueue ((worker phpinspect-dynamic-worker) task)
  (phpinspect-worker-enqueue (phpinspect-resolve-dynamic-worker worker)
                             task))

(defun phpinspect-thread-pause (pause-time mx continue)
  "Pause current thread using MX and CONTINUE for PAUSE-TIME idle seconds.

PAUSE-TIME must be the idle time that the thread should pause for.
MX must be a mutex
CONTINUE must be a condition-variable"
  (phpinspect--log "Worker thead is paused for %d seconds" pause-time)
  (run-with-idle-timer
   pause-time
   nil
   (lambda () (with-mutex mx (condition-notify continue))))
  (with-mutex mx (condition-wait continue))
  (phpinspect--log "Index thread continuing"))

(cl-defgeneric phpinspect-worker-make-thread-function (worker)
  "Create a function that can be used to start WORKER's thread.")

(cl-defmethod phpinspect-worker-make-thread-function ((worker phpinspect-worker))
  (lambda ()
    (while (phpinspect-worker-continue-running worker)
      ;; This error is used to wake up the thread when new tasks are added to the
      ;; queue.
      (ignore-error 'phpinspect-wakeup-thread
        (let* ((task (phpinspect-queue-dequeue (phpinspect-worker-queue worker)))
               (mx (make-mutex))
               (continue (make-condition-variable mx)))
          (if task
              ;; Execute task if it belongs to a project that has not been
              ;; purged (meaning that it is still actively used).
              (unless (phpinspect--project-purged (phpinspect-task-project task))
                (phpinspect-task-execute task worker))
            ;; else: join with the main thread until wakeup is signaled
            (thread-join main-thread))

          ;; Pause for a second after indexing something, to allow user input to
          ;; interrupt the thread.
          (unless (phpinspect-worker-skip-next-pause worker)
            (phpinspect-thread-pause 1 mx continue))
          (setf (phpinspect-worker-skip-next-pause worker) nil))))
    (phpinspect--log "Worker thread exiting")
    (message "phpinspect worker thread exited")))

(cl-defmethod phpinspect-worker-make-thread-function ((worker phpinspect-dynamic-worker))
  (phpinspect-worker-make-thread-function
   (phpinspect-resolve-dynamic-worker worker)))

(cl-defgeneric phpinspect-worker-start (worker)
  "Start WORKER's thread.")

(cl-defmethod phpinspect-worker-start ((worker phpinspect-worker))
  (if (phpinspect-worker-live-p worker)
      (error "Attempt to start a worker that is already running")
    (progn
      (setf (phpinspect-worker-continue-running worker) t)
      (setf (phpinspect-worker-thread worker)
            (make-thread (phpinspect-worker-make-thread-function worker))))))

(cl-defmethod phpinspect-worker-start ((worker phpinspect-dynamic-worker))
  (phpinspect-worker-start (phpinspect-resolve-dynamic-worker worker)))

(cl-defgeneric phpinspect-worker-stop (worker)
  "Stop the worker")

(cl-defmethod phpinspect-worker-stop ((worker phpinspect-worker))
  (setf (phpinspect-worker-continue-running worker) nil))

(cl-defmethod phpinspect-worker-stop ((worker phpinspect-dynamic-worker))
  (phpinspect-worker-stop (phpinspect-resolve-dynamic-worker worker)))

(defun phpinspect-ensure-worker ()
  (interactive)
  (when (not phpinspect-worker)
    (setq phpinspect-worker (phpinspect-make-worker)))

  (when (not (phpinspect-worker-live-p phpinspect-worker))
    (phpinspect-worker-start phpinspect-worker)))

(defun phpinspect-stop-worker ()
  (interactive)
  (phpinspect-worker-stop phpinspect-worker))

(cl-defgeneric phpinspect-make-index-task ((project phpinspect--project)
                                          (type phpinspect--type))
  (phpinspect-make-index-task-generated
   :project project
   :type type))

(cl-defgeneric phpinspect-task-project (task)
  "The project that this task belongs to.")

(cl-defmethod phpinspect-task-project ((task phpinspect-index-task))
  (phpinspect-index-task-project task))

(cl-defgeneric phpinspect-task-execute (task worker)
  "Execute TASK for WORKER.")

(cl-defmethod phpinspect-task-execute ((task phpinspect-index-task)
                                       (worker phpinspect-worker))
  "Execute index TASK for WORKER."
  (let ((project (phpinspect-index-task-project task))
        (is-native-type (phpinspect--type-is-native
                         (phpinspect-index-task-type task))))
    (phpinspect--log "Indexing class %s for project in %s from index thread"
                     (phpinspect-index-task-type task)
                     (phpinspect--project-root project))

    (cond (is-native-type
           (phpinspect--log "Skipping indexation of native type %s"
                            (phpinspect-index-task-type task))

           ;; We can skip pausing when a native type is encountered
           ;; and skipped, as we haven't done any intensive work that
           ;; may cause hangups.
           (setf (phpinspect-worker-skip-next-pause worker) t))
          (t
           (let* ((type (phpinspect-index-task-type task))
                  (root-index (phpinspect--index-type-file project type)))
             (when root-index
               (phpinspect--project-add-index project root-index)))))))


(provide 'phpinspect-worker)
;;; phpinspect-worker.el ends here