# HG changeset patch # User Adam Chlipala # Date 1348929000 14400 # Node ID 7275f59cab611af8a8ab204922a36d390ae8b88a # Parent dd5b333a79607c992319a0b155866a0a407fc63f tagAOR and a Reddit example of using it diff -r dd5b333a7960 -r 7275f59cab61 src/ur/feed.ur --- a/src/ur/feed.ur Sat Jun 23 09:58:31 2012 -0400 +++ b/src/ur/feed.ur Sat Sep 29 10:30:00 2012 -0400 @@ -80,7 +80,17 @@ fun tagAO [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs)) : pattern (tagInternal attrs) $(mapU (option string) attrs) = - @tagG fl (fn r => Some (r.Attrs)) name attrs + @tagG fl (fn r => Some r.Attrs) name attrs + +fun tagAOR [optional ::: {Unit}] [required ::: {Unit}] [optional ~ required] + (ofl : folder optional) (rfl : folder required) + (name : string) (required : $(mapU string required)) (optional : $(mapU string optional)) + : pattern (tagInternal (optional ++ required)) $(mapU string required ++ mapU (option string) optional) = + @tagG (@Folder.concat ! ofl rfl) + (fn r => case @allPresent rfl (r.Attrs --- mapU (option string) optional) of + None => None + | Some req => Some (r.Attrs --- mapU (option string) required ++ req)) + name (required ++ optional) fun tagC (name : string) : pattern (tagInternal []) string = tagG (fn r => r.Cdata) name {} diff -r dd5b333a7960 -r 7275f59cab61 src/ur/feed.urs --- a/src/ur/feed.urs Sat Jun 23 09:58:31 2012 -0400 +++ b/src/ur/feed.urs Sat Sep 29 10:30:00 2012 -0400 @@ -35,6 +35,13 @@ -> pattern (tagInternal attrs) $(mapU (option string) attrs) (* A version of [tagA] that makes each attribute optional *) +val tagAOR : optional ::: {Unit} -> required ::: {Unit} -> [optional ~ required] + => folder optional -> folder required -> string + -> $(mapU string required) -> $(mapU string optional) + -> pattern (tagInternal (optional ++ required)) + $(mapU string required ++ mapU (option string) optional) +(* A version of [tagAO] that does a check for mere presence of other attributes *) + val tagC : string -> pattern (tagInternal []) string (* A version of [tag] that only matches tags with nonempty CDATA and returns * only that text *) diff -r dd5b333a7960 -r 7275f59cab61 tests/reddit.ur --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/reddit.ur Sat Sep 29 10:30:00 2012 -0400 @@ -0,0 +1,27 @@ +fun main () = + doc <- Feed.fetch "http://www.reddit.com/?limit=30"; + + acc <- Feed.app' (Feed.tree (Feed.tagAOR "div" {DataUps = "data-ups", Class = "class"} {Style = "style"}) + (Feed.tagAO "a" {Class = "class", Style = "style", Href = "href"})) + (fn (div, a) (count, list) => + return (case a.Href of + None => (count, list) + | Some link => + if count >= 30 + || not (String.isPrefix {Full = div.Class, Prefix = " thing "}) + || Option.isSome (String.sindex {Haystack = div.Class, Needle = "promoted"}) + || div.Style = Some "display:none" + || a.Class <> Some "title " + || a.Style = Some "display:none" then + (count, list) + else + (count + 1, link :: list))) + doc (0, []); + + return +

Top 30 Reddit Links

+ +
    + {List.mapX (fn url =>
  1. {[url]}
  2. ) (List.rev acc.2)} +
+
diff -r dd5b333a7960 -r 7275f59cab61 tests/reddit.urp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/reddit.urp Sat Sep 29 10:30:00 2012 -0400 @@ -0,0 +1,5 @@ +library ../src/ur/lib +rewrite all Reddit/* + +$/list +reddit diff -r dd5b333a7960 -r 7275f59cab61 tests/reddit.urs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/reddit.urs Sat Sep 29 10:30:00 2012 -0400 @@ -0,0 +1,1 @@ +val main : unit -> transaction page