# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1294773591 18000
# Node ID ea0ca570c12128397c0ac82c8d197f241f607ceb
# Parent  2ec84d349838b2bfc11cd6074f9ffdf9ac703dac
Shortcut tag combinators

diff -r 2ec84d349838 -r ea0ca570c121 src/ur/feed.ur
--- a/src/ur/feed.ur	Tue Jan 11 14:05:34 2011 -0500
+++ b/src/ur/feed.ur	Tue Jan 11 14:19:51 2011 -0500
@@ -8,8 +8,9 @@
 
 con tagInternal (attrs :: {Unit}) = option {Attrs : $(mapU string attrs), Cdata : option string}
 
-fun tag [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs))
-    : pattern (tagInternal attrs) {Attrs : $(mapU string attrs), Cdata : option string} =
+fun tagG [attrs ::: {Unit}] [t ::: Type] (fl : folder attrs) (accept : {Attrs : $(mapU string attrs), Cdata : option string} -> option t)
+         (name : string) (attrs : $(mapU string attrs))
+    : pattern (tagInternal attrs) t =
     Transducer {Initial = None,
                 EnterTag = fn tinfo state =>
                               case state of
@@ -28,9 +29,27 @@
                                                       | Some v => Some ({nm = v} ++ r))
                                             (Some {}) fl attrs of
                                           None => None
-                                        | Some vs => Some (Some {Attrs = vs, Cdata = tinfo.Cdata}),
+                                        | Some vs =>
+                                          let
+                                              val v = {Attrs = vs, Cdata = tinfo.Cdata}
+                                          in
+                                              case accept v of
+                                                  None => None
+                                                | Some _ => Some (Some v)
+                                          end,
                 ExitTag = Some,
-                Finished = fn x => x}
+                Finished = Option.bind accept}
+
+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 Some name attrs
+
+fun tagA [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs))
+    : pattern (tagInternal attrs) $(mapU string attrs) =
+    @tagG fl (fn r => Some r.Attrs) name attrs
+
+fun tagC (name : string) : pattern (tagInternal []) string =
+    tagG (fn r => r.Cdata) name {}
 
 datatype status a = Initial | Failed | Matched of a
 
diff -r 2ec84d349838 -r ea0ca570c121 src/ur/feed.urs
--- a/src/ur/feed.urs	Tue Jan 11 14:05:34 2011 -0500
+++ b/src/ur/feed.urs	Tue Jan 11 14:19:51 2011 -0500
@@ -5,6 +5,10 @@
 val tag : attrs ::: {Unit} -> folder attrs -> string -> $(mapU string attrs)
           -> pattern (tagInternal attrs) {Attrs : $(mapU string attrs), Cdata : option string}
 
+val tagA : attrs ::: {Unit} -> folder attrs -> string -> $(mapU string attrs)
+          -> pattern (tagInternal attrs) $(mapU string attrs)
+val tagC : string -> pattern (tagInternal []) string
+
 con childrenInternal :: Type -> {Type} -> Type
 
 val children : parentI ::: Type -> parent ::: Type -> children ::: {(Type * Type)}
diff -r 2ec84d349838 -r ea0ca570c121 src/ur/lib.urp
--- a/src/ur/lib.urp	Tue Jan 11 14:05:34 2011 -0500
+++ b/src/ur/lib.urp	Tue Jan 11 14:19:51 2011 -0500
@@ -6,5 +6,6 @@
 
 $/char
 $/string
+$/option
 $/list
 feed
diff -r 2ec84d349838 -r ea0ca570c121 tests/mr.ur
--- a/tests/mr.ur	Tue Jan 11 14:05:34 2011 -0500
+++ b/tests/mr.ur	Tue Jan 11 14:19:51 2011 -0500
@@ -1,16 +1,11 @@
 fun main () =
     Feed.app (Feed.children
-                  (Feed.tag "item" {1 = "rdf:about"})
-                  (Feed.tag "title" {}, Feed.tag "content:encoded" {}))
-             (fn ({Attrs = {1 = about}, ...},
-                  ({Cdata = title, ...}, {Cdata = content, ...})) =>
-                 debug ("URL: " ^ about);
-                 (case title of
-                      None => return ()
-                    | Some title => debug ("Title: " ^ title));
-                  case content of
-                      None => return ()
-                    | Some content => debug ("Content: " ^ content))
+                  (Feed.tagA "item" {1 = "rdf:about"})
+                  (Feed.tagC "title", Feed.tagC "content:encoded"))
+             (fn (item, props) =>
+                 debug ("URL: " ^ item.1);
+                 debug ("Title: " ^ props.1);
+                 debug ("Content: " ^ props.2))
              "http://feeds.feedburner.com/marginalrevolution/hCQh";
     return <xml>
       See stdout.