First commit!

The wonderful beginnings of a new blog powered by Haunt!
author: David Thompson <dthompson2@worcester.edu> 2016-03-27 11:59:14 -0400
committer: David Thompson <dthompson2@worcester.edu> 2016-03-27 11:59:14 -0400
commit: 9934cc80b087ce9b71a87baaa77068fbd23445ce (patch)
tree: 0ad991cec55a7fe492f07e22c03d411fd7229a18 /posts/2015-04-10-sxml-html-guile.skr
1 files changed, 235 insertions, 0 deletions
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
+   "<foo><bar attr=\"something\" /></foo>"))
+
+ (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
+   "<html>
+  <head>
+    <title>Hello, world!</title>
+    <script src=\"foo.js\" /> <!-- what? -->
+  </head>
+  <body>
+    <h1>Hello!</h1>
+  </body>
+</html>"))
+
+ (p [That ,(code [<script>]) tag doesn’t look right!  Script tags
+          don’t close themselves like that.  Well, we could hack around it:])
+
+ (source-code
+  (scheme-source
+   "(sxml->xml
+ '(html
+   (head
+    (title \"Hello, world!\")
+    (script (@ (src \"foo.js\")) \"\"))
+   (body
+    (h1 \"Hello!\"))))"))
+
+ (source-code
+  (xml-source
+   "<html>
+  <head>
+    <title>Hello, world!</title>
+    <script src=\"foo.js\"></script>
+  </head>
+  <body>
+    <h1>Hello!</h1>
+  </body>
+</html>"))
+
+ (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 [<!DOCTYPE html>]).  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 <davet@gnu.org>\"))"))
+
+ (source-code
+  (xml-source
+   "<script src=\"foo.js\"></script>
+Copyright © 2015  David Thompson &lt;davet@gnu.org&gt;"))
+
+ (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 <davet@gnu.org>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+(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 \"</~a>\" tag))))
+
+(define (doctype->html doctype port)
+  (format port \"<!DOCTYPE ~a>\" 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))))")))
author	David Thompson <dthompson2@worcester.edu>	2016-03-27 11:59:14 -0400
committer	David Thompson <dthompson2@worcester.edu>	2016-03-27 11:59:14 -0400
commit	9934cc80b087ce9b71a87baaa77068fbd23445ce (patch)
tree	0ad991cec55a7fe492f07e22c03d411fd7229a18 /posts/2015-04-10-sxml-html-guile.skr