Mercurial > urweb

annotate tests/jsinj.ur @ 1313:0bf73c3e4563

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Monad.appR3
author Adam Chlipala <adam@chlipala.net>
date Tue, 19 Oct 2010 15:26:12 -0400
parents d49d58a69877
children
rev   line source
adamc@590 1 fun getOpt (t ::: Type) (o : option t) (v : t) : t =
adamc@590 2 case o of
adamc@590 3 None => v
adamc@590 4 | Some x => x
adamc@590 5
adamc@595 6 datatype color = Red | White | Blue
adamc@595 7
adamc@595 8 fun colorToString c =
adamc@595 9 case c of
adamc@595 10 Red => "R"
adamc@595 11 | White => "W"
adamc@595 12 | Blue => "B"
adamc@595 13
adamc@595 14 val show_color = mkShow colorToString
adamc@595 15
adamc@596 16 datatype list a = Nil | Cons of a * list a
adamc@596 17
adamc@596 18 fun delist ls : xbody =
adamc@596 19 case ls of
adamc@596 20 Nil => <xml>Nil</xml>
adamc@596 21 | Cons (h, t) => <xml>{cdata h} :: {delist t}</xml>
adamc@596 22
adamc@597 23 datatype weird = Foo | Bar | Baz of string
adamc@597 24
adamc@597 25 fun weirdToString w =
adamc@597 26 case w of
adamc@597 27 Foo => "Foo"
adamc@597 28 | Bar => "Bar"
adamc@597 29 | Baz s => s
adamc@597 30
adamc@597 31 val show_weird = mkShow weirdToString
adamc@597 32
adamc@591 33 cookie int : int
adamc@591 34 cookie float : float
adamc@592 35 cookie string : string
adamc@592 36 cookie bool : bool
adamc@593 37 cookie pair : int * float
adamc@594 38 cookie option : option int
adamc@595 39 cookie color : color
adamc@596 40 cookie list : list string
adamc@597 41 cookie weird : weird
adamc@591 42
adamc@590 43 fun main () : transaction page =
adamc@590 44 n <- getCookie int;
adamc@591 45 n <- return (getOpt n 7);
adamc@591 46 sn <- source 6;
adamc@591 47
adamc@591 48 f <- getCookie float;
adamc@591 49 f <- return (getOpt f 1.23);
adamc@591 50 sf <- source 4.56;
adamc@591 51
adamc@592 52 s <- getCookie string;
adamc@592 53 s <- return (getOpt s "Hi");
adamc@592 54 ss <- source "Bye";
adamc@592 55
adamc@592 56 b <- getCookie bool;
adamc@592 57 b <- return (getOpt b True);
adamc@592 58 sb <- source False;
adamc@592 59
adamc@593 60 p <- getCookie pair;
adamc@593 61 p <- return (getOpt p (1, 2.3));
adamc@593 62 sp <- source (4, 5.6);
adamc@593 63
adamc@594 64 o <- getCookie option;
adamc@594 65 o <- return (getOpt o (Some 1));
adamc@595 66 so <- source None;
adamc@595 67
adamc@595 68 c <- getCookie color;
adamc@595 69 c <- return (getOpt c White);
adamc@595 70 sc <- source Blue;
adamc@594 71
adamc@596 72 l <- getCookie list;
adamc@596 73 l <- return (getOpt l (Cons ("A", Cons ("B", Nil))));
adamc@596 74 sl <- source Nil;
adamc@596 75
adamc@597 76 w <- getCookie weird;
adamc@597 77 w <- return (getOpt w (Baz "TADA!"));
adamc@597 78 sw <- source Foo;
adamc@597 79
adamc@590 80 return <xml><body>
adamc@590 81 <dyn signal={n <- signal sn; return <xml>{[n]}</xml>}/>
adamc@591 82 <a onclick={set sn n}>CHANGE</a><br/>
adamc@591 83
adamc@591 84 <dyn signal={f <- signal sf; return <xml>{[f]}</xml>}/>
adamc@591 85 <a onclick={set sf f}>CHANGE</a><br/>
adamc@592 86
adamc@592 87 <dyn signal={s <- signal ss; return <xml>{[s]}</xml>}/>
adamc@592 88 <a onclick={set ss s}>CHANGE</a><br/>
adamc@592 89
adamc@592 90 <dyn signal={b <- signal sb; return <xml>{[b]}</xml>}/>
adamc@592 91 <a onclick={set sb b}>CHANGE</a><br/>
adamc@593 92
adamc@593 93 <dyn signal={p <- signal sp; return <xml>{[p.1]}, {[p.2]}</xml>}/>
adamc@593 94 <a onclick={set sp p}>CHANGE</a><br/>
adamc@594 95
adamc@595 96 <dyn signal={o <- signal so; case o of
adamc@594 97 None => return <xml>None</xml>
adamc@594 98 | Some x => return <xml>{[x]}</xml>}/>
adamc@595 99 <a onclick={set so o}>CHANGE</a><br/>
adamc@595 100
adamc@595 101 <dyn signal={c <- signal sc; return <xml>{[c]}</xml>}/>
adamc@595 102 <a onclick={set sc c}>CHANGE</a><br/>
adamc@596 103
adamc@596 104 <dyn signal={l <- signal sl; return <xml>{delist l}</xml>}/>
adamc@596 105 <a onclick={set sl l}>CHANGE</a><br/>
adamc@597 106
adamc@597 107 <dyn signal={w <- signal sw; return <xml>{[w]}</xml>}/>
adamc@597 108 <a onclick={set sw w}>CHANGE</a><br/>
adamc@590 109 </body></xml>