|
adamc@993
|
1 open Versioned.Make(struct
|
|
adamc@993
|
2 con key = [Id = int]
|
|
adamc@993
|
3 con data = [Nam = string, ShoeSize = int]
|
|
adamc@993
|
4
|
|
adamc@993
|
5 val key = {Id = _}
|
|
adamc@993
|
6 val data = {Nam = {Inj = _,
|
|
adamc@993
|
7 Eq = _},
|
|
adamc@993
|
8 ShoeSize = {Inj = _,
|
|
adamc@993
|
9 Eq = _}}
|
|
adamc@993
|
10 end)
|
|
adamc@993
|
11
|
|
adamc@995
|
12 fun retro vr =
|
|
adamc@995
|
13 ks <- keysAt vr;
|
|
adamc@995
|
14 ks <- List.mapM (fn r => fso <- archive vr r; return (r.Id, fso)) ks;
|
|
adamc@995
|
15
|
|
adamc@995
|
16 return <xml><body>
|
|
adamc@995
|
17 {List.mapX (fn (k, r) => <xml><li>
|
|
adamc@995
|
18 {[k]}: {case r of
|
|
adamc@995
|
19 None => <xml>Whoa!</xml>
|
|
adamc@995
|
20 | Some r => <xml>{[r.Nam]}, {[r.ShoeSize]}</xml>}
|
|
adamc@995
|
21 </li></xml>) ks}
|
|
adamc@995
|
22 </body></xml>
|
|
adamc@995
|
23
|
|
adamc@993
|
24 fun expandKey k =
|
|
adamc@993
|
25 name <- source "";
|
|
adamc@993
|
26 shoeSize <- source "";
|
|
adamc@993
|
27 return {Key = k, Nam = name, ShoeSize = shoeSize}
|
|
adamc@993
|
28
|
|
adamc@993
|
29 fun main () =
|
|
adamc@993
|
30 ks0 <- keys;
|
|
adamc@993
|
31 ks0 <- List.mapM (fn r => expandKey r.Id) ks0;
|
|
adamc@993
|
32 ks <- source ks0;
|
|
adamc@993
|
33
|
|
adamc@993
|
34 id <- source "";
|
|
adamc@993
|
35 name <- source "";
|
|
adamc@993
|
36 shoeSize <- source "";
|
|
adamc@993
|
37
|
|
adamc@995
|
38 times <- updateTimes;
|
|
adamc@995
|
39
|
|
adamc@993
|
40 return <xml><body>
|
|
adamc@993
|
41 <dyn signal={ks <- signal ks;
|
|
adamc@993
|
42 return (List.mapX (fn kr => <xml><div>
|
|
adamc@993
|
43 {[kr.Key]}:
|
|
adamc@993
|
44 <ctextbox source={kr.Nam}/>
|
|
adamc@993
|
45 <ctextbox size={5} source={kr.ShoeSize}/>
|
|
adam@1784
|
46 <button value="Latest" onclick={fn _ => ro <- rpc (current {Id = kr.Key});
|
|
adam@1784
|
47 case ro of
|
|
adam@1784
|
48 None => alert "Can't get it!"
|
|
adam@1784
|
49 | Some r =>
|
|
adam@1784
|
50 set kr.Nam r.Nam;
|
|
adam@1784
|
51 set kr.ShoeSize (show r.ShoeSize)}/>
|
|
adam@1784
|
52 <button value="Update" onclick={fn _ => name <- get kr.Nam;
|
|
adam@1784
|
53 shoeSize <- get kr.ShoeSize;
|
|
adam@1784
|
54 rpc (update {Id = kr.Key,
|
|
adam@1784
|
55 Nam = name,
|
|
adam@1784
|
56 ShoeSize = readError shoeSize})
|
|
adamc@993
|
57 }/>
|
|
adamc@993
|
58 </div></xml>) ks)}/>
|
|
adamc@993
|
59
|
|
adamc@993
|
60 <h2>Add one:</h2>
|
|
adamc@993
|
61
|
|
adamc@993
|
62 <table>
|
|
adamc@993
|
63 <tr><th>Id:</th> <td><ctextbox size={5} source={id}/></td></tr>
|
|
adamc@993
|
64 <tr><th>Name:</th> <td><ctextbox source={name}/></td></tr>
|
|
adamc@993
|
65 <tr><th>Shoe size:</th> <td><ctextbox size={5} source={shoeSize}/></td></tr>
|
|
adam@1784
|
66 <tr><th><button value="Add" onclick={fn _ => id <- get id;
|
|
adam@1784
|
67 name <- get name;
|
|
adam@1784
|
68 shoeSize <- get shoeSize;
|
|
adam@1784
|
69 rpc (insert {Id = readError id, Nam = name,
|
|
adam@1784
|
70 ShoeSize = readError shoeSize});
|
|
adamc@993
|
71
|
|
adam@1784
|
72 cur <- get ks;
|
|
adam@1784
|
73 kr <- expandKey (readError id);
|
|
adam@1784
|
74 set ks (kr :: cur)}/></th></tr>
|
|
adamc@993
|
75 </table>
|
|
adamc@995
|
76
|
|
adamc@995
|
77 <h2>Archive</h2>
|
|
adamc@995
|
78
|
|
adamc@995
|
79 {List.mapX (fn (vr, tm) => <xml><li><a link={retro vr}>{[tm]}</a></li></xml>) times}
|
|
adamc@993
|
80 </body></xml>
|
