contract-lp.ss @@ -2,28 +2,26 @@ (require "time.scm" "util.scm" + "contract-lp.ss" "web-support.scm" + "settings.scm" + "page.scm" (planet "uuid-v4.ss" ("zitterbewegung" "uuid-v4.plt" 1 0))) (provide atom-item - atom-inc - atom-wrapper + atom-feed - rss-inc - rss-wrapper - rss-item - rss-li) + rss-feed + ;; rss-item (via contract) + ) -(define (atom-inc feed-url) - `(link ((rel "alternate") (type "application/atom+xml") (href ,feed-url)))) - -(define (atom-wrapper feed-title - feed-subtitle - feed-url - url - author-name - author-email - . body) +(define (atom-feed feed-title + feed-subtitle + feed-url + url + author-name + author-email + . body) (list-response #:type #"text/xml" (list (raw-str "<?xml version=\"1.0\" encoding=\"utf-8\"?>") `(feed ((xmlns "http://www.w3.org/2005/Atom")) @@ -44,73 +42,56 @@ (updated ,(atom-time-str (current-seconds))) (summary ,item-summary) (content ,item-content))) + ;; ;; rss-inc ;; -;; Function to include the browser feed autodiscovery link in your page. +;; Function to include the browser feed auto-discovery link in your page. ;; (define (rss-inc feed-url) `(link ((href ,feed-url) (rel "alternate") (type "application/rss+xml") (title "Sitewide RSS Feed")))) ;; -;; rss-wrapper +;; rss-feed ;; -;; Main wrapper function to create an RSS 1.0 feed. +;; Generate an RSS 1.0 feed. ;; -(define (rss-wrapper about - channel-title - channel-link - channel-description - channel-image - item-list - . body) +;(provide/contract +; (rss-feed )) +;; +(define (rss-feed rss-feed-page + #:feed-title feed-title + #:feed-description feed-description + #:original-content-link (original-content-link (setting *WEB_APP_URL*)) + #:items (rss-items '())) (list-response #:type #"text/xml" - (list (raw-str "<?xml version=\"1.0\"?>") + (list (raw-str "<?xml version=\"1.0\" encoding=\"utf-8\"?>") `(rdf:RDF ((xmlns "http://purl.org/rss/1.0/") (xmlns:rdf "http://www.w3.org/1999/02/22-rdf-syntax-ns#")) - (channel - ((rdf:about ,about)) - (title ,channel-title) - (link ,channel-link) - (description - ,channel-description) - (image ((rdf:resource ,channel-image))) - (items - (rdf:Seq - ,@item-list))) - ,@body)))) + (channel ((rdf:about ,(page-url rss-feed-page))) + (title ,feed-title) + (link ,original-content-link) + (description ,feed-description) + (items (rdf:Seq ,@(map rss-li rss-items)))) + ,@(map markup-rss-item rss-items))))) -;; -;; rss-li -;; -;; RSS list element creator. -;; -(define (rss-li resource-link) - `(rdf:li ((resource ,resource-link)))) +(define (rss-li rss-item) + `(rdf:li ((resource ,(rss-item-url rss-item))))) -;; -;; rss-item -;; -;; Creation of RSS items. -;; -(define (rss-item rdf-about item-title item-link item-description) - `(item - ((rdf:about ,rdf-about)) - (title () ,item-title) - (link () ,item-link) - (description () ,item-description))) +(define-struct rss-item (title url description)) -;; -;; rss-textinput -;; -;; Creation of RSS textinput items. -;; -(define (rss-textinput about text-title text-description text-name text-link) - `(textinput - ((rdf:about ,about)) - (title () ,text-title) - (description () ,text-description) - (name () , text-name) - (link () ,text-link))) +(provide/contract + (rename construct-rss-item rss-item (->* (#:title string? #:url string?) + (#:description (or/c #f string?)) + rss-item?))) +(define (construct-rss-item #:title title #:url url #:description (desc #f)) + (make-rss-item title url desc)) + +(define (markup-rss-item rss-item) + (let ((url (rss-item-url rss-item))) + `(item ((rdf:about ,url)) + (title ,(rss-item-title rss-item)) + (link ,url) + ,@(splice-if (aand (rss-item-description rss-item) `(description ,it)))))) feed.ss @@ -56,14 +56,11 @@ form-markup grab-user-input - ;;Feeds + ;; feeds + atom-feed atom-item - atom-inc - atom-wrapper - rss-inc - rss-wrapper + rss-feed rss-item - rss-li ;; records and the data repository rec-prop @@ -145,7 +142,6 @@ ** page-url redirect-to-page - atom-wrapper js-inc css-inc versioned-file-reference leftparen.scm @@ -7,8 +7,7 @@ "web-support.scm" "session.scm" "settings.scm" - "time.scm" - "feed.ss") + "time.scm") (provide define-page define-session-page @@ -17,7 +16,6 @@ ** page-url redirect-to-page - atom-wrapper js-inc css-inc versioned-file-reference @@ -148,6 +146,13 @@ (define (css-inc css-filename) `(link ((rel "stylesheet") (type "text/css") (href ,css-filename)))) +(define (atom-inc feed-url) + `(link ((rel "alternate") (type "application/atom+xml") (href ,feed-url)))) + +(define (rss-inc feed-url #:title (title "RSS feed")) + `(link ((href ,feed-url) (rel "alternate") (type "application/rss+xml") + (title ,title)))) + ;; filename should be relative to htdocs directory ;; XXX I'm not sure this will actually work (does the # trigger a new file refresh?) ;; XXX INDEED IT DOES NOT. We'll have to change the actual filename and then page.scm @@ -4,8 +4,7 @@ (lib "xml.ss" "xml") net/url scheme/serialize - (rename-in scheme/contract - (any c:any)) + "contract-lp.ss" (planet "web.scm" ("soegaard" "web.plt" 2 1)) ) web-support.scm 372b34e661ac5dab24222e3eef4e07ff58b93155 Rob Hunter rob.hunter@gmail.com http://github.com/vegashacker/leftparen/commit/6d520540d7d26d2b7740c7fa94f56465d5920b52 6d520540d7d26d2b7740c7fa94f56465d5920b52 2008-11-24T21:45:24-08:00 2008-11-24T21:45:24-08:00 code changes to simplify the RSS feed interface incl. contracts added; keyword arguments and removal of need to enter redundant info; moved atom-inc and rss-inc into page.scm due to a circular dependency where feed.ss needs to call page-url (from page.scm) c5863988e46ccacfc0b7b517d7184bce3350a8b9 Rob Hunter rob.hunter@gmail.com