# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1312742332 14400
# Node ID 8300d5f0dc19acc99c83ded61705418767844c2c
# Parent  0827320b0f04f42bd479385243c9785bf628324b
Replace ChangePoller with SourceL, plus some other rearrangements

diff -r 0827320b0f04 -r 8300d5f0dc19 calendar.ur
--- a/calendar.ur	Fri Aug 05 18:55:24 2011 -0430
+++ b/calendar.ur	Sun Aug 07 14:38:52 2011 -0400
@@ -21,7 +21,7 @@
                           ThisMonthLength : int, PrevMonthLength : int,
                           MondayMonth : month, MondayDay : int,
                           PrevMonthName : string, ThisMonthName : string, NextMonthName : string},
-          Day : ChangePoller.changePoller date}
+          Day : SourceL.t date}
          
 fun pad len n =
     let
@@ -108,7 +108,7 @@
     month <- return (readError (timef "%m" tm));
     minf <- source (monthInfo' {Month = month, Year = year});
     day <- return (readError (timef "%d" tm));
-    day <- ChangePoller.create {Year = year, Month = month, Day = day};
+    day <- SourceL.create {Year = year, Month = month, Day = day};
     return {Month = minf, Day = day}
 
 fun render' t =
@@ -129,12 +129,12 @@
                                                                      | Next => if minf.ThisMonth = 12 then 1 else minf.ThisMonth + 1,
                                                            Day = day}
                                        in
-                                           cday <- ChangePoller.value t.Day;
+                                           cday <- SourceL.value t.Day;
                                            return (if Record.equal thisDate cday then
                                                        <xml><td class={selday}>{[day]}</td></xml>
                                                    else case month of
                                                             This => <xml><td class={curday}
-                                                                             onclick={set (ChangePoller.ctl t.Day) thisDate}>{[day]}</td></xml>
+                                                                             onclick={SourceL.set t.Day thisDate}>{[day]}</td></xml>
                                                           | _ => <xml><td class={otherday}>{[day]}</td></xml>)
                                        end}/>
                             {let
@@ -203,8 +203,8 @@
         </xml>
     end
 
-fun addListener f ctl =
-    ChangePoller.addChangeListener f 100 ctl.Day
+fun onChange ctl f =
+    SourceL.onChange ctl.Day f
 
 val gui_t = Gui.mkGui 
                 (fn ctl =>
@@ -215,6 +215,6 @@
 fun set ctl day =
     minf <- rpc (monthInfo (day -- #Day));
     Basis.set ctl.Month minf;
-    Basis.set (ChangePoller.ctl ctl.Day) day
+    SourceL.set ctl.Day day
 
-fun value ctl = ChangePoller.value ctl.Day
+fun value ctl = SourceL.value ctl.Day
diff -r 0827320b0f04 -r 8300d5f0dc19 calendar.urs
--- a/calendar.urs	Fri Aug 05 18:55:24 2011 -0430
+++ b/calendar.urs	Sun Aug 07 14:38:52 2011 -0400
@@ -11,7 +11,7 @@
  * the new date.  They are displayed as pictures of calendars which
  * have clickable dates. *)
 
-val addListener : (date -> transaction unit) -> t -> transaction unit
+val onChange : t -> (date -> transaction {}) -> transaction unit
 (* Add a change listener to a calendar control. *)
 
 val set : t -> date -> transaction unit
diff -r 0827320b0f04 -r 8300d5f0dc19 changePoller.ur
--- a/changePoller.ur	Fri Aug 05 18:55:24 2011 -0430
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,30 +0,0 @@
-con changePoller t = {Val : source t,
-                      Last : source t}
-
-fun create [t ::: Type] (_ : eq t) (i : t)  =
-    v <- source i;
-    l <- source i;
-
-    return {Val = v,
-            Last = l}
-
-fun addChangeListener [t ::: Type] (_ : eq t) f pollInterval cp =
-    let
-        fun go () =
-            sleep pollInterval;
-            sample <- get cp.Val;
-            lst <- get cp.Last;
-            if sample = lst then
-                go ()
-            else
-                f sample;
-                set cp.Last sample;
-                go ()
-    in
-        go ()
-    end
-
-fun ctl [t ::: Type] cp = cp.Val
-
-fun value [t ::: Type] cp = signal (cp.Val)
-
diff -r 0827320b0f04 -r 8300d5f0dc19 changePoller.urs
--- a/changePoller.urs	Fri Aug 05 18:55:24 2011 -0430
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,17 +0,0 @@
-(* A source which can poll for changes and call an action on the new value
- * when one is found. *)
-
-con changePoller :: Type -> Type
-(* The type of pollers over the given type. *) 
-
-val create : t ::: Type -> eq t -> t -> transaction (changePoller t)
-(* From an initial value get a poller. *)
-
-val addChangeListener : t ::: Type -> eq t -> (t -> transaction unit) -> int -> changePoller t -> transaction unit
-(* Add an action to run on changed values with a polling period given by the int. *)
-
-val ctl : t ::: Type -> changePoller t -> source t
-(* Get a source to control or set the current value. *)
-
-val value : t ::: Type -> changePoller t -> signal t
-(* A signal holding the current value. *)
diff -r 0827320b0f04 -r 8300d5f0dc19 datebox.ur
--- a/datebox.ur	Fri Aug 05 18:55:24 2011 -0430
+++ b/datebox.ur	Sun Aug 07 14:38:52 2011 -0400
@@ -19,8 +19,8 @@
     return {Cal = cal,
             Panel = panel}
 
-fun addListener f db =
-    Calendar.addListener f db.Cal
+fun onChange db f =
+    Calendar.onChange db.Cal f
 
 fun set db day =
     Calendar.set db.Cal day
diff -r 0827320b0f04 -r 8300d5f0dc19 datebox.urs
--- a/datebox.urs	Fri Aug 05 18:55:24 2011 -0430
+++ b/datebox.urs	Sun Aug 07 14:38:52 2011 -0400
@@ -13,10 +13,10 @@
 val create : time -> transaction t
 (* Get a datebox initially set to the given time. *)
 
-val addListener : (date -> transaction unit) -> t -> transaction unit
+val onChange : t -> (date -> transaction {}) -> transaction {}
 (* Add an action to be run when the date changes. *)
 
-val set : t -> date -> transaction unit
+val set : t -> date -> transaction {}
 (* Call this to change the selected date. *)
 
 val value : t -> signal date
diff -r 0827320b0f04 -r 8300d5f0dc19 examples/datebox.ur
--- a/examples/datebox.ur	Fri Aug 05 18:55:24 2011 -0430
+++ b/examples/datebox.ur	Sun Aug 07 14:38:52 2011 -0400
@@ -4,7 +4,7 @@
 
 dayCtl <- Datebox.create tm;
 
-load <- return (Datebox.addListener (fn d => alert (show d.Day)) dayCtl);
+load <- return (Datebox.onChange dayCtl (fn d => alert (show d.Day)));
 
 return
     <xml>
diff -r 0827320b0f04 -r 8300d5f0dc19 lib.urp
--- a/lib.urp	Fri Aug 05 18:55:24 2011 -0430
+++ b/lib.urp	Sun Aug 07 14:38:52 2011 -0400
@@ -7,7 +7,7 @@
 waitbox
 select
 forms
-changePoller
+sourceL
 calendar
 navbar
 togglePanel
diff -r 0827320b0f04 -r 8300d5f0dc19 sourceL.ur
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/sourceL.ur	Sun Aug 07 14:38:52 2011 -0400
@@ -0,0 +1,22 @@
+con t a = {Source : source a,
+           OnSet : source (a -> transaction {})}
+
+fun create [a] (i : a) =
+    s <- source i;
+    f <- source (fn _ => return ());
+
+    return {Source = s,
+            OnSet = f}
+
+fun onChange [a] (t : t a) f =
+    old <- get t.OnSet;
+    set t.OnSet (fn x => (old x; f x))
+
+fun set [a] (t : t a) (v : a) =
+    Basis.set t.Source v;
+    f <- get t.OnSet;
+    f v
+
+fun get [a] (t : t a) = Basis.get t.Source
+
+fun value [a] (t : t a) = signal t.Source
diff -r 0827320b0f04 -r 8300d5f0dc19 sourceL.urs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/sourceL.urs	Sun Aug 07 14:38:52 2011 -0400
@@ -0,0 +1,11 @@
+(* Reactive sources that accept change listeners *)
+
+con t :: Type -> Type
+
+val create : a ::: Type -> a -> transaction (t a)
+
+val onChange : a ::: Type -> t a -> (a -> transaction {}) -> transaction {}
+
+val set : a ::: Type -> t a -> a -> transaction {}
+val get : a ::: Type -> t a -> transaction a
+val value : a ::: Type -> t a -> signal a