Mercurial > feed
comparison 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 |
comparison
equal
deleted
inserted
replaced
2:2ec84d349838 | 3:ea0ca570c121 |
---|---|
6 ExitTag : internal -> option internal, | 6 ExitTag : internal -> option internal, |
7 Finished : internal -> option output} | 7 Finished : internal -> option output} |
8 | 8 |
9 con tagInternal (attrs :: {Unit}) = option {Attrs : $(mapU string attrs), Cdata : option string} | 9 con tagInternal (attrs :: {Unit}) = option {Attrs : $(mapU string attrs), Cdata : option string} |
10 | 10 |
11 fun tag [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs)) | 11 fun tagG [attrs ::: {Unit}] [t ::: Type] (fl : folder attrs) (accept : {Attrs : $(mapU string attrs), Cdata : option string} -> option t) |
12 : pattern (tagInternal attrs) {Attrs : $(mapU string attrs), Cdata : option string} = | 12 (name : string) (attrs : $(mapU string attrs)) |
13 : pattern (tagInternal attrs) t = | |
13 Transducer {Initial = None, | 14 Transducer {Initial = None, |
14 EnterTag = fn tinfo state => | 15 EnterTag = fn tinfo state => |
15 case state of | 16 case state of |
16 Some _ => None | 17 Some _ => None |
17 | None => | 18 | None => |
26 case List.assoc aname tinfo.Attrs of | 27 case List.assoc aname tinfo.Attrs of |
27 None => None | 28 None => None |
28 | Some v => Some ({nm = v} ++ r)) | 29 | Some v => Some ({nm = v} ++ r)) |
29 (Some {}) fl attrs of | 30 (Some {}) fl attrs of |
30 None => None | 31 None => None |
31 | Some vs => Some (Some {Attrs = vs, Cdata = tinfo.Cdata}), | 32 | Some vs => |
33 let | |
34 val v = {Attrs = vs, Cdata = tinfo.Cdata} | |
35 in | |
36 case accept v of | |
37 None => None | |
38 | Some _ => Some (Some v) | |
39 end, | |
32 ExitTag = Some, | 40 ExitTag = Some, |
33 Finished = fn x => x} | 41 Finished = Option.bind accept} |
42 | |
43 fun tag [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs)) | |
44 : pattern (tagInternal attrs) {Attrs : $(mapU string attrs), Cdata : option string} = | |
45 @tagG fl Some name attrs | |
46 | |
47 fun tagA [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs)) | |
48 : pattern (tagInternal attrs) $(mapU string attrs) = | |
49 @tagG fl (fn r => Some r.Attrs) name attrs | |
50 | |
51 fun tagC (name : string) : pattern (tagInternal []) string = | |
52 tagG (fn r => r.Cdata) name {} | |
34 | 53 |
35 datatype status a = Initial | Failed | Matched of a | 54 datatype status a = Initial | Failed | Matched of a |
36 | 55 |
37 con childrenInternal (parent :: Type) (children :: {Type}) = option (parent * int * $(map status children)) | 56 con childrenInternal (parent :: Type) (children :: {Type}) = option (parent * int * $(map status children)) |
38 | 57 |