From 9934cc80b087ce9b71a87baaa77068fbd23445ce Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 27 Mar 2016 11:59:14 -0400 Subject: First commit! The wonderful beginnings of a new blog powered by Haunt! --- posts/2015-04-10-sxml-html-guile.skr | 235 +++++++++++++++++++++++++++++++++++ 1 file changed, 235 insertions(+) create mode 100644 posts/2015-04-10-sxml-html-guile.skr (limited to 'posts/2015-04-10-sxml-html-guile.skr') diff --git a/posts/2015-04-10-sxml-html-guile.skr b/posts/2015-04-10-sxml-html-guile.skr new file mode 100644 index 0000000..beea865 --- /dev/null +++ b/posts/2015-04-10-sxml-html-guile.skr @@ -0,0 +1,235 @@ +(post + :title "Rendering HTML with SXML and GNU Guile" + :date (make-date* 2015 04 10) + :tags '("gnu" "guile" "wsu") + :summary "With a little effort, SXML can be used for HTML templates" + + (p [GNU Guile provides modules for working with XML documents called + SXML. SXML provides an elegant way of writing XML documents as + s-expressions that can be easily manipulated in Scheme. Here’s an + example:]) + + (source-code + (scheme-source + "(sxml->xml '(foo (bar (@ (attr \"something\")))))")) + + (source-code + (xml-source + "")) + + (p [I don’t know about you, but I work with HTML documents much more + often than XML. Since HTML is very similar to XML, we should be able + to represent it with SXML, too!]) + + (source-code + (scheme-source + "(sxml->xml + '(html + (head + (title \"Hello, world!\") + (script (@ (src \"foo.js\")))) + (body + (h1 \"Hello!\"))))")) + + (source-code + (xml-source + " + + Hello, world! + + + +

Hello!

+ +")) + + (p [There’s no bug. The improper rendering happens because HTML, while + similar to XML, has some different syntax rules. Instead of using + ,(code [sxml->xml]) a new procedure that is tailored to the HTML syntax + is needed. Introducing ,(code [sxml->html]):]) + + (source-code + (scheme-source + "(define* (sxml->html tree #:optional (port (current-output-port))) + \"Write the serialized HTML form of TREE to PORT.\" + (match tree + (() *unspecified*) + (('doctype type) + (doctype->html type port)) + (((? symbol? tag) ('@ attrs ...) body ...) + (element->html tag attrs body port)) + (((? symbol? tag) body ...) + (element->html tag '() body port)) + ((nodes ...) + (for-each (cut sxml->html <> port) nodes)) + ((? string? text) + (string->escaped-html text port)) + ;; Render arbitrary Scheme objects, too. + (obj (object->escaped-html obj port))))")) + + (p [In addition to being aware of void elements and escape +characters, it can also render ,(code ['(doctype "html")]) as +,(code []). If we replace ,(code [sxml->xml]) +with ,(code [sxml->html]) in the failing example above we can see +that it does the right thing.]) + + (source-code + (scheme-source + "(sxml->html + '((script (@ (src \"foo.js\"))) + \"Copyright © 2015 David Thompson \"))")) + + (source-code + (xml-source + " +Copyright © 2015 David Thompson <davet@gnu.org>")) + + (p [Here’s the full version of my ,(code "(sxml html)") module. It’s +quite brief, which is a nice bonus. This code requires Guile 2.0.11 +or greater.]) + + (p [Happy hacking!]) + + (source-code + (scheme-source + ";;; Copyright © 2015 David Thompson +;;; +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public License +;;; as published by the Free Software Foundation; either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; This library 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 +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this library. If not, see +;;; . + +(define-module (sxml html) + #:use-module (sxml simple) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:use-module (ice-9 hash-table) + #:export (sxml->html)) + +(define %void-elements + '(area + base + br + col + command + embed + hr + img + input + keygen + link + meta + param + source + track + wbr)) + +(define (void-element? tag) + \"Return #t if TAG is a void element.\" + (pair? (memq tag %void-elements))) + +(define %escape-chars + (alist->hash-table + '((#\\\" . \"quot\") + (#\\& . \"amp\") + (#\\' . \"apos\") + (#\\< . \"lt\") + (#\\> . \"gt\")))) + +(define (string->escaped-html s port) + \"Write the HTML escaped form of S to PORT.\" + (define (escape c) + (let ((escaped (hash-ref %escape-chars c))) + (if escaped + (format port \"&~a;\" escaped) + (display c port)))) + (string-for-each escape s)) + +(define (object->escaped-html obj port) + \"Write the HTML escaped form of OBJ to PORT.\" + (string->escaped-html + (call-with-output-string (cut display obj <>)) + port)) + +(define (attribute-value->html value port) + \"Write the HTML escaped form of VALUE to PORT.\" + (if (string? value) + (string->escaped-html value port) + (object->escaped-html value port))) + +(define (attribute->html attr value port) + \"Write ATTR and VALUE to PORT.\" + (format port \"~a=\\\"\" attr) + (attribute-value->html value port) + (display #\\\" port)) + +(define (element->html tag attrs body port) + \"Write the HTML TAG to PORT, where TAG has the attributes in the +list ATTRS and the child nodes in BODY.\" + (format port \"<~a\" tag) + (for-each (match-lambda + ((attr value) + (display #\\space port) + (attribute->html attr value port))) + attrs) + (if (and (null? body) (void-element? tag)) + (display \" />\" port) + (begin + (display #\\> port) + (for-each (cut sxml->html <> port) body) + (format port \"\" tag)))) + +(define (doctype->html doctype port) + (format port \"\" doctype)) + +(define* (sxml->html tree #:optional (port (current-output-port))) + \"Write the serialized HTML form of TREE to PORT.\" + (match tree + (() *unspecified*) + (('doctype type) + (doctype->html type port)) + (((? symbol? tag) ('@ attrs ...) body ...) + (element->html tag attrs body port)) + (((? symbol? tag) body ...) + (element->html tag '() body port)) + ((nodes ...) + (for-each (cut sxml->html <> port) nodes)) + ((? string? text) + (string->escaped-html text port)) + ;; Render arbitrary Scheme objects, too. + (obj (object->escaped-html obj port))))"))) -- cgit v1.2.3