diff options
| -rw-r--r-- | demo/crud2.sql | 6 | ||||
| -rw-r--r-- | demo/crud2.ur | 34 | ||||
| -rw-r--r-- | demo/crud2.urp | 5 | ||||
| -rw-r--r-- | demo/prose | 4 | ||||
| -rw-r--r-- | lib/basis.urs | 3 | ||||
| -rw-r--r-- | lib/top.ur | 2 | ||||
| -rw-r--r-- | lib/top.urs | 2 | ||||
| -rw-r--r-- | src/monoize.sml | 9 |
8 files changed, 64 insertions, 1 deletions
diff --git a/demo/crud2.sql b/demo/crud2.sql new file mode 100644 index 00000000..88568f2a --- /dev/null +++ b/demo/crud2.sql @@ -0,0 +1,6 @@ +CREATE TABLE uw_Crud2_t(uw_id int8 NOT NULL, uw_nam text NOT NULL, + uw_ready bool NOT NULL); + + CREATE SEQUENCE uw_Crud2_Crud_Make_seq; + +
\ No newline at end of file diff --git a/demo/crud2.ur b/demo/crud2.ur new file mode 100644 index 00000000..1db376d4 --- /dev/null +++ b/demo/crud2.ur @@ -0,0 +1,34 @@ +table t : {Id : int, Nam : string, Ready : bool} + +open Crud.Make(struct + val tab = t + + val title = "Are you ready?" + + val cols = {Nam = Crud.string "Name", + Ready = {Nam = "Ready", + Show = (fn b => if b then + <xml>Ready!</xml> + else + <xml>Not ready</xml>), + Widget = (fn (nm :: Name) => <xml> + <select{nm}> + <option>Ready</option> + <option>Not ready</option> + </select> + </xml>), + WidgetPopulated = (fn (nm :: Name) b => <xml> + <select{nm}> + <option selected={b}>Ready</option> + <option selected={not b}>Not ready</option> + </select> + </xml>), + Parse = (fn s => + case s of + "Ready" => True + | "Not ready" => False + | _ => error <xml>Invalid ready/not ready</xml>), + Inject = _ + } + } + end) diff --git a/demo/crud2.urp b/demo/crud2.urp new file mode 100644 index 00000000..d552e1a7 --- /dev/null +++ b/demo/crud2.urp @@ -0,0 +1,5 @@ +database dbname=test +sql crud2.sql + +crud +crud2 @@ -152,3 +152,7 @@ crud1.urp <p>Looking at <tt>crud1.ur</tt>, we see that a use of the functor is almost trivial. Only the value components of the argument structure must be provided. The column row type is inferred, and the disjointness constraint is proved automatically.</p> <p>We won't go into detail on the implementation of <tt>Crud.Make</tt>. The types of the functions used there can be found in the signatures of the built-in <tt>Basis</tt> module and the <tt>Top</tt> module from the standard library. The signature of the first and the signature and implementation of the second can be found in the <tt>lib</tt> directory of the Ur/Web distribution.</p> + +crud2.urp + +<p>This example shows another application of <tt>Crud.Make</tt>. We mix one standard column with one customized column. We write an underscore for the <tt>Inject</tt> field of meta-data, since the type class facility can infer that witness.</p> diff --git a/lib/basis.urs b/lib/basis.urs index a8c81353..fce29ff9 100644 --- a/lib/basis.urs +++ b/lib/basis.urs @@ -18,6 +18,7 @@ val eq_int : eq int val eq_float : eq float val eq_string : eq string val eq_bool : eq bool +val mkEq : t ::: Type -> (t -> t -> bool) -> eq t class num val zero : t ::: Type -> num t -> t @@ -365,7 +366,7 @@ val radioOption : unit -> tag [Value = string] radio [] [] [] con select = [Select] val select : formTag string select [] -val option : unit -> tag [Value = string] select [] [] [] +val option : unit -> tag [Value = string, Selected = bool] select [] [] [] val submit : ctx ::: {Unit} -> use ::: {Type} -> fn [[Form] ~ ctx] => @@ -1,3 +1,5 @@ +fun not b = if b then False else True + con idT (t :: Type) = t con record (t :: {Type}) = $t con fstTT (t :: (Type * Type)) = t.1 diff --git a/lib/top.urs b/lib/top.urs index 29a1acf1..22cebb16 100644 --- a/lib/top.urs +++ b/lib/top.urs @@ -1,3 +1,5 @@ +val not : bool -> bool + con idT = fn t :: Type => t con record = fn t :: {Type} => $t con fstTT = fn t :: (Type * Type) => t.1 diff --git a/src/monoize.sml b/src/monoize.sml index 6a12306b..5fda4fa1 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -597,6 +597,15 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L'.TFfi ("Basis", "bool"), loc), (L'.EBinop ("!strcmp", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc), fm) + | L.ECApp ((L.EFfi ("Basis", "mkEq"), _), t) => + let + val t = monoType env t + val b = (L'.TFfi ("Basis", "bool"), loc) + val dom = (L'.TFun (t, (L'.TFun (t, b), loc)), loc) + in + ((L'.EAbs ("f", dom, dom, + (L'.ERel 0, loc)), loc), fm) + end | L.ECApp ((L.EFfi ("Basis", "zero"), _), t) => let |