vegashacker / leftparen

Click here to lend your support to: leftparen and make a donation at www.pledgie.com !

An easy way to make web apps (in PLT Scheme)

This URL has Read+Write access

leftparen / feed.ss
raw normal view history
07a8ded1 » vegashacker 2008-11-24 moved rss.ss and atom.ss in... 1 #lang scheme/base
2
3 (require "time.scm"
4 "util.scm"
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 5 "contract-lp.ss"
af0a5496 » vegashacker 2009-01-08 added web-export for conven... 6 "web-export.ss"
07a8ded1 » vegashacker 2008-11-24 moved rss.ss and atom.ss in... 7 "web-support.scm"
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 8 "settings.scm"
af0a5496 » vegashacker 2009-01-08 added web-export for conven... 9 "page.scm")
07a8ded1 » vegashacker 2008-11-24 moved rss.ss and atom.ss in... 10
c144229e » vegashacker 2008-11-25 added contracts to some fee... 11 (provide ;; atom-feed (via contract)
12 ;; atom-item (via contract)
07a8ded1 » vegashacker 2008-11-24 moved rss.ss and atom.ss in... 13
c144229e » vegashacker 2008-11-25 added contracts to some fee... 14 ;; rss-feed (via contract)
15 ;; rss-item (via contract)
16 )
07a8ded1 » vegashacker 2008-11-24 moved rss.ss and atom.ss in... 17
c144229e » vegashacker 2008-11-25 added contracts to some fee... 18 (define-struct atom-item (title url updated content))
19 (define-struct rss-item (title url content))
20
21 ;;
22 ;; atom-feed
23 ;;
24 ;; Generate an Atom 1.0 feed.
25 ;;
26 (provide/contract
27 (atom-feed (->* (page? #:feed-title string? #:feed-updated/epoch-seconds integer?
28 #:author-name string?)
29 (#:feed-description (or/c #f string?) #:feed-id string?
30 #:related-content-link string? #:items (listof atom-item?))
31 response/full?)))
12fc417f » vegashacker 2008-11-26 got rid of dead rss-inc fn ... 32 ;;
c144229e » vegashacker 2008-11-25 added contracts to some fee... 33 (define (atom-feed atom-feed-page
34 #:feed-title feed-title
35 #:feed-updated/epoch-seconds feed-updated
36 #:author-name author-name
37 #:feed-description (feed-description #f)
38 #:feed-id (feed-id (page-url atom-feed-page #:absolute #t))
39 #:related-content-link (related-content-link (setting *WEB_APP_URL*))
40 #:items (atom-items '()))
07a8ded1 » vegashacker 2008-11-24 moved rss.ss and atom.ss in... 41 (list-response #:type #"text/xml"
42 (list (raw-str "<?xml version=\"1.0\" encoding=\"utf-8\"?>")
43 `(feed ((xmlns "http://www.w3.org/2005/Atom"))
c144229e » vegashacker 2008-11-25 added contracts to some fee... 44 (id ,feed-id)
07a8ded1 » vegashacker 2008-11-24 moved rss.ss and atom.ss in... 45 (title ,feed-title)
c144229e » vegashacker 2008-11-25 added contracts to some fee... 46 ,@(splice-if feed-description `(subtitle ,feed-description))
47 (link ((href ,(page-url atom-feed-page #:absolute #t))
48 (rel "self")))
49 (link ((href ,related-content-link) (rel "alternate")))
50 (updated ,(atom-time-str feed-updated))
51 (author (name ,author-name))
52 ,@(map atom-item-markup atom-items)))))
07a8ded1 » vegashacker 2008-11-24 moved rss.ss and atom.ss in... 53
c144229e » vegashacker 2008-11-25 added contracts to some fee... 54 ;;
55 ;; atom-item
56 ;;
57 ;; A way to make atom-items (which are passed into #:items of atom-feed).
58 ;;
59 (provide/contract
60 (rename construct-atom-item atom-item (->* (#:title string? #:url string?
61 #:updated-epoch-seconds integer?)
62 (#:content (or/c #f string?))
63 atom-item?)))
64 ;;
65 (define (construct-atom-item #:title title #:url url #:updated-epoch-seconds updated
66 #:content (content #f))
67 (make-atom-item title url updated content))
68
69 (define (atom-item-markup atom-item)
70 (let ((url (atom-item-url atom-item)))
71 `(entry (title ,(atom-item-title atom-item))
72 (link ((href ,url) (rel "self")))
73 (id ,url)
74 (updated ,(atom-time-str (atom-item-updated atom-item)))
75 ,@(splice-if (aand (atom-item-content atom-item) `(content ,it))))))
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 76
372b34e6 » vegashacker 2008-11-24 comment cleanup and some si... 77 ;;
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 78 ;; rss-feed
372b34e6 » vegashacker 2008-11-24 comment cleanup and some si... 79 ;;
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 80 ;; Generate an RSS 1.0 feed.
372b34e6 » vegashacker 2008-11-24 comment cleanup and some si... 81 ;;
c144229e » vegashacker 2008-11-25 added contracts to some fee... 82 (provide/contract
83 (rss-feed (->* (page? #:feed-title string? #:feed-description string?)
84 (#:related-content-link string? #:items (listof rss-item?))
85 response/full?)))
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 86 ;;
87 (define (rss-feed rss-feed-page
88 #:feed-title feed-title
89 #:feed-description feed-description
c144229e » vegashacker 2008-11-25 added contracts to some fee... 90 #:related-content-link (related-content-link (setting *WEB_APP_URL*))
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 91 #:items (rss-items '()))
372b34e6 » vegashacker 2008-11-24 comment cleanup and some si... 92 (list-response #:type #"text/xml"
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 93 (list (raw-str "<?xml version=\"1.0\" encoding=\"utf-8\"?>")
07a8ded1 » vegashacker 2008-11-24 moved rss.ss and atom.ss in... 94 `(rdf:RDF
95 ((xmlns "http://purl.org/rss/1.0/")
96 (xmlns:rdf "http://www.w3.org/1999/02/22-rdf-syntax-ns#"))
c144229e » vegashacker 2008-11-25 added contracts to some fee... 97 (channel ((rdf:about ,(page-url rss-feed-page #:absolute #t)))
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 98 (title ,feed-title)
c144229e » vegashacker 2008-11-25 added contracts to some fee... 99 (link ,related-content-link)
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 100 (description ,feed-description)
c144229e » vegashacker 2008-11-25 added contracts to some fee... 101 (items (rdf:Seq ,@(map rss-li rss-items))))
102 ,@(map rss-item-markup rss-items)))))
372b34e6 » vegashacker 2008-11-24 comment cleanup and some si... 103
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 104 (define (rss-li rss-item)
105 `(rdf:li ((resource ,(rss-item-url rss-item)))))
07a8ded1 » vegashacker 2008-11-24 moved rss.ss and atom.ss in... 106
c144229e » vegashacker 2008-11-25 added contracts to some fee... 107 ;;
108 ;; rss-item
109 ;;
110 ;; A way to make rss-items (which are passed into #:items of rss-feed)
111 ;;
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 112 (provide/contract
113 (rename construct-rss-item rss-item (->* (#:title string? #:url string?)
c144229e » vegashacker 2008-11-25 added contracts to some fee... 114 (#:content (or/c #f string?))
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 115 rss-item?)))
c144229e » vegashacker 2008-11-25 added contracts to some fee... 116 ;;
117 (define (construct-rss-item #:title title #:url url #:content (content #f))
118 (make-rss-item title url content))
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 119
c144229e » vegashacker 2008-11-25 added contracts to some fee... 120 (define (rss-item-markup rss-item)
6d520540 » vegashacker 2008-11-24 code changes to simplify th... 121 (let ((url (rss-item-url rss-item)))
122 `(item ((rdf:about ,url))
123 (title ,(rss-item-title rss-item))
124 (link ,url)
c144229e » vegashacker 2008-11-25 added contracts to some fee... 125 ,@(splice-if (aand (rss-item-content rss-item) `(description ,it))))))