Mercurial > feed

comparison src/ur/feed.ur @ 9:f19beef42ceb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add tag combinator with given attribute values.
author Karn Kallio <kkallio@eka>
date Tue, 31 May 2011 09:21:49 -0430
parents 05a28a77f6fe
children edc2b467f818
comparison
equal deleted inserted replaced
8:a4e5d053daed 9:f19beef42ceb
45 case (os, acc) of 45 case (os, acc) of
46 (Some s, Some acc) => Some ({nm = s} ++ acc) 46 (Some s, Some acc) => Some ({nm = s} ++ acc)
47 | _ => None) 47 | _ => None)
48 (Some {}) fl attrs 48 (Some {}) fl attrs
49 49
50 fun allPresentE [attrs ::: {Unit}] (fl : folder attrs) (vs : $(mapU (option string) attrs)) (attrs : $(mapU (option string) attrs))
51 : option $(mapU string attrs) =
52 @foldUR2 [option string] [option string] [fn attrs => option $(mapU string attrs)]
53 (fn [nm ::_] [r ::_] [[nm] ~ r] os os' acc =>
54 case (os, os', acc) of
55 (Some s, Some s', Some acc) => if s = s' then Some ({nm = s'} ++ acc) else None
56 | (None, Some s', Some acc) => Some ({nm = s'} ++ acc)
57 | _ => None)
58 (Some {}) fl vs attrs
59
50 fun tag [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs)) 60 fun tag [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs))
51 : pattern (tagInternal attrs) {Attrs : $(mapU string attrs), Cdata : option string} = 61 : pattern (tagInternal attrs) {Attrs : $(mapU string attrs), Cdata : option string} =
52 @tagG fl (fn r => 62 @tagG fl (fn r =>
53 case @allPresent fl r.Attrs of 63 case @allPresent fl r.Attrs of
54 None => None 64 None => None
56 name attrs 66 name attrs
57 67
58 fun tagA [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs)) 68 fun tagA [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs))
59 : pattern (tagInternal attrs) $(mapU string attrs) = 69 : pattern (tagInternal attrs) $(mapU string attrs) =
60 @tagG fl (fn r => @allPresent fl r.Attrs) name attrs 70 @tagG fl (fn r => @allPresent fl r.Attrs) name attrs
71
72 fun tagAV [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU (string * option string) attrs))
73 : pattern (tagInternal attrs) $(mapU string attrs) =
74 let
75 val as = @mp [fn _ => (string * option string)] [fn _ => string] (fn [u] (x, _) => x) fl attrs
76 val vs = @mp [fn _ => (string * option string)] [fn _ => option string] (fn [u] (_, x) => x) fl attrs
77 in
78 @tagG fl (fn r => @allPresentE fl vs r.Attrs) name as
79 end
80
61 fun tagAO [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs)) 81 fun tagAO [attrs ::: {Unit}] (fl : folder attrs) (name : string) (attrs : $(mapU string attrs))
62 : pattern (tagInternal attrs) $(mapU (option string) attrs) = 82 : pattern (tagInternal attrs) $(mapU (option string) attrs) =
63 @tagG fl (fn r => Some (r.Attrs)) name attrs 83 @tagG fl (fn r => Some (r.Attrs)) name attrs
64 84
65 fun tagC (name : string) : pattern (tagInternal []) string = 85 fun tagC (name : string) : pattern (tagInternal []) string =