Mercurial > feed
changeset 3:ea0ca570c121
Shortcut tag combinators
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Tue, 11 Jan 2011 14:19:51 -0500 |
| parents | 2ec84d349838 |
| children | af95d9d73eb5 |
| files | src/ur/feed.ur src/ur/feed.urs src/ur/lib.urp tests/mr.ur |
| diffstat | 4 files changed, 34 insertions(+), 15 deletions(-) [+] |
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
--- 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)}
--- 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
--- 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.