# HG changeset patch
# User Karn Kallio <kkallio@eka>
# Date 1306849909 16200
# Node ID f19beef42ceb5b663e6ef6e78c0f0603245bff15
# Parent  a4e5d053daedee04b63536ddd8dfeef8b7c25a97
Add tag combinator with given attribute values.

diff -r a4e5d053daed -r f19beef42ceb src/ur/feed.ur
--- a/src/ur/feed.ur	Sat Mar 19 14:35:11 2011 -0400
+++ b/src/ur/feed.ur	Tue May 31 09:21:49 2011 -0430
@@ -47,6 +47,16 @@
           | _ => None)
     (Some {}) fl attrs
 
+fun allPresentE [attrs ::: {Unit}] (fl : folder attrs) (vs : $(mapU (option string) attrs)) (attrs : $(mapU (option string) attrs))
+    : option $(mapU string attrs) =
+    @foldUR2 [option string] [option string] [fn attrs => option $(mapU string attrs)]
+    (fn [nm ::_] [r ::_] [[nm] ~ r] os os' acc =>
+        case (os, os', acc) of
+            (Some s, Some s', Some acc) => if s = s' then Some ({nm = s'} ++ acc) else None
+          | (None, Some s', Some acc) => Some ({nm = s'} ++ acc)
+          | _ => None)
+    (Some {}) fl vs attrs
+
 fun tag [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs))
     : pattern (tagInternal attrs) {Attrs : $(mapU string attrs), Cdata : option string} =
     @tagG fl (fn r =>
@@ -58,6 +68,16 @@
 fun tagA [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs))
     : pattern (tagInternal attrs) $(mapU string attrs) =
     @tagG fl (fn r => @allPresent fl r.Attrs) name attrs
+
+fun tagAV [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU (string * option string) attrs))
+    : pattern (tagInternal attrs) $(mapU string attrs) =
+    let
+        val as = @mp [fn _ => (string * option string)] [fn _ => string] (fn [u] (x, _) => x) fl attrs
+        val vs = @mp [fn _ => (string * option string)] [fn _ => option string] (fn [u] (_, x) => x) fl attrs
+    in
+        @tagG fl (fn r => @allPresentE fl vs r.Attrs) name as
+    end
+
 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
diff -r a4e5d053daed -r f19beef42ceb src/ur/feed.urs
--- a/src/ur/feed.urs	Sat Mar 19 14:35:11 2011 -0400
+++ b/src/ur/feed.urs	Tue May 31 09:21:49 2011 -0430
@@ -26,6 +26,11 @@
           -> pattern (tagInternal attrs) $(mapU string attrs)
 (* A version of [tag] that ignores CDATA *)
 
+val tagAV : attrs ::: {Unit} -> folder attrs -> string -> $(mapU (string * option string) attrs)
+            -> pattern (tagInternal attrs) $(mapU string attrs)
+(* Extension of tagA with optional specification of values which attributes must
+ * bear in order to count as a match. *)
+
 val tagAO : attrs ::: {Unit} -> folder attrs -> string -> $(mapU string attrs)
             -> pattern (tagInternal attrs) $(mapU (option string) attrs)
 (* A version of [tagA] that makes each attribute optional *)