Allow to customize icons

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]