aboutsummaryrefslogtreecommitdiff
path: root/src/Lib/Dom
diff options
context:
space:
mode:
Diffstat (limited to 'src/Lib/Dom')
-rw-r--r--src/Lib/Dom/Document.ml3
-rw-r--r--src/Lib/Dom/Element.ml12
-rw-r--r--src/Lib/Dom/Event.ml3
-rw-r--r--src/Lib/Dom/H.ml49
-rw-r--r--src/Lib/Dom/HA.ml23
-rw-r--r--src/Lib/Dom/HE.ml7
-rw-r--r--src/Lib/Dom/History.ml2
-rw-r--r--src/Lib/Dom/Location.ml7
-rw-r--r--src/Lib/Dom/Window.ml2
9 files changed, 75 insertions, 33 deletions
diff --git a/src/Lib/Dom/Document.ml b/src/Lib/Dom/Document.ml
index 867e28c..39c1bb4 100644
--- a/src/Lib/Dom/Document.ml
+++ b/src/Lib/Dom/Document.ml
@@ -12,3 +12,6 @@ let querySelectorUnsafe id =
external createTextNode : string -> Dom.element = "createTextNode"
[@@bs.val] [@@bs.scope "document"]
+
+external location : Location.location = "location"
+ [@@bs.val] [@@bs.scope "document"]
diff --git a/src/Lib/Dom/Element.ml b/src/Lib/Dom/Element.ml
index 3e3b78a..a72b783 100644
--- a/src/Lib/Dom/Element.ml
+++ b/src/Lib/Dom/Element.ml
@@ -1,4 +1,6 @@
-external setValue : Dom.element -> string -> unit = "value" [@@bs.set]
+external set_value : Dom.element -> string -> unit = "value" [@@bs.set]
+
+external value : Dom.element -> string = "value" [@@bs.get]
external setTextContent : Dom.element -> string -> unit = "textContent"
[@@bs.set]
@@ -34,9 +36,9 @@ let removeFirstChild element =
true
| _ -> false
-let rec removeChildren element =
- if removeFirstChild element then removeChildren element else ()
+let rec remove_children element =
+ if removeFirstChild element then remove_children element else ()
-let mountOn base element =
- let () = removeChildren base in
+let mount_on base element =
+ let () = remove_children base in
appendChild base element
diff --git a/src/Lib/Dom/Event.ml b/src/Lib/Dom/Event.ml
new file mode 100644
index 0000000..acdc9fd
--- /dev/null
+++ b/src/Lib/Dom/Event.ml
@@ -0,0 +1,3 @@
+external preventDefault : Dom.event -> unit = "preventDefault" [@@bs.send]
+
+external target : Dom.event -> Dom.element = "target" [@@bs.get]
diff --git a/src/Lib/Dom/H.ml b/src/Lib/Dom/H.ml
index 8183a02..d547a70 100644
--- a/src/Lib/Dom/H.ml
+++ b/src/Lib/Dom/H.ml
@@ -1,7 +1,10 @@
(* Element creation *)
-let h tag ?(attributes = [||]) ?(eventListeners = [||]) ?(children = [||]) () :
- Dom.element =
+type attribute =
+ | TextAttr of string * string
+ | EventAttr of string * (Dom.event -> unit)
+
+let h tag attributes children =
let element =
if tag == "svg" || tag == "path" then
Document.createElementNS "http://www.w3.org/2000/svg" tag
@@ -9,17 +12,19 @@ let h tag ?(attributes = [||]) ?(eventListeners = [||]) ?(children = [||]) () :
in
let () =
Js.Array.forEach
- (fun (name, value) -> Element.setAttribute element name value)
+ (fun attr ->
+ match attr with
+ | TextAttr (name, value) ->
+ Element.setAttribute element name value
+
+ | EventAttr (name, eventListener) ->
+ Element.addEventListener element name eventListener)
attributes
in
let () =
Js.Array.forEach
- (fun (name, eventListener) ->
- Element.addEventListener element name eventListener)
- eventListeners
- in
- let () =
- Js.Array.forEach (fun child -> Element.appendChild element child) children
+ (fun child -> Element.appendChild element child)
+ children
in
element
@@ -45,28 +50,16 @@ let form = h "form"
let label = h "label"
-let input_ = h "input"
-
-(* Attribute creation *)
-
-let id v = ("id", v)
-
-let className v = ("class", v)
-
-let viewBox v = ("viewBox", v)
-
-let d v = ("d", v)
-
-let type_ v = ("type", v)
+let input = h "input"
-let min_ v = ("min", v)
+let textarea = h "textarea"
-let value v = ("value", v)
+let i = h "i"
-(* Event listeners *)
+let a = h "a"
-let onClick f = ("click", f)
+let h1 = h "h1"
-let onInput f = ("input", f)
+let h2 = h "h2"
-let onSubmit f = ("submit", f)
+let h3 = h "h3"
diff --git a/src/Lib/Dom/HA.ml b/src/Lib/Dom/HA.ml
new file mode 100644
index 0000000..a7a45ce
--- /dev/null
+++ b/src/Lib/Dom/HA.ml
@@ -0,0 +1,23 @@
+(* Attribute creation *)
+
+let id v = H.TextAttr ("id", v)
+
+let class_ v = H.TextAttr ("class", v)
+
+let viewBox v = H.TextAttr ("viewBox", v)
+
+let d v = H.TextAttr ("d", v)
+
+let type_ v = H.TextAttr ("type", v)
+
+let min_ v = H.TextAttr ("min", v)
+
+let value v = H.TextAttr ("value", v)
+
+let for_ v = H.TextAttr ("for", v)
+
+let style v = H.TextAttr ("style", v)
+
+let href v = H.TextAttr ("href", v)
+
+let autocomplete v = H.TextAttr ("autocomplete", v)
diff --git a/src/Lib/Dom/HE.ml b/src/Lib/Dom/HE.ml
new file mode 100644
index 0000000..098259a
--- /dev/null
+++ b/src/Lib/Dom/HE.ml
@@ -0,0 +1,7 @@
+(* Event listeners *)
+
+let on_click f = H.EventAttr ("click", f)
+
+let on_input f = H.EventAttr ("input", f)
+
+let on_submit f = H.EventAttr ("submit", f)
diff --git a/src/Lib/Dom/History.ml b/src/Lib/Dom/History.ml
new file mode 100644
index 0000000..ce7a877
--- /dev/null
+++ b/src/Lib/Dom/History.ml
@@ -0,0 +1,2 @@
+external push_state : string -> string -> string -> unit -> unit = "pushState"
+ [@@bs.val] [@@bs.scope "history"]
diff --git a/src/Lib/Dom/Location.ml b/src/Lib/Dom/Location.ml
new file mode 100644
index 0000000..2c58705
--- /dev/null
+++ b/src/Lib/Dom/Location.ml
@@ -0,0 +1,7 @@
+external set : Dom.element -> string -> unit = "location"
+ [@@bs.set]
+
+type location
+
+external hash : location -> string = "hash"
+ [@@bs.get]
diff --git a/src/Lib/Dom/Window.ml b/src/Lib/Dom/Window.ml
new file mode 100644
index 0000000..3abc921
--- /dev/null
+++ b/src/Lib/Dom/Window.ml
@@ -0,0 +1,2 @@
+external window : Dom.element = "window"
+ [@@bs.val]