Ur/Web: demo/more/conference.ur annotate

Add tuple pattern-matching at the constructor level

author	Adam Chlipala <adamc@hcoop.net>
date	Tue, 20 Oct 2009 10:19:00 -0400
parents
children	61c30f0742d7

rev	line source
adamc@1001	1 con reviewMeta = fn (db :: Type, widget :: Type) =>
adamc@1001	2 {Show : db -> xbody,
adamc@1001	3 Widget : nm :: Name -> xml form [] [nm = widget],
adamc@1001	4 WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget],
adamc@1001	5 Parse : widget -> db,
adamc@1001	6 Inject : sql_injectable db}
adamc@1001	7
adamc@1001	8 fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t) : reviewMeta (t, string) =
adamc@1001	9 {Show = txt,
adamc@1001	10 Widget = fn [nm :: Name] => <xml><textbox{nm}/></xml>,
adamc@1001	11 WidgetPopulated = fn [nm :: Name] n =>
adamc@1001	12 <xml><textbox{nm} value={show n}/></xml>,
adamc@1001	13 Parse = readError,
adamc@1001	14 Inject = _}
adamc@1001	15
adamc@1001	16 val int = default
adamc@1001	17 val float = default
adamc@1001	18 val string = default
adamc@1001	19 val bool = {Show = txt,
adamc@1001	20 Widget = fn [nm :: Name] => <xml><checkbox{nm}/></xml>,
adamc@1001	21 WidgetPopulated = fn [nm :: Name] b =>
adamc@1001	22 <xml><checkbox{nm} checked={b}/></xml>,
adamc@1001	23 Parse = fn x => x,
adamc@1001	24 Inject = _}
adamc@1001	25
adamc@1001	26 functor Make(M : sig
adamc@1001	27 con review :: {(Type * Type)}
adamc@1001	28 val review : $(map reviewMeta review)
adamc@1001	29 end) = struct
adamc@1001	30
adamc@1001	31 fun main () = return <xml/>
adamc@1001	32
adamc@1001	33 end

Mercurial > urweb