diff options
| -rw-r--r-- | src/html.scm | 162 | ||||
| -rw-r--r-- | tests/html.scm | 35 |
2 files changed, 196 insertions, 1 deletions
diff --git a/src/html.scm b/src/html.scm index 7d37fbd..107b78c 100644 --- a/src/html.scm +++ b/src/html.scm @@ -1,2 +1,162 @@ (define-module (src html) - #:use-module (src mime-types)) + #:use-module (src dates) + #:use-module (srfi srfi-9) + #:use-module (sxml simple) + #:use-module (src mime-types) + #:export (render + person + post + index + media + css + js)) + +(define-record-type <index> + (make-index title description uri author posts styles scripts) + index? + (title index-title) + (description index-description) + (uri index-uri) + (author index-author) + (posts index-posts) + (styles index-styles) + (scripts index-scripts)) + +(define-record-type <post> + (make-post id + title + published + updated + authors + summary-html + content-html + categories + contributors + media) + post? + (id post-id) + (title post-title) + (published post-published) + (updated post-updated) + (authors post-authors) + (summary-html post-summary-html) + (content-html post-content-html) + (categories post-categories) + (contributors post-contributors) + (media post-media)) + +(define-record-type <media> + (make-media type uri path) + media? + (type media-type) + (uri media-uri) + (path media-path)) + +(define-record-type <person> + (make-person name email uri) + person? + (name person-name) + (email person-email) + (uri person-uri)) + + +(define* (index #:key (title "") + (description "") + (uri "") + (author (person "")) + (posts '()) + (styles '()) + (scripts '()) + #:allow-other-keys) + (make-index title description uri author posts styles scripts)) + + +(define* (post #:key (id #f) + (title "") + (published unix-date) + (updated unix-date) + (authors '()) + (summary-html '()) + (content-html '()) + (categories '()) + (contributors '()) + (media '()) + #:allow-other-keys) + + (define (id-from-title title) + (string-map (lambda (c) + (if (char-set-contains? char-set:letter c) c #\-)) + title)) + (make-post (or id (id-from-title title)) + title + published + (find-newest (list published updated)) + authors + summary-html + content-html + categories + contributors + media)) + +(define* (media path #:key (uri "") + #:allow-other-keys) + (define (type path) + (let* ((extension (car (last-pair (string-split path #\.)))) + (type (assoc-ref mime-types extension))) + (if (string? type) type (throw "Unknown mime-type")))) + + (make-media (type path) + uri + path)) + +(define css media) +(define js media) + +(define* (person name #:key (email "") + (uri "") + #:allow-other-keys) + (make-person name email uri)) + +; Rendering +(define (render-author author) + `(address (@(class author)) + (a (@(rel author)) ,(person-name author)))) + +(define (render-post post) + `(article (@(class "post") + (id ,(post-id post))) ;; For anchors + (h2 ,(post-title post)) + (time (@(datetime ,(date->string/RFC3339 (post-published post))) + (pubdate #t)) + ,(date->string/RFC3339 (post-published post))) ;; TODO make human readable + ,@(map render-author (post-authors post)) + (section (@(class summary)) + ,(post-summary-html post)) + (section (@(class content)) + ,(post-content-html post)))) + +(define (render-style style) + ;; TODO it escapes the contents!! if added inline :( + `(link (@(rel stylesheet) + (href ,(media-uri style))))) +(define (render-script script) + ;; TODO it escapes the contents!! if added inline :( + `(script (@(src ,(media-uri script))))) + +(define (render-index index) + `(html + (head + (meta (@(author ,(person-name (index-author index))))) + (meta (@(charset "utf-8"))) + (meta (@(name "viewport") + (content "width=device-width, initial-scale=1"))) + (meta (@(name "description") + (content ,(index-description index)))) + ,@(map render-style (index-styles index))) + (body + ,@(map render-post (index-posts index)) + ,@(map render-script (index-scripts index))))) + +(define (render index) + (display "<!DOCTYPE html>") + (sxml->xml (render-index index))) diff --git a/tests/html.scm b/tests/html.scm new file mode 100644 index 0000000..c5a5967 --- /dev/null +++ b/tests/html.scm @@ -0,0 +1,35 @@ +(define-module (tests html) + #:use-module (src dates) + #:use-module (srfi srfi-64) + #:use-module ((src html) #:prefix html:)) + +(test-begin "HTML index page") + +(define me (html:person "Ekaitz" + #:email "ekaitz@elenq.tech" + #:uri "https://elenq.tech")) +(define index + (html:index #:title "Mi feed" + #:description "Este es mi feed" + #:uri "https://feed.elenq.tech/index.html" + #:styles (list + (html:css "this.css" #:uri "/this.css") + (html:css "that.css" #:uri "/that.css")) + #:scripts (list (html:js "script.js" #:uri "/script.js")) + #:author me + #:posts (list + (html:post #:title "first entry" + #:published (string/ISO->date "2023-03-01") + #:authors (list me) + #:summary-html '(p "Este es el resumen") + #:content-html '(p "Este es el contenido") + #:categories (list "una" "dos" "tres") + #:media (list))))) + + +(let ((html-index (with-output-to-string (lambda () (html:render index))))) + (test-assert (string=? html-index + "<!DOCTYPE html><html><head><meta author=\"Ekaitz\" /><meta charset=\"utf-8\" /><meta name=\"viewport\" content=\"width=device-width, initial-scale=1\" /><meta name=\"description\" content=\"Este es mi feed\" /><link rel=\"stylesheet\" href=\"/this.css\" /><link rel=\"stylesheet\" href=\"/that.css\" /></head><body><article class=\"post\" id=\"first-entry\"><h2>first entry</h2><time datetime=\"2023-03-01T00:00:00+0100\" pubdate=\"#t\">2023-03-01T00:00:00+0100</time><address class=\"author\"><a rel=\"author\">Ekaitz</a></address><section class=\"summary\"><p>Este es el resumen</p></section><section class=\"content\"><p>Este es el contenido</p></section></article><script src=\"/script.js\" /></body></html>"))) + + +(test-end "HTML index page") |