summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/js/urweb.js19
-rw-r--r--lib/ur/basis.urs28
-rw-r--r--lib/ur/string.ur25
-rw-r--r--lib/ur/string.urs2
-rw-r--r--lib/ur/top.ur5
-rw-r--r--lib/ur/top.urs3
6 files changed, 71 insertions, 11 deletions
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index c3cab50a..5cc49fec 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -1050,6 +1050,18 @@ function inp(s, name) {
return x;
}
+function password(s, name) {
+ if (suspendScripts)
+ return;
+
+ var x = input(document.createElement("input"), s,
+ function(x) { return function(v) { if (x.value != v) x.value = v; }; }, "password", name);
+ x.value = s.data;
+ x.onkeyup = x.oninput = x.onchange = x.onpropertychange = function() { sv(s, x.value) };
+
+ return x;
+}
+
function selectValue(x) {
if (x.options.length == 0)
return "";
@@ -1212,6 +1224,13 @@ function sidx(s, ch) {
else
return r;
}
+function ssidx(h, n) {
+ var r = h.indexOf(n);
+ if (r == -1)
+ return null;
+ else
+ return r;
+}
function sspn(s, chs) {
for (var i = 0; i < s.length; ++i)
if (chs.indexOf(s.charAt(i)) != -1)
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index ce864563..5d0a0c8a 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -703,6 +703,7 @@ type css_value
val atom : string -> css_value
type url
val css_url : url -> css_value
+val sql_url : sql_injectable_prim url
type css_property
val property : string -> css_property
val value : css_property -> css_value -> css_property
@@ -796,9 +797,13 @@ val active : unit
val script : unit
-> tag [Code = transaction unit] head [] [] []
-(* Type for HTML5 "data-*" attributes. *)
+(* Type for HTML5 "data-*" and "aria-*" attributes. *)
+type data_attr_kind
+val data_kind : data_attr_kind
+val aria_kind : data_attr_kind
+
type data_attr
-val data_attr : string (* Key *) -> string (* Value *) -> data_attr
+val data_attr : data_attr_kind -> string (* Key *) -> string (* Value *) -> data_attr
(* This function will fail if the key doesn't meet HTML's lexical rules! *)
val data_attrs : data_attr -> data_attr -> data_attr
@@ -843,7 +848,7 @@ con scrollEvents = [Onscroll = transaction unit]
con boxEvents = focusEvents ++ mouseEvents ++ keyEvents ++ resizeEvents ++ scrollEvents
con tableEvents = focusEvents ++ mouseEvents ++ keyEvents
-con boxAttrs = [Data = data_attr, Id = id, Title = string] ++ boxEvents
+con boxAttrs = [Data = data_attr, Id = id, Title = string, Role = string] ++ boxEvents
con tableAttrs = [Data = data_attr, Id = id, Title = string] ++ tableEvents
val span : bodyTag boxAttrs
@@ -946,11 +951,11 @@ con formTag = fn (ty :: Type) (inner :: {Unit}) (attrs :: {Type}) =>
val hidden : formTag string [] [Data = data_attr, Id = string, Value = string]
val textbox : formTag string [] ([Value = string, Size = int, Placeholder = string, Source = source string, Onchange = transaction unit,
Ontext = transaction unit] ++ boxAttrs)
-val password : formTag string [] ([Value = string, Size = int, Placeholder = string] ++ boxAttrs)
+val password : formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs)
val textarea : formTag string [] ([Rows = int, Cols = int, Onchange = transaction unit,
Ontext = transaction unit] ++ boxAttrs)
-val checkbox : formTag bool [] ([Checked = bool] ++ boxAttrs)
+val checkbox : formTag bool [] ([Checked = bool, Onchange = transaction unit] ++ boxAttrs)
type file
val fileName : file -> option string
@@ -1003,18 +1008,19 @@ val label : bodyTag ([For = id, Accesskey = string] ++ tableAttrs)
con cformTag = fn (attrs :: {Type}) (inner :: {Unit}) =>
ctx ::: {Unit}
- -> [[Body] ~ ctx] =>
- unit -> tag attrs ([Body] ++ ctx) inner [] []
+ -> [[Body] ~ ctx] => [[Body] ~ inner] =>
+ unit -> tag attrs ([Body] ++ ctx) ([Body] ++ inner) [] []
val ctextbox : cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, Onchange = transaction unit,
Ontext = transaction unit] ++ boxAttrs) []
+val cpassword : cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, Onchange = transaction unit,
+ Ontext = transaction unit] ++ boxAttrs) []
val button : cformTag ([Value = string] ++ boxAttrs) []
-val ccheckbox : cformTag ([Value = bool, Size = int, Source = source bool] ++ boxAttrs) []
+val ccheckbox : cformTag ([Value = bool, Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs) []
-con cselect = [Cselect]
-val cselect : cformTag ([Source = source string, Onchange = transaction unit] ++ boxAttrs) cselect
-val coption : unit -> tag [Value = string, Selected = bool] cselect [] [] []
+val cselect : cformTag ([Source = source string, Onchange = transaction unit] ++ boxAttrs) [Cselect]
+val coption : unit -> tag [Value = string, Selected = bool] [Cselect, Body] [] [] []
val ctextarea : cformTag ([Value = string, Rows = int, Cols = int, Source = source string, Onchange = transaction unit,
Ontext = transaction unit] ++ boxAttrs) []
diff --git a/lib/ur/string.ur b/lib/ur/string.ur
index 59a8e5c5..da4e7eb4 100644
--- a/lib/ur/string.ur
+++ b/lib/ur/string.ur
@@ -86,3 +86,28 @@ fun newlines [ctx] [[Body] ~ ctx] (s : string) : xml ([Body] ++ ctx) [] [] =
fun isPrefix {Full = f, Prefix = p} =
length f >= length p && substring f {Start = 0, Len = length p} = p
+
+fun trim s =
+ let
+ val len = length s
+
+ fun findStart i =
+ if i < len && isspace (sub s i) then
+ findStart (i+1)
+ else
+ i
+
+ fun findFinish i =
+ if i >= 0 && isspace (sub s i) then
+ findFinish (i-1)
+ else
+ i
+
+ val start = findStart 0
+ val finish = findFinish (len - 1)
+ in
+ if finish >= start then
+ substring s {Start = start, Len = finish - start + 1}
+ else
+ ""
+ end
diff --git a/lib/ur/string.urs b/lib/ur/string.urs
index 0861279d..1bdca96c 100644
--- a/lib/ur/string.urs
+++ b/lib/ur/string.urs
@@ -33,3 +33,5 @@ val mp : (char -> char) -> string -> string
val newlines : ctx ::: {Unit} -> [[Body] ~ ctx] => string -> xml ([Body] ++ ctx) [] []
val isPrefix : {Full : t, Prefix : t} -> bool
+
+val trim : t -> t
diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index 5b9d43ab..3250a5a3 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -405,3 +405,8 @@ fun postFields pb =
"application/x-www-form-urlencoded" => postFields' (postData pb)
| _ => error <xml>Tried to get POST fields, but MIME type is not "application/x-www-form-urlencoded"</xml>
end
+
+fun max [t] ( _ : ord t) (x : t) (y : t) : t =
+ if x > y then x else y
+fun min [t] ( _ : ord t) (x : t) (y : t) : t =
+ if x < y then x else y
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
index 2ea86dc4..15bc6a22 100644
--- a/lib/ur/top.urs
+++ b/lib/ur/top.urs
@@ -287,3 +287,6 @@ val eqNullable' : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
val mkRead' : t ::: Type -> (string -> option t) -> string -> read t
val postFields : postBody -> list (string * string)
+
+val max : t ::: Type -> ord t -> t -> t -> t
+val min : t ::: Type -> ord t -> t -> t -> t