RSS feed in planet
Slava Pestov
parent
214974ec52
commit
4eb4982e60
|
|
@ -1,41 +1,14 @@
|
|||
USING: sequences rss arrays concurrency kernel sorting
|
||||
html.elements io assocs namespaces math threads vocabs html
|
||||
furnace http.server.templating calendar math.parser splitting
|
||||
continuations debugger system http.server.responders ;
|
||||
continuations debugger system http.server.responders
|
||||
xml.writer ;
|
||||
IN: webapps.planet
|
||||
|
||||
TUPLE: posting author title date link body ;
|
||||
|
||||
: diagnostic write print flush ;
|
||||
|
||||
: fetch-feed ( pair -- feed )
|
||||
second
|
||||
dup "Fetching " diagnostic
|
||||
dup download-feed feed-entries
|
||||
swap "Done fetching " diagnostic ;
|
||||
|
||||
: fetch-blogroll ( blogroll -- entries )
|
||||
#! entries is an array of { author entries } pairs.
|
||||
dup [
|
||||
[ fetch-feed ] [ error. drop f ] recover
|
||||
] parallel-map
|
||||
[ [ >r first r> 2array ] curry* map ] 2map concat ;
|
||||
|
||||
: sort-entries ( entries -- entries' )
|
||||
[ [ second entry-pub-date ] compare ] sort <reversed> ;
|
||||
|
||||
: <posting> ( pair -- posting )
|
||||
#! pair has shape { author entry }
|
||||
first2
|
||||
{ entry-title entry-pub-date entry-link entry-description }
|
||||
get-slots posting construct-boa ;
|
||||
|
||||
: print-posting-summary ( posting -- )
|
||||
<p "news" =class p>
|
||||
<b> dup posting-title write </b> <br/>
|
||||
"- " write
|
||||
dup posting-author write bl
|
||||
<a posting-link =href "more" =class a>
|
||||
<b> dup entry-title write </b> <br/>
|
||||
<a entry-link =href "more" =class a>
|
||||
"Read More..." write
|
||||
</a>
|
||||
</p> ;
|
||||
|
|
@ -63,14 +36,16 @@ TUPLE: posting author title date link body ;
|
|||
|
||||
: print-posting ( posting -- )
|
||||
<h2 "posting-title" =class h2>
|
||||
<a dup posting-link =href a>
|
||||
dup posting-title write-html
|
||||
" - " write
|
||||
dup posting-author write
|
||||
<a dup entry-link =href a>
|
||||
dup entry-title write-html
|
||||
</a>
|
||||
</h2>
|
||||
<p "posting-body" =class p> dup posting-body write-html </p>
|
||||
<p "posting-date" =class p> posting-date format-date write </p> ;
|
||||
<p "posting-body" =class p>
|
||||
dup entry-description write-html
|
||||
</p>
|
||||
<p "posting-date" =class p>
|
||||
entry-pub-date format-date write
|
||||
</p> ;
|
||||
|
||||
: print-postings ( postings -- )
|
||||
[ print-posting ] each ;
|
||||
|
|
@ -83,38 +58,56 @@ TUPLE: posting author title date link body ;
|
|||
SYMBOL: default-blogroll
|
||||
SYMBOL: cached-postings
|
||||
|
||||
: update-cached-postings ( -- )
|
||||
default-blogroll get fetch-blogroll sort-entries
|
||||
[ <posting> ] map
|
||||
cached-postings set-global ;
|
||||
|
||||
: mini-planet-factor ( -- )
|
||||
cached-postings get 4 head print-posting-summaries ;
|
||||
|
||||
: planet-factor ( -- )
|
||||
serving-html [
|
||||
"resource:extra/webapps/planet/planet.fhtml"
|
||||
run-template-file
|
||||
] with-html-stream ;
|
||||
serving-html [ "planet" render-template ] with-html-stream ;
|
||||
|
||||
\ planet-factor { } define-action
|
||||
|
||||
{
|
||||
{ "Berlin Brown" "http://factorlang-fornovices.blogspot.com/feeds/posts/default" "http://factorlang-fornovices.blogspot.com" }
|
||||
{ "Chris Double" "http://www.bluishcoder.co.nz/atom.xml" "http://www.bluishcoder.co.nz/" }
|
||||
{ "Elie Chaftari" "http://fun-factor.blogspot.com/feeds/posts/default" "http://fun-factor.blogspot.com/" }
|
||||
{ "Doug Coleman" "http://code-factor.blogspot.com/feeds/posts/default" "http://code-factor.blogspot.com/" }
|
||||
{ "Daniel Ehrenberg" "http://useless-factor.blogspot.com/feeds/posts/default" "http://useless-factor.blogspot.com/" }
|
||||
{ "Kio M. Smallwood"
|
||||
"http://sekenre.wordpress.com/feed/atom/"
|
||||
"http://sekenre.wordpress.com/" }
|
||||
{ "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" }
|
||||
{ "Samuel Tardieu" "http://www.rfc1149.net/blog/tag/factor/feed/atom/" "http://www.rfc1149.net/blog/tag/factor/" }
|
||||
{ "Slava Pestov" "http://factor-language.blogspot.com/atom.xml" "http://factor-language.blogspot.com/" }
|
||||
} default-blogroll set-global
|
||||
: planet-feed ( -- feed )
|
||||
"[ planet-factor ]"
|
||||
"http://planet.factorcode.org"
|
||||
cached-postings get 30 head <feed> ;
|
||||
|
||||
: feed.xml
|
||||
"text/xml" serving-content
|
||||
planet-feed feed>xml write-xml ;
|
||||
|
||||
\ feed.xml { } define-action
|
||||
|
||||
SYMBOL: last-update
|
||||
|
||||
: diagnostic write print flush ;
|
||||
|
||||
: fetch-feed ( triple -- feed )
|
||||
second
|
||||
dup "Fetching " diagnostic
|
||||
dup download-feed feed-entries
|
||||
swap "Done fetching " diagnostic ;
|
||||
|
||||
: <posting> ( author entry -- entry' )
|
||||
clone
|
||||
[ ": " swap entry-title 3append ] keep
|
||||
[ set-entry-title ] keep ;
|
||||
|
||||
: ?fetch-feed ( triple -- feed/f )
|
||||
[ fetch-feed ] [ error. drop f ] recover ;
|
||||
|
||||
: fetch-blogroll ( blogroll -- entries )
|
||||
dup 0 <column>
|
||||
swap [ ?fetch-feed ] parallel-map
|
||||
[ [ <posting> ] curry* map ] 2map concat ;
|
||||
|
||||
: sort-entries ( entries -- entries' )
|
||||
[ [ entry-pub-date ] compare ] sort <reversed> ;
|
||||
|
||||
: update-cached-postings ( -- )
|
||||
default-blogroll get
|
||||
fetch-blogroll sort-entries
|
||||
cached-postings set-global ;
|
||||
|
||||
: update-thread ( -- )
|
||||
millis last-update set-global
|
||||
[ update-cached-postings ] in-thread
|
||||
|
|
@ -126,14 +119,16 @@ SYMBOL: last-update
|
|||
|
||||
"planet" "planet-factor" "extra/webapps/planet" web-app
|
||||
|
||||
: merge-feeds ( feeds -- feed )
|
||||
[ feed-entries ] map concat sort-entries ;
|
||||
|
||||
: planet-feed ( -- feed )
|
||||
default-blogroll get [ second download-feed ] map merge-feeds
|
||||
>r "[ planet-factor ]" "http://planet.factorcode.org" r> <entry>
|
||||
feed>xml ;
|
||||
|
||||
: feed.xml planet-feed ;
|
||||
|
||||
\ feed.xml { } define-action
|
||||
{
|
||||
{ "Berlin Brown" "http://factorlang-fornovices.blogspot.com/feeds/posts/default" "http://factorlang-fornovices.blogspot.com" }
|
||||
{ "Chris Double" "http://www.bluishcoder.co.nz/atom.xml" "http://www.bluishcoder.co.nz/" }
|
||||
{ "Elie Chaftari" "http://fun-factor.blogspot.com/feeds/posts/default" "http://fun-factor.blogspot.com/" }
|
||||
{ "Doug Coleman" "http://code-factor.blogspot.com/feeds/posts/default" "http://code-factor.blogspot.com/" }
|
||||
{ "Daniel Ehrenberg" "http://useless-factor.blogspot.com/feeds/posts/default" "http://useless-factor.blogspot.com/" }
|
||||
{ "Kio M. Smallwood"
|
||||
"http://sekenre.wordpress.com/feed/atom/"
|
||||
"http://sekenre.wordpress.com/" }
|
||||
! { "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" }
|
||||
{ "Samuel Tardieu" "http://www.rfc1149.net/blog/tag/factor/feed/atom/" "http://www.rfc1149.net/blog/tag/factor/" }
|
||||
{ "Slava Pestov" "http://factor-language.blogspot.com/atom.xml" "http://factor-language.blogspot.com/" }
|
||||
} default-blogroll set-global
|
||||
|
|
|
|||
Loading…
Reference in New Issue