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@1005
|
7 val readKey : read keyType
|
adamc@1005
|
8 val injKey : sql_injectable keyType
|
adamc@1004
|
9
|
adamc@1004
|
10 con visible :: {(Type * Type)}
|
adamc@1004
|
11 constraint [keyName] ~ visible
|
adamc@1004
|
12 val folder : folder visible
|
adamc@1004
|
13 val visible : $(map Meta.meta visible)
|
adamc@1004
|
14
|
adamc@1004
|
15 con invisible :: {Type}
|
adamc@1004
|
16 constraint [keyName] ~ invisible
|
adamc@1004
|
17 constraint visible ~ invisible
|
adamc@1004
|
18
|
adamc@1004
|
19 val title : string
|
adamc@1004
|
20 val isAllowed : transaction bool
|
adamc@1004
|
21 table t : ([keyName = keyType] ++ map fst visible ++ invisible)
|
adamc@1004
|
22 end) = struct
|
adamc@1004
|
23
|
adamc@1004
|
24 open M
|
adamc@1004
|
25
|
adamc@1004
|
26 fun main () =
|
adamc@1004
|
27 items <- queryX (SELECT t.{keyName}, t.{{map fst visible}} FROM t)
|
adamc@1004
|
28 (fn r => <xml><entry><tr>
|
adamc@1004
|
29 <hidden{keyName} value={show r.T.keyName}/>
|
adamc@1008
|
30 {useMore (allPopulatedTr visible (r.T -- keyName) folder)}
|
adamc@1004
|
31 </tr></entry></xml>);
|
adamc@1004
|
32
|
adamc@1004
|
33 return <xml><body>
|
adamc@1004
|
34 <h1>{[title]}</h1>
|
adamc@1004
|
35
|
adamc@1004
|
36 <form><table>
|
adamc@1004
|
37 <tr>{foldRX [meta] [_]
|
adamc@1004
|
38 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] m =>
|
adamc@1004
|
39 <xml><th>{[m.Nam]}</th></xml>) [_] folder visible}</tr>
|
adamc@1004
|
40 <subforms{#Users}>{items}</subforms>
|
adamc@1005
|
41 <tr> <td><submit value="Save" action={save}/></td> </tr>
|
adamc@1004
|
42 </table></form>
|
adamc@1004
|
43 </body></xml>
|
adamc@1004
|
44
|
adamc@1005
|
45 and save r =
|
adamc@1005
|
46 List.app (fn user => dml (update [map fst visible] !
|
adamc@1008
|
47 (ensql visible (user -- keyName) folder)
|
adamc@1005
|
48 t
|
adamc@1005
|
49 (WHERE t.{keyName} = {[readError user.keyName]}))) r.Users;
|
adamc@1005
|
50 main ()
|
adamc@1005
|
51
|
adamc@1004
|
52 end
|