From 225068497c5fd41da12030a6bbf58a0fc9c294d0 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 9 Aug 2020 14:44:02 +0200
Subject: Import from CSV

---
 src/Lib/CSV.ml         | 76 ++++++++++++++++++++++++++++++++++++++++++++++++++
 src/Lib/Dom/Element.ml |  3 ++
 src/Lib/Dom/HE.ml      |  2 ++
 src/Lib/File.ml        |  9 ++++++
 src/Lib/Leaflet.ml     |  6 +++-
 src/Lib/Option.ml      |  9 ++++++
 6 files changed, 104 insertions(+), 1 deletion(-)
 create mode 100644 src/Lib/CSV.ml
 create mode 100644 src/Lib/Option.ml

(limited to 'src/Lib')

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
-- 
cgit v1.2.3