Mercurial > feed

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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