diff src/ur/feed.ur @ 3:ea0ca570c121

Shortcut tag combinators
author Adam Chlipala <adam@chlipala.net>
date Tue, 11 Jan 2011 14:19:51 -0500
parents 2ec84d349838
children af95d9d73eb5
line wrap: on
line diff
--- 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