adamc@1004
|
1 open Meta
|
adamc@1004
|
2
|
adamc@1004
|
3 functor Make(M : sig
|
adamc@1004
|
4 con keyName :: Name
|
adamc@1004
|
5 con keyType :: Type
|
adamc@1004
|
6 val showKey : show keyType
|
adamc@1004
|
7
|
adamc@1004
|
8 con visible :: {(Type * Type)}
|
adamc@1004
|
9 constraint [keyName] ~ visible
|
adamc@1004
|
10 val folder : folder visible
|
adamc@1004
|
11 val visible : $(map Meta.meta visible)
|
adamc@1004
|
12
|
adamc@1004
|
13 con invisible :: {Type}
|
adamc@1004
|
14 constraint [keyName] ~ invisible
|
adamc@1004
|
15 constraint visible ~ invisible
|
adamc@1004
|
16
|
adamc@1004
|
17 val title : string
|
adamc@1004
|
18 val isAllowed : transaction bool
|
adamc@1004
|
19 table t : ([keyName = keyType] ++ map fst visible ++ invisible)
|
adamc@1004
|
20 end) = struct
|
adamc@1004
|
21
|
adamc@1004
|
22 open M
|
adamc@1004
|
23
|
adamc@1004
|
24 fun main () =
|
adamc@1004
|
25 items <- queryX (SELECT t.{keyName}, t.{{map fst visible}} FROM t)
|
adamc@1004
|
26 (fn r => <xml><entry><tr>
|
adamc@1004
|
27 <hidden{keyName} value={show r.T.keyName}/>
|
adamc@1004
|
28 {useMore (foldR2 [meta] [fst] [fn cols :: {(Type * Type)} =>
|
adamc@1004
|
29 xml [Body, Form, Tr] [] (map snd cols)]
|
adamc@1004
|
30 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest]
|
adamc@1004
|
31 (m : meta p) v (acc : xml [Body, Form, Tr] [] (map snd rest)) =>
|
adamc@1004
|
32 <xml>
|
adamc@1004
|
33 <td>{m.WidgetPopulated [nm] v}</td>
|
adamc@1004
|
34 {useMore acc}
|
adamc@1004
|
35 </xml>)
|
adamc@1004
|
36 <xml/>
|
adamc@1004
|
37 [_] folder visible (r.T -- keyName))}
|
adamc@1004
|
38 </tr></entry></xml>);
|
adamc@1004
|
39
|
adamc@1004
|
40 return <xml><body>
|
adamc@1004
|
41 <h1>{[title]}</h1>
|
adamc@1004
|
42
|
adamc@1004
|
43 <form><table>
|
adamc@1004
|
44 <tr>{foldRX [meta] [_]
|
adamc@1004
|
45 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] m =>
|
adamc@1004
|
46 <xml><th>{[m.Nam]}</th></xml>) [_] folder visible}</tr>
|
adamc@1004
|
47 <subforms{#Users}>{items}</subforms>
|
adamc@1004
|
48 </table></form>
|
adamc@1004
|
49 </body></xml>
|
adamc@1004
|
50
|
adamc@1004
|
51 end
|