Reusable column handlers for Crud

5 files changed, 45 insertions, 40 deletions

diff --git a/src/elaborate.sml b/src/elaborate.sml
index b2d1f958..035b95f6 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -2167,8 +2167,15 @@ fun subSgn (env, denv) sgn1 (sgn2 as (_, loc2)) =
 
       | (L'.SgnConst sgis1, L'.SgnConst sgis2) =>
         let
+            (*val () = prefaces "subSgn" [("sgn1", p_sgn env sgn1),
+                                        ("sgn2", p_sgn env sgn2),
+                                        ("sgis1", p_sgn env (L'.SgnConst sgis1, loc2)),
+                                        ("sgis2", p_sgn env (L'.SgnConst sgis2, loc2))]*)
+
             fun folder (sgi2All as (sgi, loc), (env, denv)) =
                 let
+                    (*val () = prefaces "folder" [("sgis1", p_sgn env (L'.SgnConst sgis1, loc2))]*)
+
                     fun seek p =
                         let
                             fun seek (env, denv) ls =
@@ -2358,7 +2365,9 @@ fun subSgn (env, denv) sgn1 (sgn2 as (_, loc2)) =
                                  case sgi1 of
                                      L'.SgiVal (x', n1, c1) =>
                                      if x = x' then
-                                         (case unifyCons (env, denv) c1 c2 of
+                                         ((*prefaces "Pre" [("c1", p_con env c1),
+                                                          ("c2", p_con env c2)];*)
+                                          case unifyCons (env, denv) c1 c2 of
                                               [] => SOME (env, denv)
                                             | _ => NONE)
                                          handle CUnify (c1, c2, err) =>
@@ -2846,7 +2855,7 @@ fun elabDecl (dAll as (d, loc), (env, denv, gs : constraint list)) =
                     val c' = makeInstantiable c'
                 in
                     (*prefaces "DVal" [("x", Print.PD.string x),
-                                       ("c'", p_con env c')];*)
+                                     ("c'", p_con env c')];*)
                     ([(L'.DVal (x, n, c', e'), loc)], (env', denv, enD gs1 @ gs2 @ enD gs3 @ enD gs4 @ gs))
                 end
               | L.DValRec vis =>
diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el
index 39cb41f8..27271f11 100644
--- a/src/elisp/urweb-mode.el
+++ b/src/elisp/urweb-mode.el
@@ -197,7 +197,7 @@ See doc for the variable `urweb-mode-info'."
 
 (defconst urweb-font-lock-keywords
   `(;;(urweb-font-comments-and-strings)
-    ("\\(<\\sw+\\)\\(\\s-\\|\\sw\\|=\\|\"[^\"]*\"\\|{[^}]*}\\)*/?\\(>\\)"
+    ("\\(<\\sw+\\)\\(\\s-\\|\\sw\\|=\\|\"[^\"]*\"\\|{[^}]*}\\)*\\(/?>\\)"
      (1 font-lock-tag-face)
      (3 font-lock-tag-face))
     ("\\(</\\sw+>\\)"
@@ -350,7 +350,7 @@ See doc for the variable `urweb-mode-info'."
 
 ;;;###autoload (add-to-list 'load-path (file-name-directory load-file-name))
 ;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.s\\(ml\\|ig\\)\\'" . urweb-mode))
+(add-to-list 'auto-mode-alist '("\\.urs?\\'" . urweb-mode))
 
 ;;;###autoload
 (define-derived-mode urweb-mode fundamental-mode "Ur/Web"
diff --git a/tests/crud.ur b/tests/crud.ur
index b22cb157..02405f78 100644
--- a/tests/crud.ur
+++ b/tests/crud.ur
@@ -8,6 +8,28 @@ con colMeta = fn t_formT :: (Type * Type) => {
 }
 con colsMeta = fn cols :: {(Type * Type)} => $(Top.mapT2T colMeta cols)
 
+fun default (t ::: Type) (sh : show t) (rd : read t) (inj : sql_injectable t)
+            name : colMeta (t, string) =
+    {Nam = name,
+     Show = txt _,
+     Widget = fn nm :: Name => <xml><textbox{nm}/></xml>,
+     WidgetPopulated = fn (nm :: Name) n =>
+       <xml><textbox{nm} value={show _ n}/></xml>,
+     Parse = readError _,
+     Inject = _}
+
+val int = default _ _ _
+val float = default _ _ _
+val string = default _ _ _
+
+fun bool name = {Nam = name,
+                 Show = txt _,
+                 Widget = fn nm :: Name => <xml><checkbox{nm}/></xml>,
+                 WidgetPopulated = fn (nm :: Name) b =>
+                   <xml><checkbox{nm} checked={b}/></xml>,
+                 Parse = fn x => x,
+                 Inject = _}
+
 functor Make(M : sig
         con cols :: {(Type * Type)}
         constraint [Id] ~ cols
diff --git a/tests/crud.urs b/tests/crud.urs
index 866853d5..0b3a4191 100644
--- a/tests/crud.urs
+++ b/tests/crud.urs
@@ -8,6 +8,12 @@ con colMeta = fn t_formT :: (Type * Type) =>
                   Inject : sql_injectable t_formT.1}
 con colsMeta = fn cols :: {(Type * Type)} => $(mapT2T colMeta cols)
 
+val default : t ::: Type -> show t -> read t -> sql_injectable t -> string -> colMeta (t, string)
+val int : string -> colMeta (int, string)
+val float : string -> colMeta (float, string)
+val string : string -> colMeta (string, string)
+val bool : string -> colMeta (bool, bool)
+
 functor Make(M : sig
                  con cols :: {(Type * Type)}
                  constraint [Id] ~ cols
diff --git a/tests/crud1.ur b/tests/crud1.ur
index 80b2b103..3849e822 100644
--- a/tests/crud1.ur
+++ b/tests/crud1.ur
@@ -1,44 +1,12 @@
 table t1 : {Id : int, A : int, B : string, C : float, D : bool}
 
-val a = {Nam = "A",
-         Show = txt _,
-         Widget = fn nm :: Name => <xml><textbox{nm}/></xml>,
-         WidgetPopulated = fn (nm :: Name) n =>
-                              <xml><textbox{nm} value={show _ n}/></xml>,
-         Parse = readError _,
-         Inject = _}
-
-val b = {Nam = "B",
-         Show = txt _,
-         Widget = fn nm :: Name => <xml><textbox{nm}/></xml>,
-         WidgetPopulated = fn (nm :: Name) s =>
-                              <xml><textbox{nm} value={s}/></xml>,
-         Parse = readError _,
-         Inject = _}
-
-val c = {Nam = "C",
-         Show = txt _,
-         Widget = fn nm :: Name => <xml><textbox{nm}/></xml>,
-         WidgetPopulated = fn (nm :: Name) n =>
-                              <xml><textbox{nm} value={show _ n}/></xml>,
-         Parse = readError _,
-         Inject = _}
-
-val d = {Nam = "D",
-         Show = txt _,
-         Widget = fn nm :: Name => <xml><checkbox{nm}/></xml>,
-         WidgetPopulated = fn (nm :: Name) b =>
-                              <xml><checkbox{nm} checked={b}/></xml>,
-         Parse = fn x => x,
-         Inject = _}
-
 open Crud.Make(struct
                    val tab = t1
                              
                    val title = "Crud1"
                                
-                   val cols = {A = a,
-                               B = b,
-                               C = c,
-                               D = d}
+                   val cols = {A = Crud.int "A",
+                               B = Crud.string "B",
+                               C = Crud.float "C",
+                               D = Crud.bool "D"}
                end)