Ur/Web: tests/DynChannel.ur annotate

Reduce: add reduction in some spots previously missed, associated with 'case' return types

author	Adam Chlipala <adam@chlipala.net>
date	Wed, 25 Nov 2015 18:48:17 -0500
parents	3dd041b00087
children

rev	line source
adam@2064	1 table channels : {Id : int, Channel:channel xbody}
adam@2064	2
adam@2064	3 fun dosend (s:string) : transaction unit =
adam@2064	4 c <- oneRow1 (SELECT * FROM channels);
adam@2064	5 debug ("Sending " ^ s ^ " through the channel...");
adam@2064	6 send c.Channel <xml>{[s]}</xml>
adam@2064	7
adam@2064	8 fun mkchannel {} : transaction xbody =
adam@2064	9 c <- channel;
adam@2064	10 s <- source <xml/>;
adam@2064	11 dml( DELETE FROM channels WHERE Id >= 0);
adam@2064	12 dml( INSERT INTO channels(Id, Channel) VALUES(0, {[c]}) );
adam@2064	13 return <xml>
adam@2064	14 <button value="Send" onclick={fn _ => rpc(dosend "blabla")}/>
adam@2064	15 <active code={spawn(x <- recv c; alert ("Got something from the channel"); set s x); return <xml/>}/>
adam@2064	16 <dyn signal={signal s}/>
adam@2064	17 </xml>
adam@2064	18
adam@2064	19 fun main {} : transaction page =
adam@2064	20 s <- source <xml/>;
adam@2064	21 return <xml>
adam@2064	22 <head/>
adam@2064	23 <body>
adam@2064	24 <button value="Register" onclick={fn _ =>
adam@2064	25 x <- rpc(mkchannel {}); set s x
adam@2064	26 }/>
adam@2064	27 <dyn signal={signal s}/>
adam@2064	28 </body>
adam@2064	29 </xml>

Mercurial > urweb