Re: RFC: A framework for task management and execution in Emacs

[joakim]

Jan Moringen <address@hidden> writes:

> Hi,
>
> I would like to start a discussion regarding a topic that has bothered
> me for some time now: management and execution of (long-running) tasks
> in Emacs. Instead of properly explaining what I mean by "task", I will
> just paste a table from my notes that has several examples:
>
> | Component    | Execution          | Progress Indication | Cancelable
> |--------------+--------------------+---------------------+-----------
> | Tramp        | synchronous        | progress reporter   | no?
> | VC           | sync, async        | mode-line           | sometimes
> | Gnus         | synchronous        | ?                   | ?
> | Compilation  | asynchronous       | mode-line           | yes
> | URL          | synchronous, async | progress reporter   | ?
> | Emacs Jabber | timers, fsm        | ?                   | ?
> | SemanticDB   | idle-timers        | custom reporter     | on input
>
> Each of these packages performs some kinds of potentially long running
> operations. Originally, the table was intended to illustrate the
> heterogeneous nature of solutions despite similar requirements and
> use-cases.
>
> The (hopefully) upcoming thread support will probably make the situation
> better and worse. Better, because long-running operations could "simply"
> run in their own threads, worse because actually implementing this is
> usually not that simple. The number and complexity of solutions for task
> execution would probably grow further once threads become available.
>
> My proposal is to introduce a set of mechanisms that make task execution
> more uniform for the user and easier for programmers. Here is the full
> set of requirements/aspects I could come up with:
>
> + Scheduling/Execution
>   + Resource Allocation (threads)
>   + Synchronization (order of execution, retrieval of results)
>   + Canceling
> + User Interface
>   + Graphical Indicators
>   + Progress/remaining Time Estimation
>   + Error Reporting
> + Desktop Integration
>   + Power Management inhibition
>   + Desktop-wide Task Management
>     (Example:
> http://ssickert.wordpress.com/2010/05/09/introducing-my-gsoc project/)
> + Customization
> + Compatibility
>   + Portability
>   + Backwards Compatibility
>
> Since there is so much potential for code duplication, reinventing the
> wheel and divergent user interfaces, I think all of these issue should
> be addressed in a general way.
>
> Other Environments such as Eclipse or the Evolution mail client seem to
> employ such generic mechanisms since their user interfaces contain lists
> of currently running tasks, which can also be interacted with.
>
> At this point, my general question is whether there are any plans or
> related efforts regarding this topic. Of course, I would also like to
> know whether people consider the approach worthwhile at all :)
>
> The second part of this message is about a small prototype framework I
> made to explore the issue practically.
>
> The framework is structured like this:
>
> Interface Layer
> +--------------------------------+-----------------------------------+
> |                                |                                   |
> |         User Interface         |               Macros              |
> |                                |                                   |
> +--------------------------------+-----------------------------------+
> Backend Layer
> +------------------------------+-------------------------------------+
> |                              |                                     |
> |              Tasks           +---+            Execution            |
> | +-----------+     +-----------+  | +-----------+     +-----------+ |
> | | Strategy1 | ... | StrategyN |  | | Strategy1 | ... | StrategyN | |
> | +-----------+     +-----------+  | +-----------+     +-----------+ |
> +----------------------------------+---------------------------------+
>
> These components are discussed below:
>
> *Macros*
>
> Basically just two macros with identical syntax:
>
> ({do,run}-as-task NAME (TASK-SPEC) (EXECUTION-SPEC)
>   [DOCSTRING]
>   BODY)
>
> The difference being that the do- macro returns the result of BODY when
> it is ready while the run- variant immediately returns an object from
> which the result of BODY can be retrieved later.
>
> Examples:
>
> (do-as-task add-numbers () ()
>   "Add some numbers."
>   (dolist (i (number-sequence 1 1000))
>     (+ 1 2 3)
>     'my-result))
>
> + Blocks immediately
> + Body may or may not start executing immediately
> + Returns when the body finishes
> + Returns the value returned by the body
>
> (let ((delayed (run-as-task add-numbers () ()
>   "Add some numbers."
>   (dolist (i (number-sequence 1 1000))
>     (+ 1 2 3)
>       'my-result))))
>   ;; do other stuff
>   (future-get delayed))
>
> + Does not block
> + Body may or may not start executing immediately
> + Returns immediately
> + Returns an object that implements a "future" protocol
> + Result of body can be retrieved from returned object
>
> *Tasks Strategies*
>
>>From the commentary section:
>
> ;; What a task is
> ;; + What gets executed
> ;; + Execution context (functions callable from task code)
> ;; + Meta information (name, description)
> ;; What a task is not
> ;; + how to execute (synchronous vs. asynchronous)
> ;; + when to execute (delayed, lazy etc)
>
> (do-as-task add-numbers (progress) ()
>   "Add some numbers, reporting progress."
>   (dolist (i (number-sequence 1 1000))
>     (+ 1 2 3)
>     (progress i))
>   'my-result)
>
> (do-as-task add-numbers (cancelable) ()
>   "Add some numbers, cancelable."
>    (dolist (i (number-sequence 1 1000))
>      (+ 1 2 3)
>      (maybe-cancel))
>    'my-result)
>
> (do-as-task add-numbers (progress cancelable) ()
>   "Add some numbers, reporting progress and cancelable."
>    (dolist (i (number-sequence 1 1000))
>      (+ 1 2 3)
>      (progress i)
>      (maybe-cancel))
>    'my-result)
>
> *Execution Strategies*
>
> These control how and when a task is executed. The currently available
> executions are (:thread is just a teaser, of course):
>
> (run-as-task add-numbers () (:execution blocking)
>
> (run-as-task add-numbers () (:execution idle)
>
> (run-as-task add-numbers () (:execution (timeout :delay 5))
>
> (run-as-task add-numbers () (:execution thread))
>
> *User Interface*
>
> There is also user interface code, but discussing it here would probably
> provide little insight.
>
> The code of the framework described above is available at
>
>   http://bazaar.launchpad.net/~scymtym/etasks/trunk/
>
> Feedback and suggestions would be greatly appreciated.

Sounds very interesting. I have a scanner package called "emsane" for
which I developed "emsane-postop". This is basically an event driven
transaction queue. you push operations on a queue, and when an event
happens, the operation is popped and executed. If the the operation
fails, the transaction fails.

Does this fit in your framework? I dont have anywhere public to place
the code at yet, so I attach the file instead, so you can have a look.

;; (C) FSF 2010, Joakim Verona, part of the emsane package

;;I want some form of process queue because:
;; - tramp gets swamped with lots of async calls
;; - some postops are slow, and hundreds of them cant be expected to run in 
parallell
;; emsane was used for a long time withouth a queue, but it put constraints on 
what could be done

;; it wouldve been nice if i didnt have to write it, but i didnt find anything.
;; i fully expect to be pointed to something glaringly obviously already 
existing once
;; i publish the code.

;; TODO I want scan-job postprocessing also, for book-level ocr for 
instance(with ocropus)


;;;tentative stuff

;; - operation  base class
;; - transaction class(a list of operations)
;; - queue class(a list of transactions, a result slot)

;;when a image is finished scanned, a new transaction is created, and the image 
pushed on the transaction result slot
;;the section definition pushes a bunch of ops on the tx
;;maybe someone else also pushes a op(the job? scanner?)
;;the tx is pushed on the queue
;;the queue is event driven, these are events:
;; - pushing a tx on the queue
;; - an emacs op finishes
;; - a shell op finishes
;;if any op ina tx fails, the entire tx fails, otoh other txes are unafected
;;the workdir is set on the post op buffer, so will work with tramp
;;there is a set workdir op, so different scan jobs wont trahs each other


;;its possible to define many queues,
;;a queue is connected to 1 postop buffer

;;transactions are independent, so they could in principle be executed in 
parallell
;;however, a queue will only do transactions in sequence
;;futureish is supporting several queues, then pushing transactions round robin 
on them

;;emsane-postop-next-op pops an op from the current tx, and executes it
;;emsane-postop-push-op pushes op on tx

;;an op ought to be able to provide environment modifiers, such as changing the 
flags for the scanner
;; the use-case for this is for instance a dust-detector that needs the scanner 
to scan a little bit more than
;; the actual document. the op will then split the img in 2 parts, one actual 
image, and one part used for dust detection.

(provide 'emsane-postop)

(defclass emsane-postop-operation ()
  ()
  "base class for post operations for image scans")

(defclass emsane-postop-lisp-operation (emsane-postop-operation)
  ((operation-lambda :initarg :operation-lambda
                     :documentation "a lambda of the form (lambda (transaction) 
(do-something-with-transaction))"))
  "A lisp image file operation. for instance for renaming files.")

(defclass emsane-postop-simple-shell-operation (emsane-postop-operation)
  ((operation-shell-command :initarg :operation-shell-command
                            :documentation "a simple string to be evaluated by 
a shell"))
  "a simple file operation done with a shell command")

(defclass emsane-postop-lifo ()
  ((lifo :initarg :lifo
         :initform '()
         :documentation "a LIFO, Last In First Out"))
  "base class for queue and transaction")

(defclass emsane-postop-queue (emsane-postop-lifo)
  ((process-buffer :initarg :process-buffer)
   (continue-go-loop :initarg  :continue-go-loop :initform t
                     :documentation "flag setable by subprocess, to indicate 
continuation")
   (default-directory :initarg :default-directory :initform default-directory
     :documentation "subproces default dir")
   (state :initarg :state :initform nil
          :documentation  "nil if ok, otherwise an object indicating some 
error")
   (error-queue :initarg :error-queue :initform nil  :documentation 
"transactions who failed gets pushed here")
   (current-tx :initarg :current-tx :initform nil)
   (current-op :initarg :current-op :initform nil)
   (error-hooks :initarg :error-hooks :initform nil
                :documentation "hooks to run in the event of a transaction 
error"))
  "a list of transactions to be performed")

(defmethod emsane-postop-exec ((this emsane-postop-lisp-operation) tx q)
  "execute lisp operation"
  (let*
      ((default-directory  (oref q default-directory)))
    (condition-case lispop-error
        (progn
          (funcall (oref this :operation-lambda) tx q)
          (emsane-postop-push q tx);;push backcurrent tx. will be skipped if op 
fails
          (emsane-process-buffer-message q "lisp-op:%s env:%s\n"
                            (oref this :operation-lambda)
                            (emsane-plist2env (oref tx environment))))
      (error (emsane-postop-signal-error q lispop-error)))))

(defmethod emsane-postop-exec ((this emsane-postop-simple-shell-operation) tx q)
  "execute shell operation"
  (let*
      ((default-directory  (oref q default-directory))
       (cmd (oref this operation-shell-command))
       (proc-buf  (oref q :process-buffer))
       (process-environment (emsane-plist2env (oref tx :environment)))
       (post-process (start-file-process-shell-command
                      "postop"
                      proc-buf
                      cmd)))
    (set-process-sentinel post-process 'emsane-postop-sentinel)
    (process-put post-process 'queue q)
    (emsane-process-buffer-message q "shell-op:%s env:%s ..." cmd 
(emsane-plist2env (oref tx environment)))
    (oset q :continue-go-loop 'waiting-for-shell-op)))

(defun emsane-plist2env (plist)
  "convert a plist to the env var format used by process-environment"
  (let*
      ((env '()))
    (while plist
      (setq env (append env (list (format "%s=%s" (first plist) (second 
plist)))))
      (setq plist (cdr (cdr plist))))
    env))

(defun emsane-postop-sentinel (process result)
  "called when an image shell postop finishes"
  (let*
      ((queue (process-get process 'queue))
       (tx-no-error (= 0 (process-exit-status process))))
    (unless tx-no-error
      (emsane-postop-signal-error queue result))
    (emsane-postop-finish-shell-operation queue tx-no-error)
    (emsane-postop-go queue);;now continue processing queue transations
    ))

(defmethod emsane-postop-signal-error ((this emsane-postop-queue) result)
  "error handler"
  ;;TODO better error handler
  ;;there are levels of errors:
  ;; - tx killers, move the tx to an error queue, other tx:es arent affected
  ;; - queue killers, inhibit further queue opperations, stop scanning!
  ;;TODO call hooks, client should know about error(shut down scanner processes 
in this case)
  ;;(oset this :state result) ;;TODO "state" is currently used as a 
queue-killer, which doesnt happen atm

  ;;the case below is "tx killer", push the broken tx on an error queue for 
later examination, queue chugs on as usual
  (unless (object-p (oref this :error-queue)) (oset this :error-queue 
(emsane-postop-lifo "errorq"))) ;;TODO move to q initializer

  ;;the current tx must be removed from the queue, but, uh, only if were 
executing a shell op??
  ;;this is because a shell op is pushed back onto the queue before its actualy 
finished. hmmm.
  ;;see donext. this sucks.

  ;;im trying to have the sentinel push back the tx instead
 
  ;; (if (equal (object-class (oref this :current-op))  
'emsane-postop-simple-shell-operation)
  ;;     (emsane-postop-dequeue this))

  
  ;;TODO :current-tx should be the complete failed transaction, not the same as 
the modified tx on top of the q, as it is now
  (emsane-postop-push (oref this :current-tx) (oref this :current-op));;push 
back the failed op on current tx
  (emsane-postop-push (oref this :error-queue) (oref this :current-tx));;push 
failed tx on error q
  

  (mapc #'funcall (oref this :error-hooks));;using run-hooks turned out not so 
good here
  (let*
      ((msg (format "postop failed. result:%s\n  tx:%s\n  op:%s" result (oref 
this :current-tx) (oref this :current-op))))
    (emsane-process-buffer-message this msg)
    (message msg))
  )

(defmethod emsane-postop-push ((this emsane-postop-lifo) object)
  "Push object on the LIFO queue. New objects go at the head of the list."
  (oset this :lifo (cons object   (oref this :lifo))))

(defmethod emsane-postop-push ((this emsane-postop-queue) object)
  "add some debugging output"
  (call-next-method)
  ;;(emsane-process-buffer-message this "pushed on queue: %s\n" object)
  )


(defmethod emsane-postop-dequeue ((this emsane-postop-lifo))
  "Return object from the end of the LIFO  queue, and remove the element."
  (unless (emsane-postop-hasnext this) (error "poping an empty queue is bad"))
  (let
      ((rv (car (last (oref this :lifo)))))
    ;;(oset this :lifo (nreverse (cdr (nreverse (oref this :lifo)))));;TODO 
ugly implementation
    (oset this :lifo (delq rv (oref this :lifo)))
    rv))

(defmethod emsane-postop-hasnext ((this emsane-postop-lifo))
  "empty?"
  (not (null (oref this :lifo))))

(defclass emsane-postop-transaction (emsane-postop-lifo)
  ((environment :initarg :environment
                :initform nil
                :documentation "transaction environment variables."))
  "a list of operations that must be performed together. contains environment 
operations can access")

(defmethod  emsane-postop-getenv ((this  emsane-postop-transaction) varname)
  (plist-get (oref this environment) varname))

(defmethod  emsane-postop-setenv ((this  emsane-postop-transaction) varname 
value)
  (oset this environment (plist-put (oref this environment) varname value)))

(defmethod emsane-postop-finish-shell-operation ((this emsane-postop-queue) 
tx-no-error)
  "finishup an ongoing shell operation, take care of error situation."
  (if tx-no-error
      (progn
        (emsane-postop-push this (oref this :current-tx));;push backcurrent tx 
if everything went ok. awkward.
        (emsane-process-buffer-message this "... DONE! env:%s\n"  
(emsane-plist2env (oref (oref this :current-tx) environment)))        
        )
    (emsane-process-buffer-message this "... FAILED! %s!!!.\n" tx-no-error))
  (oset this :continue-go-loop t))

(defmethod emsane-process-buffer-message ((this emsane-postop-queue) string 
&rest objects)
  ;;TODO should have its own insert marker, so moving the cursor doesnt break 
output
    (with-current-buffer (oref this :process-buffer)
      (insert (apply 'format (cons string objects)))))

(defmethod emsane-process-buffer-insert ((this emsane-postop-queue) string 
&rest objects)
  ;;TODO should have its own insert marker, so moving the cursor doesnt break 
output
    (with-current-buffer (oref this :process-buffer)
      (insert (apply 'format (cons string objects)))))

(defmethod emsane-postop-donext ((this emsane-postop-queue))
  "pops an operation from the current transaction in the queue and executes it.
continue with the 1st op of the next transaction if the current transaction is 
finished.
if the queue is empty return nil."
  ;;TODO the method should always be safe to call, regardless of the queue 
state, ensure this
  ;;TODO delete the transaction if the operation fails.
  ;;should almost work, because if crash, we dont push back th eop
  (if (oref this state) (error "the queue is unwell:%s" (oref this state)))
  (if (emsane-postop-hasnext this)
      (let*
          ((tx (emsane-postop-dequeue this))
           (op))
        (oset this :current-tx tx)
        (if (emsane-postop-hasnext tx)
            (progn
              (setq op  (emsane-postop-dequeue tx))
              (oset this :current-op op)
              (emsane-postop-exec op tx this))
          (emsane-postop-donext this) ;;TODO really? recursion doesnt feel 
right when we might have a complicated error condition...
          ))))

(defmethod emsane-postop-go ((this emsane-postop-queue))
  "start or continue executing transactions in queue.
it is supposed to always be safe to call.";;TODO it isnt atm...
  (if (oref this state) (error "the queue is unwell:%s" (oref this state)))
  ;;(emsane-process-buffer-message this "cgloop:%s\n" (oref this 
:continue-go-loop)  )
  (unless  (equal (oref this :continue-go-loop) 'waiting-for-shell-op)
      (let
          ((continue-go-loop t))
        (while (and continue-go-loop
                    (not (eq 'waiting-for-shell-op continue-go-loop))
                    (emsane-postop-hasnext this)) ;;TODO continue-go-loop is 
madness atm
          (emsane-postop-donext this)
          (setq continue-go-loop (oref this :continue-go-loop))))))



> Kind regards,
> Jan
>
>
-- 
Joakim Verona