Ur/Web: tests/gform.ur annotate

annotate tests/gform.ur @ 1605:48eed6cf2be7

Fix bug in previous change

author	Adam Chlipala <adam@chlipala.net>
date	Sun, 20 Nov 2011 20:46:28 -0500
parents	71bafe66dbe1
children

rev	line source
adamc@146	1 con stringify = fold (fn nm :: Name => fn u :: Unit => fn t :: {Type} => [nm = string] ++ t) []
adamc@146	2
adamc@146	3 signature S = sig
adamc@146	4 con rs :: {Unit}
adamc@146	5 end
adamc@146	6
adamc@146	7 signature S' = sig
adamc@146	8 con rs :: {Unit}
adamc@146	9
adamc@146	10 val handler : $(stringify rs) -> page
adamc@146	11 val page : unit -> page
adamc@146	12 end
adamc@146	13
adamc@146	14 functor F (M : S) : S' where con rs = M.rs = struct
adamc@146	15 con rs = M.rs
adamc@146	16
adamc@146	17 val handler = fn x : $(stringify M.rs) => <html><body>
adamc@150	18 {fold [fn rs :: {Unit} => $(stringify rs) -> xml body [] []]
adamc@150	19 (fn nm :: Name => fn u :: Unit => fn rest :: {Unit} =>
adamc@150	20 fn f : $(stringify rest) -> xml body [] [] =>
adamc@150	21 fn x : $(stringify ([nm] ++ rest)) =>
adamc@150	22 <body><li> {cdata x.nm}</li> {f (x -- nm)}</body>)
adamc@150	23 (fn x => <body></body>)
adamc@150	24 [M.rs] x}
adamc@146	25 </body></html>
adamc@146	26
adamc@146	27 val page = fn () => <html><body>
adamc@147	28 <lform>
adamc@147	29 {fold [fn rs :: {Unit} => xml lform [] (stringify rs)]
adamc@147	30 (fn nm :: Name => fn u :: Unit => fn rest :: {Unit} =>
adamc@147	31 fn frag : xml lform [] (stringify rest) =>
adamc@148	32 <lform><li> <textbox{nm}/></li> {useMore frag}</lform>)
adamc@147	33 <lform></lform>
adamc@147	34 [rs]}
adamc@146	35
adamc@147	36 <submit action={handler}/>
adamc@147	37 </lform>
adamc@146	38 </body></html>
adamc@146	39 end
adamc@146	40
adamc@146	41 structure M = F(struct
adamc@147	42 con rs = [A, B, C]
adamc@146	43 end)
adamc@146	44
adamc@146	45 open M
adamc@146	46

Mercurial > urweb

annotate tests/gform.ur @ 1605:48eed6cf2be7