From c2e2fb2304e7f10baaf1a3044a01c98b9ae5e161 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 5 Dec 2007 21:00:52 -0500 Subject: [PATCH 1/3] extra/rss now works with some Atom 0.3 feeds --- extra/rss/rss.factor | 64 +++++++++++++++++++++++--------------------- 1 file changed, 34 insertions(+), 30 deletions(-) diff --git a/extra/rss/rss.factor b/extra/rss/rss.factor index da810ee377..40395e720f 100644 --- a/extra/rss/rss.factor +++ b/extra/rss/rss.factor @@ -9,6 +9,9 @@ USING: xml.utilities kernel assocs : ?children>string ( tag/f -- string/f ) [ children>string ] [ f ] if* ; +: any-tag-named ( tag names -- tag-inside ) + f -rot [ tag-named nip dup ] curry* find 2drop ; + TUPLE: feed title link entries ; C: feed @@ -17,50 +20,51 @@ TUPLE: entry title link description pub-date ; C: entry +: rss1.0-entry ( tag -- entry ) + [ "title" tag-named children>string ] keep + [ "link" tag-named children>string ] keep + [ "description" tag-named children>string ] keep + f "date" "http://purl.org/dc/elements/1.1/" + tag-named ?children>string + ; + : rss1.0 ( xml -- feed ) [ "channel" tag-named [ "title" tag-named children>string ] keep "link" tag-named children>string ] keep - "item" tags-named [ - [ "title" tag-named children>string ] keep - [ "link" tag-named children>string ] keep - [ "description" tag-named children>string ] keep - f "date" "http://purl.org/dc/elements/1.1/" - tag-named ?children>string - - ] map ; + "item" tags-named [ rss1.0-entry ] map ; + +: rss2.0-entry ( tag -- entry ) + [ "title" tag-named children>string ] keep + [ "link" tag-named ] keep + [ "guid" tag-named dupd ? children>string ] keep + [ "description" tag-named children>string ] keep + "pubDate" tag-named children>string ; : rss2.0 ( xml -- feed ) "channel" tag-named [ "title" tag-named children>string ] keep [ "link" tag-named children>string ] keep - "item" tags-named [ - [ "title" tag-named children>string ] keep - [ "link" tag-named ] keep - [ "guid" tag-named dupd ? children>string ] keep - [ "description" tag-named children>string ] keep - "pubDate" tag-named children>string - ] map ; + "item" tags-named [ rss2.0-entry ] map ; + +: atom1.0-entry ( tag -- entry ) + [ "title" tag-named children>string ] keep + [ "link" tag-named "href" swap at ] keep + [ + { "content" "summary" } any-tag-named + dup tag-children [ string? not ] contains? + [ tag-children [ write-chunk ] string-out ] + [ children>string ] if + ] keep + { "published" "updated" "issued" "modified" } any-tag-named + children>string ; : atom1.0 ( xml -- feed ) [ "title" tag-named children>string ] keep [ "link" tag-named "href" swap at ] keep - "entry" tags-named [ - [ "title" tag-named children>string ] keep - [ "link" tag-named "href" swap at ] keep - [ - dup "content" tag-named - [ nip ] [ "summary" tag-named ] if* - dup tag-children [ tag? ] contains? - [ tag-children [ write-chunk ] string-out ] - [ children>string ] if - ] keep - dup "published" tag-named - [ nip ] [ "updated" tag-named ] if* - children>string - ] map ; + "entry" tags-named [ atom1.0-entry ] map ; : xml>feed ( xml -- feed ) dup name-tag { @@ -74,7 +78,7 @@ C: entry : download-feed ( url -- feed ) #! Retrieve an news syndication file, return as a feed tuple. - http-get rot 200 = [ + http-get-stream rot 200 = [ nip read-feed ] [ 2drop "Error retrieving newsfeed file" throw From 6b2ed35115588eedbd64128d668cac99055fe711 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 7 Dec 2007 20:06:07 -0500 Subject: [PATCH 2/3] RSS module slightly more flexible --- extra/rss/rss.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/rss/rss.factor b/extra/rss/rss.factor index 40395e720f..f9d7067e58 100644 --- a/extra/rss/rss.factor +++ b/extra/rss/rss.factor @@ -93,7 +93,7 @@ C: entry dup entry-title "title" simple-tag, "link" over entry-link "href" associate contained*, dup entry-pub-date "published" simple-tag, - entry-description "content" simple-tag, + entry-description [ "content" simple-tag, ] when* ] tag, ; : feed>xml ( feed -- xml ) From 4a29e2e70741953345c05f166decc975ae9cbe7a Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 8 Dec 2007 00:16:26 -0500 Subject: [PATCH 3/3] Functions added to sequences.lib; used in shufflers --- extra/sequences/lib/lib-tests.factor | 6 ++++- extra/sequences/lib/lib.factor | 34 ++++++++++++++++++++++++++-- extra/shufflers/shufflers.factor | 15 ++---------- 3 files changed, 39 insertions(+), 16 deletions(-) diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor index 82e2b911c3..72cf9ad9c4 100644 --- a/extra/sequences/lib/lib-tests.factor +++ b/extra/sequences/lib/lib-tests.factor @@ -1,5 +1,5 @@ USING: arrays kernel sequences sequences.lib math -math.functions tools.test ; +math.functions tools.test strings ; [ 4 ] [ { 1 2 } [ sq ] [ * ] map-reduce ] unit-test [ 36 ] [ { 2 3 } [ sq ] [ * ] map-reduce ] unit-test @@ -42,3 +42,7 @@ math.functions tools.test ; [ { 1 9 25 } ] [ { 1 3 5 6 } [ sq ] [ even? ] map-until ] unit-test [ { 2 4 } ] [ { 2 4 1 3 } [ even? ] take-while ] unit-test + +[ { { 0 0 } { 1 0 } { 0 1 } { 1 1 } } ] [ 2 2 exact-strings ] unit-test +[ t ] [ "ab" 4 strings [ >string ] map "abab" swap member? ] unit-test +[ { { } { 1 } { 2 } { 1 2 } } ] [ { 1 2 } power-set ] unit-test diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index e090feffea..f5adccf445 100644 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -1,5 +1,5 @@ -USING: combinators.lib kernel sequences math namespaces -random sequences.private shuffle ; +USING: combinators.lib kernel sequences math namespaces assocs +random sequences.private shuffle math.functions mirrors ; IN: sequences.lib ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -74,3 +74,33 @@ IN: sequences.lib [ not ] compose [ find drop [ head-slice ] when* ] curry [ dup ] swap compose keep like ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + +: exact-strings ( alphabet length -- seqs ) + >r dup length r> exact-number-strings map-alphabet ; + +: strings ( alphabet length -- seqs ) + >r dup length r> number-strings map-alphabet ; + +: nths ( nths seq -- subseq ) + ! nths is a sequence of ones and zeroes + >r [ length ] keep [ nth 1 = ] curry subset r> + [ nth ] curry { } map-as ; + +: power-set ( seq -- subsets ) + 2 over length exact-number-strings swap [ nths ] curry map ; diff --git a/extra/shufflers/shufflers.factor b/extra/shufflers/shufflers.factor index e0c5141029..95567da2ef 100644 --- a/extra/shufflers/shufflers.factor +++ b/extra/shufflers/shufflers.factor @@ -1,25 +1,14 @@ USING: kernel sequences words math math.functions arrays shuffle quotations parser math.parser strings namespaces -splitting effects ; +splitting effects sequences.lib ; IN: shufflers : shuffle>string ( names shuffle -- string ) swap [ [ nth ] curry map ] curry map first2 "-" swap 3append >string ; -: translate ( n alphabet out-len -- seq ) - [ drop /mod ] curry* map nip ; - -: (combinations) ( alphabet out-len -- seq[seq] ) - [ ^ ] 2keep [ translate ] 2curry map ; - -: combinations ( n max-out -- seq[seq] ) - ! This returns a seq of length O(n^m) - ! where and m is max-out - 1+ [ (combinations) ] curry* map concat ; - : make-shuffles ( max-out max-in -- shuffles ) - [ 1+ dup rot combinations [ 2array ] curry* map ] + [ 1+ dup rot strings [ 2array ] curry* map ] curry* map concat ; : shuffle>quot ( shuffle -- quot )