Mercurial > urweb

annotate demo/more/versioned1.ur @ 2019:79a2f3468e46

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Return to working version mode
author Adam Chlipala <adam@chlipala.net>
date Sat, 31 May 2014 16:57:52 -0400
parents e6bc6bbd7a32
children
rev   line source
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>