Mercurial > urweb
changeset 362:24a31b35e08f
Reusable column handlers for Crud
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 14 Oct 2008 17:18:59 -0400 (2008-10-14) |
parents | 260b680a6a04 |
children | 9d81597e03e8 |
files | src/elaborate.sml src/elisp/urweb-mode.el tests/crud.ur tests/crud.urs tests/crud1.ur |
diffstat | 5 files changed, 45 insertions(+), 40 deletions(-) [+] |
line wrap: on
line diff
--- a/src/elaborate.sml Tue Oct 14 16:41:48 2008 -0400 +++ b/src/elaborate.sml Tue Oct 14 17:18:59 2008 -0400 @@ -2167,8 +2167,15 @@ | (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 @@ 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 @@ 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 =>
--- a/src/elisp/urweb-mode.el Tue Oct 14 16:41:48 2008 -0400 +++ b/src/elisp/urweb-mode.el Tue Oct 14 17:18:59 2008 -0400 @@ -197,7 +197,7 @@ (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 @@ ;;;###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"
--- a/tests/crud.ur Tue Oct 14 16:41:48 2008 -0400 +++ b/tests/crud.ur Tue Oct 14 17:18:59 2008 -0400 @@ -8,6 +8,28 @@ } 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
--- a/tests/crud.urs Tue Oct 14 16:41:48 2008 -0400 +++ b/tests/crud.urs Tue Oct 14 17:18:59 2008 -0400 @@ -8,6 +8,12 @@ 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
--- a/tests/crud1.ur Tue Oct 14 16:41:48 2008 -0400 +++ b/tests/crud1.ur Tue Oct 14 17:18:59 2008 -0400 @@ -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)