Add XSLT stylesheet support (closes #6)

Author: otherjoel

splitflap-doc/mod-splitflap.scrbl

@@ -4,9 +4,11 @@
    "misc.rkt"
    scribble/examples
    (for-label splitflap 
-              (except-in gregor date? date) 
+              (except-in gregor date? date)
+              (only-in net/url url?)
               racket/base 
               racket/promise
+              (only-in racket/string non-empty-string?)
               txexpr
               xml)
    (for-syntax racket/base racket/syntax))
@@ -103,10 +105,20 @@ The @racket[_feed-url] argument must be supplied as a valid URL string when @rac
 It is not a required argument when @racket[_data] is any other type, and in those cases it will be
 ignored if supplied.
 
-If the parameter @racket[include-generator?] is @racket[#t], a @tt{generator} element will be
-included in complete feeds. If the parameter @racket[feed-language] is not set to @racket[#f], it
-will be used as the language code for the feed; otherwise the result of @racket[(force
-system-language)] is used.
+For complete feeds (e.g., when @racket[_data] is a @racket[feed] or @racket[podcast]) the output can
+be further affected by other parameters. View their documentation for more information.
+
+@itemlist[#:style 'compact
+
+@item{If @racket[include-generator?] is @racket[#t], a @tt{generator} element will be included.}
+
+@item{If @racket[feed-language] is not @racket[#f], its value will be used as the language code for
+the feed; otherwise the result of @racket[(force system-language)] is used.}
+
+@item{If @racket[feed-xslt-stylesheet] is not @racket[#f], its value will be used as the path to a
+stylesheet for the feed.}
+
+]
 
 @examples[#:eval mod-feed
           (define item
@@ -139,6 +151,23 @@ A parameter that, when not set to @racket[#f], is used by @racket[express-xml] a
 
 }
 
+@defparam[feed-xslt-stylesheet path (or/c url? non-empty-string? #f) #:value #f]{
+
+If this parameter is not @racket[#f], @racket[express-xml] will use its value as the path to an
+@link["https://en.wikipedia.org/wiki/XSLT"]{XSLT stylesheet} in the prolog of the XML document
+produced for a @racket[feed] or @racket[podcast].
+
+Generally, the XSLT file must be served from the same domain as the feed itself, otherwise the
+styling will not be applied.
+
+@margin-note{Stylesheets can solve the problem of feeds looking and behaving in unfriendly ways when
+accessed directly in a web browser. See
+@link["https://github.com/genmon/aboutfeeds/issues/8#issuecomment-673293655"]{this Github issue} for
+examples of people who have used XSLT stylesheets to add informative links and a welcoming layout to
+their feeds.}
+
+}
+
 @section{Podcasts}
 
 Splitflap provides some special data types for podcast feeds: @racket[episode] and

splitflap-lib/private/dust.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 
 (require (for-syntax racket/base)
+         (only-in net/url url? url->string)
          racket/file
          racket/list
          racket/match
@@ -37,10 +38,23 @@
   (check-equal? (as-cdata '(div (p "Hi ]]> whoops how did that get there")))
                 (cdata 'racket 'racket "<![CDATA[<div><p>Hi ]]&gt; whoops how did that get there</p></div>]]>")))
 
+;; Optional path to XSLT stylesheet
+(define feed-xslt-stylesheet (make-parameter #f))
+
 ;; Convert an x-expression to a complete XML document
 (define (xml-document xpr)
+  (define xslt-path
+    (match (feed-xslt-stylesheet)
+      [(? url? u) (url->string u)]
+      [v v]))
+  (define xml-processing
+    (cons (p-i 'racket 'racket 'xml "version=\"1.0\" encoding=\"UTF-8\"")
+          (if xslt-path
+              (list (p-i 'racket 'racket 'xml-stylesheet
+                         (format "href=\"~a\" type=\"text/xsl\"" xslt-path)))
+              '())))
   (document
-   (prolog (list (p-i 'racket 'racket 'xml "version=\"1.0\" encoding=\"UTF-8\"")) #f '())
+   (prolog xml-processing #f '())
    (xexpr->xml xpr)
    '()))
 
@@ -135,9 +149,9 @@
   `(,element
     ,@(if/sp (and (txexpr? content) (eq? dialect 'atom)) `[[type "html"]])
     ,(cond
-      [(string? content)
-       (let ([result (as-cdata content)]) (if preserve-cdata-struct? result (cdata-string result)))]
-      [else (txexpr->safe-content-str content)])))
+       [(string? content)
+        (let ([result (as-cdata content)]) (if preserve-cdata-struct? result (cdata-string result)))]
+       [else (txexpr->safe-content-str content)])))
 
 (module+ test
   (define content2 "<div>Hi ]]> whoops how did that get there</div>")

splitflap-lib/private/feed.rkt

@@ -6,19 +6,22 @@
          "xml-generic.rkt"
          "validation.rkt"
          gregor
+         (only-in net/url url?)
          txexpr
          racket/contract
          racket/generic
          racket/list
          racket/match
          racket/promise
          racket/runtime-path
+         (only-in racket/string non-empty-string?)
          setup/getinfo
          xml)
 
-(provide feed-language
-         food?
+(provide food?
          (contract-out
+          [feed-xslt-stylesheet (parameter/c (or/c non-empty-string? url? #f))]
+          [feed-language (parameter/c (or/c iso-639-language-code? #f))]
           [rename make-feed-item feed-item
                   (->* (tag-uri? valid-url-string? string? person? moment? moment? xexpr?)
                        ((or/c enclosure? #f))
@@ -55,16 +58,9 @@
          include-generator?
          express-xml)
 
-
 ;; ~~ Ancillary elements ~~~~~~~~~~~~~~~~~~~~~~~~~
 
-(define feed-language
-  (make-parameter
-   #f
-   (λ (v)
-     (unless (or (iso-639-language-code? v) (not v))
-       (raise-argument-error 'feed-locale "either iso-639-language-code? or #false" v))
-     v)))
+(define feed-language (make-parameter #f))
 
 ;; Build the <generator> tag (caches for each dialect)
 (define generator

splitflap-lib/tests.rkt

@@ -4,6 +4,7 @@
 
 (require "main.rkt"
          gregor
+         net/url
          rackunit)
 
 (define site-id (mint-tag-uri "example.com" "2007" "blog"))
@@ -91,6 +92,42 @@ END
   (check-equal? (express-xml f1 'atom "https://example.com/feed.atom") expect-feed-atom)
   (check-equal? (express-xml f1 'rss "https://example.com/feed.rss") expect-feed-rss))
 
+;; Setup: XSLT Stylesheet inclusion
+(define expect-feed-atom-xslt #<<END
+<?xml version="1.0" encoding="UTF-8"?>
+<?xml-stylesheet href="/feed.xsl" type="text/xsl"?>
+
+<feed xmlns="http://www.w3.org/2005/Atom" xml:lang="en">
+  <title type="text">Kate Poster Posts</title>
+  <link rel="self" href="https://example.com/feed.atom" />
+  <link rel="alternate" href="https://example.com/" />
+  <updated>2007-03-17T00:00:00Z</updated>
+  <id>tag:example.com,2007:blog</id>
+  <entry>
+    <title type="text">Kate's First Post</title>
+    <link rel="alternate" href="https://example.com/blog/one.html" />
+    <updated>2007-03-17T00:00:00Z</updated>
+    <published>2007-03-17T00:00:00Z</published>
+    <link rel="enclosure" type="audio/x-m4a" length="1234" href="gopher://umn.edu/greeting.m4a" />
+    <author>
+      <name>Kate Poster</name>
+      <email>kate@example.com</email>
+    </author>
+    <id>tag:example.com,2007:blog.one</id>
+    <content type="html">&lt;div&gt;&lt;p&gt;Welcome to my blog.&lt;/p&gt;&lt;ul&gt;&lt;li&gt;&amp;amp; ' &amp;lt; &amp;gt; © ℗ ™&lt;/li&gt;&lt;/ul&gt;&lt;/div&gt;</content>
+  </entry>
+</feed>
+END
+)
+
+;; Check expected results of setting feed-xslt-stylesheet to a string and a url struct
+(parameterize ([include-generator? #f]
+               [feed-language 'en])
+  (parameterize ([feed-xslt-stylesheet "/feed.xsl"])
+    (check-equal? (express-xml f1 'atom "https://example.com/feed.atom") expect-feed-atom-xslt))
+  (parameterize ([feed-xslt-stylesheet (string->url "/feed.xsl")])
+    (check-equal? (express-xml f1 'atom "https://example.com/feed.atom") expect-feed-atom-xslt)))
+
 ;; Setup: Duplicate tag URIs cause exception at time of feed construction
 (define entry2-suffix "conflict")
 (define entry2