aboutsummaryrefslogtreecommitdiff
path: root/src/Lib
diff options
context:
space:
mode:
Diffstat (limited to 'src/Lib')
-rw-r--r--src/Lib/CSV.ml76
-rw-r--r--src/Lib/Dom/Element.ml3
-rw-r--r--src/Lib/Dom/HE.ml2
-rw-r--r--src/Lib/File.ml9
-rw-r--r--src/Lib/Leaflet.ml6
-rw-r--r--src/Lib/Option.ml9
6 files changed, 104 insertions, 1 deletions
diff --git a/src/Lib/CSV.ml b/src/Lib/CSV.ml
new file mode 100644
index 0000000..f0366f7
--- /dev/null
+++ b/src/Lib/CSV.ml
@@ -0,0 +1,76 @@
+let to_string lines =
+ let
+ cell_to_string cell =
+ if Js.String.includes "\"" cell then
+ "\"" ^ (Js.String.replaceByRe [%re "/\"/g"] "\"\"" cell) ^ "\""
+ else
+ cell
+ in let
+ line_to_string line =
+ line
+ |> Js.Array.map cell_to_string
+ |> Js.Array.joinWith ","
+ in lines
+ |> Js.Array.map line_to_string
+ |> Js.Array.joinWith "\n"
+
+let parse str =
+ let lines = [| |] in
+ let current_line = ref [| |] in
+ let current_cell = ref "" in
+ let in_quote = ref false in
+ let i = ref 0 in
+ let l = Js.String.length str in
+ let () = while !i < l do
+ let cc = Js.String.get str !i in
+ let nc = Js.String.get str (!i + 1) in
+ let () =
+ if !in_quote && cc == "\"" && nc == "\"" then
+ let () = current_cell := !current_cell ^ cc in
+ i := !i + 1
+ else if cc == "\"" then
+ in_quote := not !in_quote
+ else if not !in_quote && cc == "," then
+ let _ = Js.Array.push !current_cell !current_line in
+ current_cell := ""
+ else if not !in_quote && ((cc == "\r" && nc == "\n") || cc == "\n" || cc == "\r") then
+ let _ = Js.Array.push !current_cell !current_line in
+ let _ = Js.Array.push !current_line lines in
+ let _ = current_line := [| |] in
+ current_cell := ""
+ else
+ current_cell := !current_cell ^ cc
+ in
+ i := !i + 1
+ done
+ in
+ let _ =
+ if Js.String.length !current_cell > 0 then
+ let _ = Js.Array.push !current_cell !current_line in ()
+ else
+ ()
+ in
+ let _ =
+ if Js.Array.length !current_line > 0 then
+ let _ = Js.Array.push !current_line lines in ()
+ else
+ ()
+ in
+ lines
+
+let to_dicts lines =
+ let res = [| |] in
+ let () =
+ if Js.Array.length lines > 0 then
+ let header = Js.Array.unsafe_get lines 0 in
+ for i = 1 to Js.Array.length lines - 1 do
+ let line = Js.Array.unsafe_get lines i in
+ let dict = Js.Dict.empty() in
+ let () =
+ Js.Array.forEachi
+ (fun key j -> Js.Dict.set dict key (Js.Array.unsafe_get line j))
+ header
+ in
+ ignore (Js.Array.push dict res)
+ done
+ in res
diff --git a/src/Lib/Dom/Element.ml b/src/Lib/Dom/Element.ml
index 90c0321..e370cf5 100644
--- a/src/Lib/Dom/Element.ml
+++ b/src/Lib/Dom/Element.ml
@@ -43,3 +43,6 @@ let rec remove_children element =
let mount_on base element =
let () = remove_children base in
append_child base element
+
+external files : Dom.element -> string Js.Array.t = "files"
+ [@@bs.get]
diff --git a/src/Lib/Dom/HE.ml b/src/Lib/Dom/HE.ml
index c9aac16..6e658ce 100644
--- a/src/Lib/Dom/HE.ml
+++ b/src/Lib/Dom/HE.ml
@@ -7,3 +7,5 @@ let on_input f = H.EventAttr ("input", f)
let on_submit f = H.EventAttr ("submit", f)
let on_blur f = H.EventAttr ("blur", f)
+
+let on_change f = H.EventAttr ("change", f)
diff --git a/src/Lib/File.ml b/src/Lib/File.ml
index 0089001..d3597e7 100644
--- a/src/Lib/File.ml
+++ b/src/Lib/File.ml
@@ -10,3 +10,12 @@ let download filename content =
let () = Element.append_child Document.body a in
let () = Element.click a in
Element.remove_child Document.body a
+
+external reader : unit -> Dom.element = "FileReader"
+ [@@bs.new]
+
+external read_as_text : Dom.element -> string -> unit = "readAsText"
+ [@@bs.send]
+
+external result : Dom.element -> string = "result"
+ [@@bs.get]
diff --git a/src/Lib/Leaflet.ml b/src/Lib/Leaflet.ml
index 0cc7976..282b5b0 100644
--- a/src/Lib/Leaflet.ml
+++ b/src/Lib/Leaflet.ml
@@ -1,6 +1,10 @@
type layer
-external map : string -> layer = "map"
+type map_options =
+ { attributionControl : bool
+ }
+
+external map : string -> map_options -> layer = "map"
[@@bs.val] [@@bs.scope "L"]
external setView : layer -> float array -> int -> unit = "setView"
diff --git a/src/Lib/Option.ml b/src/Lib/Option.ml
new file mode 100644
index 0000000..1158b96
--- /dev/null
+++ b/src/Lib/Option.ml
@@ -0,0 +1,9 @@
+let withDefault default opt =
+ match opt with
+ | Some v -> v
+ | None -> default
+
+let map f opt =
+ match opt with
+ | Some v -> Some (f v)
+ | None -> None