summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/elaborate.sml13
-rw-r--r--src/elisp/urweb-mode.el4
-rw-r--r--tests/crud.ur22
-rw-r--r--tests/crud.urs6
-rw-r--r--tests/crud1.ur40
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)