event system

[Ormente]

I'm exploring ways to add some sort of events in the flow of a script... i would like to have your opinion about how to do this, and how i've done it. Here's my first take with this idea :

Code Select Expand


(new Tree 'EVENTS-BEFORE)
(new Tree 'EVENTS-AFTER)

(define-macro (event-before target action)
(setf target (string target))
(unless (EVENTS-BEFORE target) (EVENTS-BEFORE target '(begin)) )
(extend (EVENTS-BEFORE target) (list action))
)

(define-macro (event-after target action)
(setf target (string target))
(unless (EVENTS-AFTER target) (EVENTS-AFTER target '(begin)) )
(extend (EVENTS-AFTER target) (list action))
)

(define-macro (with-events)
(let (_fun_ (string (args 0)) _res_ nil)
(eval (EVENTS-BEFORE _fun_))
(setf _res_ (eval $args))
(eval (EVENTS-AFTER _fun_))
_res_
)
)


With this, i can do that :

Code Select Expand


;; for now, same as (+ 4 5 6)
> (with-events + 4 5 6)
15
;; add a new "before" add event
> (event-before + (println "will add something : " $args))
;; then an "after" event
> (event-after + (println "done!"))
;; then, if i call "+" with events :
> (with-events + 4 5 6)
will add something : (+ 4 5 6)
done!
15

Is there a more idiomatic way to do this ?

Any idea to make it better (something like a way for "before" events to change the args, for example ) ?





EDIT : some background about why i want do do this. For my web framework, the main cgi script is very simple, and should end with something like "(output)". This function will output the headers, and the content. Clean and simple.

But along the way i may have loaded a module to provide sessions, and another to access a database. So, i want these modules to be able to gracefully save the session and disconnect from the database at the end of the script, without having to invoque the coresponding function explicetly. The idea :

Code Select Expand


;; in my framework :
(define (output)
(with-events output-headers)
(with-events output-content)
)

;; in a session handling extension
(event-before output-headers (SESSION:save))

;; in a text formater extension
(event-before output-content (TYPOGRAPHIST:reformat-all))

;; somwhere else
(event-after output-content (LOGGER:do-something))


[Ormente]

A little better :

Code Select Expand


(define-macro (with-events _todo_)
(let (_fun_ (string (_todo_ 0)) _res_ nil)
(eval (EVENTS-BEFORE _fun_))
(setf _res_ (eval _todo_))
(eval (EVENTS-AFTER _fun_))
_res_
)
)


This way, i can do :

Code Select Expand


> (event-before + (setf (_todo_ 2) 100))
> (with-events (+ 4 5 6))
110
> (event-after + (println "args : " (rest _todo_)))
> (with-events (+ 4 5 6))
args : (4 100 6)
110


[itistoday]

Cool, I like it! :-)



Don't know if you'll find this useful, but your code reminded me of a somewhat similar macro I made called 'wrap-func':

Code Select Expand

(define-macro (wrap-func func-sym wrapper , wrapped-func)
(setf wrapped-func (sym (string func-sym "|wrapped#" (inc wrap-func.counter))))
(set wrapped-func (eval func-sym))
(set func-sym (eval (expand wrapper 'wrapped-func)))
)

An example usage:

Code Select Expand

(wrap-func db:execute-update (fn ()
(unless (apply wrapped-func $args)
(error-out "execute-update failed: " $args)
)
))

Now when db:execute-update gets called, the function above is called instead, which then calls the real execute-update function (via 'wrapped-func') and outputs an error message if it fails.



Edit: It's available as part of http://www.rundragonfly.com/">Dragonfly actually.