changeset 1015:e47303e5d73d

Factor Dnat into separate module
author Adam Chlipala <adamc@hcoop.net>
date Sun, 25 Oct 2009 11:03:42 -0400
parents ea9f03ac2710
children 065ce3252090
files demo/more/conference.ur demo/more/conference.urp demo/more/dnat.ur demo/more/dnat.urs
diffstat 4 files changed, 55 insertions(+), 40 deletions(-) [+]
line wrap: on
line diff
--- a/demo/more/conference.ur	Thu Oct 22 17:36:30 2009 -0400
+++ b/demo/more/conference.ur	Sun Oct 25 11:03:42 2009 -0400
@@ -76,30 +76,6 @@
                                         val t = user
                                     end)
 
-    datatype dnat = O | S of source dnat
-    type dnatS = source dnat
-
-    fun inc n =
-        v <- get n;
-        case v of
-            O =>
-            n' <- source O;
-            set n (S n')
-          | S n => inc n
-
-    fun dec n =
-        let
-            fun dec' last n =
-                v <- get n;
-                case v of
-                    O => (case last of
-                              None => return ()
-                            | Some n' => set n' O)
-                  | S n' => dec' (Some n) n'
-        in
-            dec' None n
-        end
-
     fun doRegister r =
         n <- oneRowE1 (SELECT COUNT( * ) AS N
                        FROM user
@@ -203,21 +179,9 @@
                     return <xml><body>
                       Thanks for submitting!
                     </body></xml>
-
-            fun authorBlanks n =
-                case n of
-                    O => <xml/>
-                  | S n => <xml>
-                    <entry><b>Author:</b> <textbox{#Nam}/><br/></entry>
-                    <dyn signal={authorBlanksS n}/>
-                  </xml>
-
-            and authorBlanksS n =
-                n <- signal n;
-                return (authorBlanks n)
         in
             me <- getLogin;
-            numAuthors <- source O;
+            numAuthors <- Dnat.zero;
 
             return <xml><body>
               <h1>Submit a Paper</h1>
@@ -225,10 +189,10 @@
               <form>
                 <b>Author:</b> {[me.Nam]}<br/>
                 <subforms{#Authors}>
-                  <dyn signal={authorBlanksS numAuthors}/>
+                  {Dnat.render <xml><entry><b>Author:</b> <textbox{#Nam}/><br/></entry></xml> numAuthors}
                 </subforms>
-                <button value="Add author" onclick={inc numAuthors}/><br/>
-                <button value="Remove author" onclick={dec numAuthors}/><br/>
+                <button value="Add author" onclick={Dnat.inc numAuthors}/><br/>
+                <button value="Remove author" onclick={Dnat.dec numAuthors}/><br/>
                 <br/>
 
                 {useMore (allWidgets M.paper M.paperFolder)}
--- a/demo/more/conference.urp	Thu Oct 22 17:36:30 2009 -0400
+++ b/demo/more/conference.urp	Sun Oct 25 11:03:42 2009 -0400
@@ -5,5 +5,6 @@
 $/list
 meta
 bulkEdit
+dnat
 conference
 conferenceFields
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/more/dnat.ur	Sun Oct 25 11:03:42 2009 -0400
@@ -0,0 +1,42 @@
+datatype t' = O | S of source t'
+type t = source t'
+
+val zero = source O
+
+fun inc n =
+    v <- get n;
+    case v of
+        O =>
+        n' <- source O;
+        set n (S n')
+      | S n => inc n
+
+fun dec n =
+    let
+        fun dec' last n =
+            v <- get n;
+            case v of
+                O => (case last of
+                          None => return ()
+                        | Some n' => set n' O)
+              | S n' => dec' (Some n) n'
+    in
+        dec' None n
+    end
+
+fun render [ctx] [inp] [[Body] ~ ctx] (xml : xml ([Body] ++ ctx) inp []) n =
+    let
+        fun render n =
+            n <- signal n;
+            return (render' n)
+
+        and render' n =
+            case n of
+                O => <xml/>
+              | S n => <xml>
+                {xml}
+                <dyn signal={render n}/>
+              </xml>
+    in
+        <xml><dyn signal={render n}/></xml>
+    end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/more/dnat.urs	Sun Oct 25 11:03:42 2009 -0400
@@ -0,0 +1,8 @@
+type t
+
+val zero : transaction t
+val inc : t -> transaction unit
+val dec : t -> transaction unit
+
+val render : ctx ::: {Unit} -> inp ::: {Type} -> [[Body] ~ ctx] =>
+    xml ([Body] ++ ctx) inp [] -> t -> xml ([Body] ++ ctx) inp []