Hunchentoot/cl-who Page Composition
I'm trying to put together a few pages in hunchentoot as an experiment, and I'm running into an unexpected wall. As an example, I have the following template macro.
(defmacro page-template ((&key title) &body body)
`(with-html-output-to-string
(*standard-output* nil :prologue t :indent t)
(:html :xmlns "http://www.w3.org/1999/xhtml" :xml\:lang "en" :lang "en"
(:head (:meta :http-equiv "Content-Type" :content "text/html;charset=utf-8")
(:title ,(format nil "~#[~A - ~]Test Site" title)))
(:body ,#body))))
Now when I have a pure text page, or one filled with html literals like
(define-easy-handler (test-page :uri "/") ()
(page-template (:title "Splash Page") (:p "Testing testing")))
everything is a-ok. The page outputs properly and I can see te efforts of my code instantly. However, when I have a page which is made up of redundant elements, it's not as simple. For example, lets say I have a page on which for whatever reason I want to display three RSS newsfeeds. This is a sufficiently complex component that I want to abstract it out, so to my minnd, I should be able to do something like
(define-easy-handler (test-feed :uri "/feeds") ()
(page-template (:title "Splash Page")
(publish-newsfeed "http://nf-one.html")
(publish-newsfeed "http://nf-two.html")
(publish-newsfeed "http://nf-three.html")))
(defmacro publish-newsfeed (url &optional (item-limit 5))
(flet ((get-text (s-tree node-path) (car (last (xmls-tools:find-subtree s-tree node-path)))))
(let ((rss-feed (xmls:parse (drakma:http-request url))))
`(:div :class "rss-feed"
(:a :href ,(get-text rss-feed '("channel" "link")) :target "_top" (:h1 ,(get-text rss-feed '("channel" "title"))))
(:ul ,#(mapcar #'(lambda (item)
`(:li (:a :href ,(get-text item '("link")) :target "_top" (:h2 ,(get-text item '("title"))))
(:p :class "date" ,(get-text item '("pubDate")))
(:p ,(get-text item '("description")))))
(let ((items (xmls-tools:find-all-children (xmls-tools:find-subtree rss-feed '("channel")) "item")))
(if (> (length items) item-limit) (subseq items 0 item-limit) items))))))))
But the result of the above is a "Server Error" page. I'm not quire sure why; page-template is a macro so the calls to publish-newsfeed shouldn't be expanded until they're in the context of with-html-output-to-string. Can anyone tell me what I'm doing wrong?
Also, on closer inspection of the various Hunchentoot/cl-who tutorials, none of them seems to do this kind of page composition. Can anyone with some Hunchentoot experience tell me what the correct/canonical way of decomposing a page into components is?
EDIT:
Correct response by Ramarren below; the with-html-output macros work under different evaluation rules. The version of publish-newsfeed that would actually work in this situation is actually
(defun publish-newsfeed (url &optional (item-limit 5))
(flet ((get-text (s-tree node-path) (car (last (xmls-tools:find-subtree s-tree node-path)))))
(let* ((rss-feed (xmls:parse (drakma:http-request url)))
(items (xmls-tools:find-all-children (xmls-tools:find-subtree rss-feed '("channel")) "item"))
(ltd-items (if (> (length items) item-limit) (subseq items 0 item-limit) items)))
(with-html-output
(*standard-output* nil :indent t)
(:div :class "rss-feed"
(:a :href (get-text rss-feed '("channel" "link")) :target "_top" (:h1 (str (get-text rss-feed '("channel" "title")))))
(:ul (dolist (item ltd-items)
(htm (:li (:h2 (:a :href (get-text item '("link")) :target "_top" (str (get-text item '("title")))))
(:p :class "date" (str (get-text item '("pubDate"))))
(:p (str (get-text item '("description")))))))))))))
Note the removal of mapcar for dolist (I'm a Schemer, don't give me too much of a hard time about liking lambdas, but they weren't the right choice here), and the use of htm to escape blocks of html s-exps (h-exps?) that wouldn't otherwise be in context for with-html-output. Finally, I had to wrap text but NOT :href properties in (str ) to get them to expand dynamically.
The macro with-html-output-to-string expands its body using special evaluation rules. In particular, any not recognized forms are left as is, which means macros are not expanded before the html generating code is generated, which means by the time your publish-newsfeed macro is expanded by the standard compiler it is no longer in context ofwith-html-output-to-string. This is clear when expanding the macro manually, especially using slime macroexpansion feature.
To make it work you should make publish-newsfeed a function and use with-html-output inside it with the same stream (either assume `standard-output everywhere or pass the stream explicitly).
Related
The usual way to generate HTML using CL-WHO is by using the macros with-html-output and with-html-output-to-string. This uses special syntax. For example:
(let ((id "greeting")
(message "Hello!"))
(cl-who:with-html-output-to-string (*standard-output*)
((:p :id id) message)))
Is it possible to write the data ((:p :id id) message) as a list instead of using the macro syntax shown above? For example, I would like to define the HTML as a list like this:
(let* ((id "greeting")
(message "Hello!")
(the-html `((:p :id ,id) ,message)))
;; What should I do here to generate HTML using CL-WHO?
)
Can CL-WHO take a normal Lisp list and produce HTML from the list?
You want to insert code into an expression.
Actually you would need eval:
(let* ((id "greeting")
(message "Hello!")
(the-html `((:p :id ,id) ,message)))
(eval `(cl-who:with-html-output-to-string (*standard-output*)
,the-html)))
But this is not good to use eval.
But a macro contains an implicite eval.
I would define a macro for this and call the macro:
(defun html (&body body)
`(cl-who:with-html-output-to-string (*standard-output*)
,#body))
;; but still one doesn't get rid of the `eval` ...
;; one has to call:
(let* ((id "greeting")
(message "Hello!")
(the-html `((:p :id ,id) ,message)))
(eval `(html ,the-html)))
I have a struct with :name and :value that I'd like to use as arguments to a macro. But I'm not sure how to tell lisp that.
I can write out the call like
(sxql:yield (sxql:set= :name "a" :value 1))
"SET name = ?, value = ?"
("a" 1)
But I'd like to use an already existing structure
(defstruct my-struct name value)
(setq x (make-my-struct :name "a" :value 1))
; #S(MY-STRUCT :NAME "a" :VALUE 1)
using answers from Common LISP: convert (unknown) struct object to plist?
I've made
(defun struct-plist (x)
"make struct X into a property list. ugly kludge"
(let* ((slots (sb-mop:class-slots (class-of x)))
(names (mapcar 'sb-mop:slot-definition-name slots)))
(alexandria:flatten
(mapcar (lambda (n) (list (intern (string n) "KEYWORD")
(slot-value x n)))
names))))
(setq p (struct-plist x)) ; (:NAME "a" :VALUE 1)
My naive attempts are
(sxql:set= p) ; error in FORMAT: No more argument SET ~{~A = ~A~^, ~}
(funcall 'sxql:set= p) ; SXQL:SET= is a macro, not a function.
(macroexpand (sxql:set= p)) ; error in FORMAT ...
I imagine this is an easy/fundamental lisp programming question. But I'm not sure how to ask it (or search for answers). I'm also hoping there is an better struct<->plist story than what I've stumbled across so far.
EDIT: In case this is really an xy-problem. I've used flydata:defmodel to create the struct and I want to insert to a database using the same model.
This is definitely an xy problem: unfortunately I don't understand y (flydata?) well enough to answer the y part.
Here's why what you are trying to do can't work however. Consider this code in a file being compiled:
(defstruct mine name value)
...
(sxql:set= <anything derived from mine>)
Compiling this file must satisfy two constraints:
It does not fully create the structure type mine (see defstruct);
It must macroexpand sxql:set=.
What these constraints mean is that sxql:set= can't know about the structure at the time it is expanded. So any trick which relies on information about the structure must make that information available at compile time.
As I said, I don't understand the y part well enough to understand what you are trying to do, but a hacky approach to this is:
write a wrapper for defstruct which stashes information at compile time (strictly: at macro-expansion time);
write a wrapper for sxql:set= which uses that information to expand into something which makes sense.
Here is a mindless wrapper for defstruct. Note that this is mindless: it can only understand the most simple defstruct forms, and even then it may be wrong. It exists only as an example.
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *structure-information* '()))
(defmacro define-mindless-structure (name &body slots)
(assert (and (symbolp name)
(every #'symbolp slots))
(name slots)
"I am too mindless")
(let ((found (or (assoc name *structure-information*)
(car (push (list name) *structure-information*)))))
(setf (cdr found) (mapcar (lambda (slot)
(list slot (intern (symbol-name slot)
(find-package "KEYWORD"))
(intern (concatenate 'string
(symbol-name name)
"-"
(symbol-name slot)))))
slots)))
`(defstruct ,name ,#slots))
So now
(define-mindless-structure mine
name value)
Will expand into (defstruct mine name value) and, at macroexpansion time will stash some information about this structure in *structure-information*.
Now I stop really understanding what you need to do because I don't know what sxql:set= is meant to do, but it might be something like this:
(defmacro mindless-set= ((s o))
(let ((info (assoc s *structure-information*))
(ov (make-symbol "O")))
(unless info
(error "no information for ~A" s))
`(let ((,ov ,o))
(sxql:set= ,#(loop for (slot initarg accessor) in (cdr info)
;; the compiler will whine about slot annoyingly
collect initarg
collect `(,accessor ,ov))))))
So with this macro, assuming a suitable define-mindless-structure for mine form has been seen by the time the macro is expanded, then
(mindless-set= (mine it))
Will expand into
(let ((#:o it))
(set= :name (mine-name #:o) :value (mine-value #:o)))
But, as I said, I am not sure what the expansion you actually want is.
Finally, before even thinking about using anything like the above, it would be worth looking around to see if there are portability libraries which provide compile/macroexpansion-time functionality like this: there very well may be such, as I don't keep up with things.
I'm still quite new to Common Lisp macros.
For an abstraction over a defclass with defgeneric I thought it'd be nice to make a macro.
A complitely naive implementation looks like:
(defmacro defgserver (name &key call-handler cast-handler)
"TODO: needs firther testing. Convenience macro to more easily create a new `gserver' class."
`(progn
(defclass ,name (gserver) ())
(defmethod handle-call ((server ,name) message current-state)
,(if call-handler call-handler nil))
(defmethod handle-cast ((server ,name) message current-state)
,(if cast-handler cast-handler nil))))
When used the error says that 'message' is not known.
I'm not sure. 'message' is the name of a parameter of defgeneric:
(defgeneric handle-call (gserver message current-state))
Using the macro I see a warning 'undefined variable message':
(defgserver foo :call-handler
(progn
(print message)))
; in: DEFGSERVER FOO
; (PRINT MESSAGE)
;
; caught WARNING:
; undefined variable: COMMON-LISP-USER::MESSAGE
Which when used has this consequence:
CL-USER> (defvar *my* (make-instance 'foo))
*MY*
CL-USER> (call *my* "Foo")
<WARN> [10:55:10] cl-gserver gserver.lisp (handle-message fun5) -
Error condition was raised on message processing: CL-GSERVER::C: #<UNBOUND-VARIABLE MESSAGE {1002E24553}>
So something has to happen with message and/or current-state.
Should they be interned into the current package where the macro is used?
Manfred
The problem, as mentioned, is that you are talking about different symbols.
However this is really a symptom of a more general problem: what you are trying to do is a sort of anaphora. If you fixed up the package structure so this worked:
(defgserver foo :call-handler
(progn
(print message)))
Then, well, what exactly is message? Where did it come from, what other bindings exist in that scope? Anaphora can be useful, but it also can be a source of obscure bugs like this.
So, I think a better way to do this, which avoids this problem is to say that the *-handler options should specify what arguments they expect. So instead of the above form you'd write something like this:
(defgserver foo
:call-handler ((server message state)
(print message)
(detonate server)))
So here, value of the :call-handler-option is the argument list and body of a function, which the macro will turn into a method specialising on the first argument. Because the methods it creates have argument lists provided by the user of the macro there's never a problem with names, and there is no anaphora.
So, one way to do that is to do two things:
make the default values of these options be suitable for processing into methods without any special casing;
write a little local function in the macro which turns one of these specifications into a suitable (defmethod ...) form.
The second part is optional of course, but it saves a little bit of code.
In addition to this I've also done a slightly dirty trick: I've changed the macro definition so it has an &body option, the value of which is ignored. The only reason I've done this is to help my editor indent it better.
So, here's a revised version:
(defmacro defgserver (name &body forms &key
(call-handler '((server message current-state)
(declare (ignorable
server message current-state))
nil))
(cast-handler '((server message current-state)
(declare (ignorable
server message current-state))
nil)))
"TODO: needs firther testing. Convenience macro to more easily
create a new `gserver' class."
(declare (ignorable forms))
(flet ((write-method (mname mform)
(destructuring-bind (args &body decls/forms) mform
`(defmethod ,mname ((,(first args) ,name) ,#(rest args))
,#decls/forms))))
`(progn
(defclass ,name (gserver) ())
,(write-method 'handle-call call-handler)
,(write-method 'handle-cast cast-handler))))
And now
(defgserver foo
:call-handler ((server message state)
(print message)
(detonate server)))
Expands to
(progn
(defclass foo (gserver) nil)
(defmethod handle-call ((server foo) message state)
(print message)
(detonate server))
(defmethod handle-cast ((server foo) message current-state)
(declare (ignorable server message current-state))
nil))
The URI structure of my website changed drastically recently and I need to redirect all of the old pages to their corresponding new pages. I have a dotted list of pairs of all of the old and new URIs. At the moment I am trying to define easy handlers for each in a loop:
(let ((redirects '(("/old/uri/example-1" . "/new/uri/example-1"))))
(dolist (redirect redirects)
(hunchentoot:define-easy-handler (???? :uri (first redirect)) ()
(redirect (rest redirect)))
))
Maybe there is a better way. Assuming define-easy-handler is correct, it requires a function symbol for each easy handler. I tried the following to no avail:
Placing a (gensym) where it expects a function symbol
Using lists rather than dotted lists and calling (first redirect) where it expects a symbol
Placing a quasiquote around the whole thing and an unquote around (first redirect)
What would be a good way to accomplish this?
Let's guess: DEFINE-EASY-HANDLER is a macro.
Three typical ways to solve that:
call the underlying layer instead and don't use the macro - if the underlying layer is available for the programmer
write and use a macro which
expands (defredirects (a . a1) (b . b1) (c . c1))) into
(progn
(hunchentoot:define-easy-handler (f-a ... a) () (... a1))
(hunchentoot:define-easy-handler (f-b ... b) () (... b1))
(hunchentoot:define-easy-handler (f-c ... c) () (... c1)))
Generate the form you want to call and use eval (or compile and funcall if possible) in the loop for each form.
Although you already solved the problem I figured I might add this as an alternative. If you don't want to make a whole custom acceptor, you can add an around-method on HUNCHENTOOT:ACCEPTOR-DISPATCH-REQUEST for HUNCHENTOOT:EASY-HANDLER.
Let's make an acceptor and one page first:
(defparameter *acceptor* (make-instance 'hunchentoot:easy-acceptor :port 4242))
(hunchentoot:define-easy-handler (foo :uri "/foo") ()
(format nil "<html><body><h1>Test</h1><p>foo</p></body></html>"))
(hunchentoot:start *acceptor*)
Then redirect /bar and /quux to /foo:
;; A simple helper to create prefix dispatchers.
(defun make-redirect-list (redirects)
(mapcar (lambda (redirect)
(destructuring-bind (from . to) redirect
(hunchentoot:create-prefix-dispatcher from
(lambda ()
(hunchentoot:redirect to)))))
redirects))
(defparameter *redirects* (make-redirect-list
'(("/bar" . "/foo")
("/quux" . "/foo"))))
(defmethod hunchentoot:acceptor-dispatch-request :around
((acceptor hunchentoot:easy-acceptor) request)
(dolist (redirect *redirects*)
;; Match the request against the prefix dispatchers in *REDIRECTS*...
(let ((handler (funcall redirect request)))
(when handler
;; and call the corresponding handler if a match is found.
(return-from hunchentoot:acceptor-dispatch-request
(funcall handler)))))
;; Unless a handler was found, call next method to
;; handle the request normally.
(call-next-method))
Edit: Use around method instead of before. I initially figured that letting it call the main method normally would be necessary for any logging/etc. happening there, but after further testing it doesn't seem to be.
This solution works. I definitely appreciate feedback regarding whether or not it's best practice.
(defun add-redirect (name from to)
(eval `(hunchentoot:define-easy-handler (,name :uri ,from) ()
(redirect ,to))))
(defun add-redirects (redirects)
(dolist (redirect redirects)
(add-redirect (first redirect) (second redirect) (third redirect))
))
(add-redirects
'(
(redirect-1 "/redirect-1/" "/destination-1/")
(redirect-2 "/redirect-2/" "/destination-2/")
(redirect-3 "/redirect-3/" "/destination-3/")
))
I'm working my way through Lisp For The Web by Adam Tornhill and I'm stuck at generating a html page with an li element in it.
(with-html-output (*standard-output* nil :prologue t :indent t)
(htm
(:li (:a :href "Link" "Vote!")
)))
When I compile it the following output is printed to the REPL
(with-html-output (*standard-output* nil :prologue t :indent t)
(htm
(:li (:a :href "Link" "Vote!")
)))
<!DOCTYPE html>
<li>
<a href='Link'>Vote!
</a>
</li>
"
<li>
<a href='Link'>Vote!
</a>
</li>"
The string at the end of the output usually is not added and a site including this does not render in hunchentoot. Adding :ol around :li does not help and I wanted to keep the example minimal.
The code from the book as reference:
(define-easy-handler (retro-games :uri "/retro-games") ()
(standard-page (:title "Top Retro Games")
(:h1 "Vote on your all time favourite retro games!")
(:p "Missing a game? Make it available for votes " (:a :href "new-game" "here"))
(:h2 "Current stand")
(:div :id "chart" ; Used for CSS styling of the links.
(:ol
(dolist (game (games))
(htm
(:li (:a :href (format nil "vote?name=~a" (escape-string ; avoid injection attacks
(name game))) "Vote!")
(fmt "~A with ~d votes" (name game) (votes game)))))))))
What you see first is what the form prints to *standard-output* when evaluated. The string seen after that is the form's result, printed by the REPL. As your Hunchentoot handler is only interested in what goes to the output stream, the result does not matter.
To simply get the result as string, you can use with-html-output-to-string:
(with-html-output-to-string (str nil :prologue t :indent t)
(htm
(:li (:a :href "Link" "Vote!"))))
On the other hand, to suppress the result string and only see the document as written out, you can do something like this:
(progn
(with-html-output (*standard-output* nil :prologue t :indent t)
(htm
(:li (:a :href "Link" "Vote!"))))
(values))