Mercurial > feed
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