summaryrefslogtreecommitdiff
path: root/lib/ur
diff options
context:
space:
mode:
Diffstat (limited to 'lib/ur')
-rw-r--r--lib/ur/basis.urs100
-rw-r--r--lib/ur/json.ur26
-rw-r--r--lib/ur/list.ur30
-rw-r--r--lib/ur/list.urs4
4 files changed, 102 insertions, 58 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 89a48d59..66cc0e50 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -192,11 +192,6 @@ val datetimeSecond : time -> int
val datetimeDayOfWeek : time -> int
-(** * Encryption *)
-
-val crypt : string -> string -> string
-
-
(** HTTP operations *)
con http_cookie :: Type -> Type
@@ -830,7 +825,7 @@ val data_attrs : data_attr -> data_attr -> data_attr
val head : unit -> tag [Data = data_attr] html head [] []
val title : unit -> tag [Data = data_attr] head [] [] []
-val link : unit -> tag [Data = data_attr, Id = id, Rel = string, Typ = string, Href = url, Media = string, Integrity = string, Crossorigin = string] head [] [] []
+val link : unit -> tag [Data = data_attr, Id = id, Rel = string, Title = string, Typ = string, Href = url, Media = string, Integrity = string, Crossorigin = string, Sizes = string] head [] [] []
val meta : unit -> tag [Nam = meta, Content = string, Id = id] head [] [] []
datatype mouseButton = Left | Right | Middle
@@ -842,14 +837,26 @@ type mouseEvent = { ScreenX : int, ScreenY : int, ClientX : int, ClientY : int,
con mouseEvents = map (fn _ :: Unit => mouseEvent -> transaction unit)
[Onclick, Oncontextmenu, Ondblclick, Onmousedown, Onmouseenter, Onmouseleave, Onmousemove, Onmouseout, Onmouseover, Onmouseup]
+(* Key arguments are character codes. *)
type keyEvent = { KeyCode : int,
CtrlKey : bool, ShiftKey : bool, AltKey : bool, MetaKey : bool }
con keyEvents = map (fn _ :: Unit => keyEvent -> transaction unit)
[Onkeydown, Onkeypress, Onkeyup]
-val body : unit -> tag ([Data = data_attr, Onload = transaction unit, Onresize = transaction unit, Onunload = transaction unit, Onhashchange = transaction unit]
- ++ mouseEvents ++ keyEvents)
+con focusEvents = [Onblur = transaction unit, Onfocus = transaction unit]
+
+con resizeEvents = [Onresize = transaction unit]
+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, Role = string, Align = string] ++ boxEvents
+con tableAttrs = [Data = data_attr, Id = id, Title = string, Align = string] ++ tableEvents
+
+val body : unit -> tag ([Data = data_attr, Id = id, Title = string, Onload = transaction unit, Onunload = transaction unit, Onhashchange = transaction unit]
+ ++ boxEvents)
html body [] []
con bodyTag = fn (attrs :: {Type}) =>
@@ -863,19 +870,6 @@ con bodyTagStandalone = fn (attrs :: {Type}) =>
val br : bodyTagStandalone [Data = data_attr, Id = id]
-con focusEvents = [Onblur = transaction unit, Onfocus = transaction unit]
-
-
-(* Key arguments are character codes. *)
-con resizeEvents = [Onresize = transaction unit]
-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, Role = string, Align = string] ++ boxEvents
-con tableAttrs = [Data = data_attr, Id = id, Title = string, Align = string] ++ tableEvents
-
val span : bodyTag boxAttrs
val div : bodyTag boxAttrs
@@ -975,21 +969,20 @@ con formTag = fn (ty :: Type) (inner :: {Unit}) (attrs :: {Type}) =>
nm :: Name -> unit
-> tag attrs ([Form] ++ ctx) inner [] [nm = ty]
-con inputAttrs = [Required = bool, Autofocus = bool]
-
+con inputAttrs' = [Required = bool, Autofocus = bool,
+ Onchange = transaction unit]
+con inputAttrs = inputAttrs' ++ [Oninput = transaction unit]
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 ++ inputAttrs)
-val password : formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
-val textarea : formTag string [] ([Rows = int, Cols = int, Placeholder = string, Onchange = transaction unit,
- Ontext = transaction unit] ++ boxAttrs ++ inputAttrs)
+val textbox : formTag string [] ([Value = string, Size = int, Placeholder = string, Source = source string] ++ boxAttrs ++ inputAttrs)
+val password : formTag string [] ([Value = string, Size = int, Placeholder = string] ++ boxAttrs ++ inputAttrs)
+val textarea : formTag string [] ([Rows = int, Cols = int, Placeholder = string] ++ boxAttrs ++ inputAttrs)
-val checkbox : formTag bool [] ([Checked = bool, Onchange = transaction unit] ++ boxAttrs)
+val checkbox : formTag bool [] ([Checked = bool] ++ boxAttrs ++ inputAttrs')
(* HTML5 widgets galore! *)
-type textWidget = formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
+type textWidget = formTag string [] ([Value = string, Size = int, Placeholder = string] ++ boxAttrs ++ inputAttrs)
val email : textWidget
val search : textWidget
@@ -997,14 +990,14 @@ val url_ : textWidget
val tel : textWidget
val color : textWidget
-val number : formTag float [] ([Value = float, Min = float, Max = float, Step = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
-val range : formTag float [] ([Value = float, Min = float, Max = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
-val date : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
-val datetime : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
-val datetime_local : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
-val month : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
-val week : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
-val timeInput : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs)
+val number : formTag float [] ([Value = float, Min = float, Max = float, Step = float, Size = int] ++ boxAttrs ++ inputAttrs)
+val range : formTag float [] ([Value = float, Min = float, Max = float, Size = int] ++ boxAttrs ++ inputAttrs)
+val date : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs)
+val datetime : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs)
+val datetime_local : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs)
+val month : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs)
+val week : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs)
+val timeInput : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs)
@@ -1034,10 +1027,10 @@ val remainingFields : postField -> string
con radio = [Body, Radio]
val radio : formTag (option string) radio [Data = data_attr, Id = id]
-val radioOption : unit -> tag ([Value = string, Checked = bool, Onchange = transaction unit] ++ boxAttrs) radio [] [] []
+val radioOption : unit -> tag ([Value = string, Checked = bool] ++ boxAttrs ++ inputAttrs') radio [] [] []
con select = [Select]
-val select : formTag string select ([Onchange = transaction unit] ++ boxAttrs)
+val select : formTag string select (boxAttrs ++ inputAttrs')
val option : unit -> tag [Data = data_attr, Value = string, Selected = bool] select [] [] []
val submit : ctx ::: {Unit} -> use ::: {Type}
@@ -1065,8 +1058,7 @@ con cformTag = fn (attrs :: {Type}) (inner :: {Unit}) =>
-> [[Body] ~ ctx] => [[Body] ~ inner] =>
unit -> tag attrs ([Body] ++ ctx) ([Body] ++ inner) [] []
-type ctext = cformTag ([Value = string, Size = int, Source = source string, Placeholder = string,
- Onchange = transaction unit, Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) []
+type ctext = cformTag ([Value = string, Size = int, Source = source string, Placeholder = string] ++ boxAttrs ++ inputAttrs) []
val ctextbox : ctext
val cpassword : ctext
@@ -1076,23 +1068,25 @@ val curl : ctext
val ctel : ctext
val ccolor : ctext
-val cnumber : cformTag ([Source = source (option float), Min = float, Max = float, Step = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
-val crange : cformTag ([Source = source (option float), Min = float, Max = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
-val cdate : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
-val cdatetime : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
-val cdatetime_local : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
-val cmonth : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
-val cweek : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
-val ctime : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
+val cnumber : cformTag ([Source = source (option float), Min = float, Max = float, Step = float, Size = int] ++ boxAttrs ++ inputAttrs) []
+val crange : cformTag ([Source = source (option float), Min = float, Max = float, Size = int] ++ boxAttrs ++ inputAttrs) []
+val cdate : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) []
+val cdatetime : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) []
+val cdatetime_local : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) []
+val cmonth : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) []
+val cweek : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) []
+val ctime : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) []
val button : cformTag ([Value = string, Disabled = bool] ++ boxAttrs) []
-val ccheckbox : cformTag ([Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
+val ccheckbox : cformTag ([Size = int, Source = source bool] ++ boxAttrs ++ inputAttrs') []
+
+val cradio : cformTag ([Source = source (option string), Value = string] ++ boxAttrs ++ inputAttrs') []
-val cselect : cformTag ([Source = source string, Onchange = transaction unit] ++ boxAttrs) [Cselect]
+val cselect : cformTag ([Source = source string] ++ boxAttrs ++ inputAttrs') [Cselect]
val coption : unit -> tag [Value = string, Selected = bool] [Cselect, Body] [] [] []
-val ctextarea : cformTag ([Rows = int, Cols = int, Placeholder = string, Source = source string, Onchange = transaction unit,
+val ctextarea : cformTag ([Rows = int, Cols = int, Placeholder = string, Source = source string,
Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) []
(*** Tables *)
diff --git a/lib/ur/json.ur b/lib/ur/json.ur
index 9288a6dd..817ec16e 100644
--- a/lib/ur/json.ur
+++ b/lib/ur/json.ur
@@ -46,10 +46,16 @@ fun escape s =
let
val ch = String.sub s 0
in
- (if ch = #"\"" || ch = #"\\" then
- "\\" ^ String.str ch
- else
- String.str ch) ^ esc (String.suffix s 1)
+ (case ch of
+ #"\n" => "\\n"
+ | #"\r" => "\\r"
+ | #"\t" => "\\t"
+ | #"\"" => "\\\""
+ | #"\'" => "\\\'"
+ | #"\\" => "\\\\"
+ | #"/" => "\\/"
+ | x => String.str ch
+ ) ^ esc (String.suffix s 1)
end
in
"\"" ^ esc s
@@ -90,7 +96,17 @@ fun unescape s =
if i+1 >= len then
error <xml>JSON unescape: Bad escape sequence: {[s]}</xml>
else
- String.str (String.sub s (i+1)) ^ unesc (i+2)
+ (case String.sub s (i+1) of
+ #"n" => "\n"
+ | #"r" => "\r"
+ | #"t" => "\t"
+ | #"\"" => "\""
+ | #"\'" => "\'"
+ | #"\\" => "\\"
+ | #"/" => "/"
+ | x => error <xml>JSON unescape: Bad escape char: {[x]}</xml>)
+ ^
+ unesc (i+2)
| _ => String.str ch ^ unesc (i+1)
end
in
diff --git a/lib/ur/list.ur b/lib/ur/list.ur
index cc533676..95d6fbc8 100644
--- a/lib/ur/list.ur
+++ b/lib/ur/list.ur
@@ -204,6 +204,21 @@ fun exists [a] f =
ex
end
+fun existsM [m] (_ : monad m) [a] f =
+ let
+ fun ex ls =
+ case ls of
+ [] => return False
+ | x :: ls =>
+ b <- f x;
+ if b then
+ return True
+ else
+ ex ls
+ in
+ ex
+ end
+
fun foldlMap [a] [b] [c] f =
let
fun fold ls' st ls =
@@ -240,6 +255,21 @@ fun find [a] f =
find'
end
+fun findM [m] (_ : monad m) [a] f =
+ let
+ fun find' ls =
+ case ls of
+ [] => return None
+ | x :: ls =>
+ b <- f x;
+ if b then
+ return (Some x)
+ else
+ find' ls
+ in
+ find'
+ end
+
fun search [a] [b] f =
let
fun search' ls =
diff --git a/lib/ur/list.urs b/lib/ur/list.urs
index fd56679d..fe730152 100644
--- a/lib/ur/list.urs
+++ b/lib/ur/list.urs
@@ -42,6 +42,8 @@ val filter : a ::: Type -> (a -> bool) -> t a -> t a
val exists : a ::: Type -> (a -> bool) -> t a -> bool
+val existsM : m ::: (Type -> Type) -> monad m -> a ::: Type -> (a -> m bool) -> t a -> m bool
+
val foldlM : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type
-> (a -> b -> m b) -> b -> t a -> m b
@@ -58,6 +60,8 @@ val mem : a ::: Type -> eq a -> a -> t a -> bool
val find : a ::: Type -> (a -> bool) -> t a -> option a
+val findM : m ::: (Type -> Type) -> monad m -> a ::: Type -> (a -> m bool) -> t a -> m (option a)
+
val search : a ::: Type -> b ::: Type -> (a -> option b) -> t a -> option b
val all : a ::: Type -> (a -> bool) -> t a -> bool
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-19 17:13:24 +0000