event system

Q&A's, tips, howto's
Locked
Ormente
Posts: 23
Joined: Tue Aug 31, 2010 1:54 pm
Location: Near Mâcon, France

event system

Post by 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 all

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

;; 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 all

;; 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
Posts: 23
Joined: Tue Aug 31, 2010 1:54 pm
Location: Near Mâcon, France

Re: event system

Post by Ormente »

A little better :

Code: Select all

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

> (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
Posts: 429
Joined: Sun Dec 02, 2007 5:10 pm
Contact:

Re: event system

Post by 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 all

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

(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 Dragonfly actually.
Get your Objective newLISP groove on.

Locked