adamc@993: open Versioned.Make(struct
adamc@993:                         con key = [Id = int]
adamc@993:                         con data = [Nam = string, ShoeSize = int]
adamc@993: 
adamc@993:                         val key = {Id = _}
adamc@993:                         val data = {Nam = {Inj = _,
adamc@993:                                            Eq = _},
adamc@993:                                     ShoeSize = {Inj = _,
adamc@993:                                                 Eq = _}}
adamc@993:                     end)
adamc@993: 
adamc@995: fun retro vr =
adamc@995:     ks <- keysAt vr;
adamc@995:     ks <- List.mapM (fn r => fso <- archive vr r; return (r.Id, fso)) ks;
adamc@995: 
adamc@995:     return <xml><body>
adamc@995:       {List.mapX (fn (k, r) => <xml><li>
adamc@995:         {[k]}: {case r of
adamc@995:                     None => <xml>Whoa!</xml>
adamc@995:                   | Some r => <xml>{[r.Nam]}, {[r.ShoeSize]}</xml>}
adamc@995:       </li></xml>) ks}
adamc@995:     </body></xml>
adamc@995: 
adamc@993: fun expandKey k =
adamc@993:     name <- source "";
adamc@993:     shoeSize <- source "";
adamc@993:     return {Key = k, Nam = name, ShoeSize = shoeSize}
adamc@993: 
adamc@993: fun main () =
adamc@993:     ks0 <- keys;
adamc@993:     ks0 <- List.mapM (fn r => expandKey r.Id) ks0;
adamc@993:     ks <- source ks0;
adamc@993: 
adamc@993:     id <- source "";
adamc@993:     name <- source "";
adamc@993:     shoeSize <- source "";
adamc@993: 
adamc@995:     times <- updateTimes;
adamc@995: 
adamc@993:     return <xml><body>
adamc@993:       <dyn signal={ks <- signal ks;
adamc@993:                    return (List.mapX (fn kr => <xml><div>
adamc@993:                      {[kr.Key]}:
adamc@993:                      <ctextbox source={kr.Nam}/>
adamc@993:                      <ctextbox size={5} source={kr.ShoeSize}/>
adam@1784:                      <button value="Latest" onclick={fn _ => ro <- rpc (current {Id = kr.Key});
adam@1784:                                                         case ro of
adam@1784:                                                             None => alert "Can't get it!"
adam@1784:                                                           | Some r =>
adam@1784:                                                             set kr.Nam r.Nam;
adam@1784:                                                             set kr.ShoeSize (show r.ShoeSize)}/>
adam@1784:                      <button value="Update" onclick={fn _ => name <- get kr.Nam;
adam@1784:                                                         shoeSize <- get kr.ShoeSize;
adam@1784:                                                         rpc (update {Id = kr.Key,
adam@1784:                                                                      Nam = name,
adam@1784:                                                                      ShoeSize = readError shoeSize})
adamc@993:                                                     }/>
adamc@993:                    </div></xml>) ks)}/>
adamc@993: 
adamc@993:       <h2>Add one:</h2>
adamc@993: 
adamc@993:       <table>
adamc@993:         <tr><th>Id:</th> <td><ctextbox size={5} source={id}/></td></tr>
adamc@993:         <tr><th>Name:</th> <td><ctextbox source={name}/></td></tr>
adamc@993:         <tr><th>Shoe size:</th> <td><ctextbox size={5} source={shoeSize}/></td></tr>
adam@1784:         <tr><th><button value="Add" onclick={fn _ => id <- get id;
adam@1784:                                                 name <- get name;
adam@1784:                                                 shoeSize <- get shoeSize;
adam@1784:                                                 rpc (insert {Id = readError id, Nam = name,
adam@1784:                                                              ShoeSize = readError shoeSize});
adamc@993: 
adam@1784:                                                 cur <- get ks;
adam@1784:                                                 kr <- expandKey (readError id);
adam@1784:                                                 set ks (kr :: cur)}/></th></tr>
adamc@993:       </table>
adamc@995: 
adamc@995:       <h2>Archive</h2>
adamc@995: 
adamc@995:       {List.mapX (fn (vr, tm) => <xml><li><a link={retro vr}>{[tm]}</a></li></xml>) times}
adamc@993:     </body></xml>