This time we said that we would talk about extracting the parameters from the query string and rendering the table. The string (srfi-13) and character set (srfi-14) SRFIs make it very easy to parse the query string.
(string-tokenize *query-string* (char-set-complement (char-set #\= #\&)))
We are not quite ready to talk about passing data from one page to another so we won’t discuss this any further until next time. How about rendering the table? Concatenating strings is messy and error-prone. We need some helper functions. e.g. let’s say there was a function tag that took a tag name, some attributes and content and formatted it into HTML. How would we want that to look? Maybe something like this?
(tag 'br) --> <br/>
(tag 'a '(href "www.google.com") "google") --> <a href="www.google.com">google</a>
(tag 'tr '() (tag 'td '() "hello")) --> "<tr><td>hello</td></tr>"
First of all, we need something to convert attributes into a string. Perhaps we might want multiple attributes or an attribute may want to concatenate a number of elements together:
e.g.
(list 'href "data=" data "&xyz=" xyz)
(define (attributes->string attributes)
(if (pair? attributes)
(let ((h (car attributes))
(t (cdr attributes)))
(if (pair? h)
(string-join (map attributes->string attributes) " ")
(string-append (symbol->string h)
"="
(qstr (string-concatenate t)))))
""))
A little helper function prefixes the attributes with a space if they result in a non-empty string.
(define (prefix-space s)
(if (and (string? s)
(> (string-length s) 0))
(string-append " " s) ""))
We may not want to pass all of the parameters in so only the tag name is compulsory. Everything else is passed into args as a list. We then extract the appropriate variables parameters if there are any.
(define (tag name . args)
(let* ((s-name (symbol->string name))
(args-len (length args))
(s-attributes (if (>= args-len 1)
(attributes->string (first args)) ""))
(s-content (if (>= args-len 2)
(string-concatenate (cdr args)) ""))
(content-length (string-length s-content)))
(string-append "<" s-name
(prefix-space s-attributes)
(if (> content-length 0)
(string-append ">" s-content
"</" s-name ">")
"/>"))))
srfi-13 provides some convenience functions for concatenating lists of strings and joining strings together.
I briefly thought about providing a nicer interface with two functions providing a tag interface without attributes and with attributes respectively and delegating to a similar function to the one above.
(define (tag name . args) ...)
(define (tag-attribs name . args) ...)
Alternatively the keyword library can be used to make a nicer interface:
(require (lib "kw.ss"))
(define/kw (tag/kw tag-name #:key attributes (content ""))
(tag tag-name attributes content))
This would then be called like this:
(print-ln (tag/kw 'x #:attributes '(a "b")))
(print-ln (tag/kw 'td #:content "hi"))
Now that we have a tag function, we can use it to render a table. A basic table is straight-forward enough. We map a render row function across each table row, joining the result with string-join. The render row maps a function that surrounds each element with <td> … </td> string-concatenates that, and surrounds that with <tr> … </tr>. We want to alternate different classes to each row and closures are great for this. We provide a function that returns a closure that returns a different id each call.
(define (id-generator ids)
(let ((i -1)
(ids (list->vector ids))
(len (length ids)))
(lambda ()
(set! i (+ i 1))
(vector-ref ids (remainder i len)))))
We can the use this generator to pass a different id to the row renderer for each row in the table.
(define (render-table-row row . tr-class)
(let ((tr-attribs (if (null? tr-class) '()
(list 'class (car tr-class)))))
(tag 'tr tr-attribs
(string-concatenate (map (lambda (e) (tag 'td '() e)) row)))))
(define (render-table table . ids)
(let ((columns (table-columns table))
(data (table-data table))
(f-row (if (null? ids)
render-table-row
(let ((f (id-generator (map symbol->string (car ids)))))
(lambda (e)
(render-table-row e (f)))))))
(tag 'table '() (string-join (map f-row data) "\n"))))
And here is a little test function:
(print-ln (render-table (make-table
'("a" "b" "c")
'(("1" "2" "3")
("4" "5" "6")
("7" "8" "9")))
'(id0 id1)))
I’m not really happy with the interface yet so maybe I’ll look at fixing that next time along with passing data from one page to the next and sorting based on the columns.
Postscript: Danny Yoo mentioned an xml library I need to look into to see if it will replace (tag …) and related functions. The uri-codec library replaces a lot of the code from the earlier article.
(define *encodings-list*
'((%20 " ")
(+a "&")
(+e "=")
(+p "+")
(+q "\"")
(+r "\r\n")))
(define *hash* (make-hash-table 'equal))
(for-each (lambda (e)
(let ((k (symbol->string (car e)))
(v (second e)))
(hash-table-put! *hash* k v)
(hash-table-put! *hash* v k)))
*encodings-list*)
(define (encode-chars regex s)
(pregexp-replace* regex s
(lambda (k)
(hash-table-get *hash* k))))
The data-encode and data-decode functions also become simpler as they now use the uri-encode and uri-decode functions.
(define (data-encode data)
(let ((i (open-input-string data))
(o (open-output-bytes)))
(deflate i o)
(let ((r (base64-encode (get-output-bytes o))))
(uri-encode (bytes->string/utf-8
(subbytes r 0 (- (bytes-length r) 2)))))))
(define (data-decode data)
(let ((i (open-input-bytes
(base64-decode
(string->bytes/utf-8
(uri-decode data)))))
(o (open-output-string)))
(inflate i o)
(get-output-string o)))
Read Full Post »
A Curious Programmer 
