Mercurial > urweb
annotate tests/gform.lac @ 147:eb16f2aadbe9
Meta-programming forms
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 22 Jul 2008 18:46:04 -0400 |
parents | 80ac94b54e41 |
children | 15e8b9775539 |
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@146 | 18 OK. |
adamc@146 | 19 </body></html> |
adamc@146 | 20 |
adamc@146 | 21 val page = fn () => <html><body> |
adamc@147 | 22 <lform> |
adamc@147 | 23 {fold [fn rs :: {Unit} => xml lform [] (stringify rs)] |
adamc@147 | 24 (fn nm :: Name => fn u :: Unit => fn rest :: {Unit} => |
adamc@147 | 25 fn frag : xml lform [] (stringify rest) => |
adamc@147 | 26 <lform><li>{frag} <textbox{nm}/></li></lform>) |
adamc@147 | 27 <lform></lform> |
adamc@147 | 28 [rs]} |
adamc@146 | 29 |
adamc@147 | 30 <submit action={handler}/> |
adamc@147 | 31 </lform> |
adamc@146 | 32 </body></html> |
adamc@146 | 33 end |
adamc@146 | 34 |
adamc@146 | 35 structure M = F(struct |
adamc@147 | 36 con rs = [A, B, C] |
adamc@146 | 37 end) |
adamc@146 | 38 |
adamc@146 | 39 open M |
adamc@146 | 40 |