Mercurial > urweb

annotate tests/gform.ur @ 2109:f42fea631c1d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Improve wildification for records of type-class witnesses
author Adam Chlipala <adam@chlipala.net>
date Wed, 28 Jan 2015 08:47:04 -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