Import from CSV

9 files changed, 241 insertions, 68 deletions

diff --git a/public/main.css b/public/main.css
index fdedc4c..dfd5c1b 100644
--- a/public/main.css
+++ b/public/main.css
@@ -50,6 +50,18 @@ body {
   margin-right: 1.5rem;
 }
 
+/* Header */
+
+#g-Header__ImportInput {
+  display: none;
+}
+
+.g-Header__ImportLabel {
+  cursor: pointer;
+  font-size: 50%;
+  text-decoration: underline;
+}
+
 /* Modal */
 
 :root {
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
diff --git a/src/State.ml b/src/State.ml
index 4c6cedb..c1cb99d 100644
--- a/src/State.ml
+++ b/src/State.ml
@@ -60,25 +60,10 @@ let from_url_string str =
     (Js.Array.from (Js.String.castToArrayLike ((String.decode str) ^ sep)))
   in res
 
-(* CSV Serialization *)
-
-let to_csv_line marker =
-  [| Js.Float.toString marker.pos.lat
-  ;  Js.Float.toString marker.pos.lng
-  ;  marker.name
-  ;  marker.color
-  ;  marker.icon
-  |]
-    |> Js.Array.joinWith ","
-
-let to_csv_string state =
-  state
-    |> Js.Array.map to_csv_line
-    |> Fun.flip Js.Array.concat [| "lat,lng,name,color,icon" |]
-    |> Js.Array.joinWith "\n"
-
 (* Colors *)
 
+let default_color = "#3f92cf"
+
 let colors =
   Js.Array.reduce
     (fun colors marker ->
@@ -87,3 +72,48 @@ let colors =
       else
         colors)
     [| |]
+
+(* CSV Serialization *)
+
+let lat_key = "lat"
+let lng_key = "lng"
+let name_key = "name"
+let color_key = "color"
+let icon_key = "icon"
+
+let to_csv_string state =
+  let to_csv_line marker =
+    [| Js.Float.toString marker.pos.lat
+    ;  Js.Float.toString marker.pos.lng
+    ;  marker.name
+    ;  marker.color
+    ;  marker.icon
+    |]
+  in let
+    header =
+      [| lat_key; lng_key; name_key; color_key; icon_key |]
+  in
+  state
+    |> Js.Array.map to_csv_line
+    |> Fun.flip Js.Array.concat [| header |]
+    |> CSV.to_string
+
+let from_dicts dicts =
+  Js.Array.map
+    (fun dict ->
+      (* let get key default = Js.Dict.get dict key |> Option.withDefault default in *)
+      { pos =
+        { lat =
+          Js.Dict.get dict lat_key
+            |> Option.map Js.Float.fromString
+            |> Option.withDefault 0.0
+        ; lng =
+          Js.Dict.get dict lng_key
+            |> Option.map Js.Float.fromString
+            |> Option.withDefault 0.0
+        }
+      ; name = Js.Dict.get dict name_key |> Option.withDefault ""
+      ; color = Js.Dict.get dict color_key |> Option.withDefault default_color
+      ; icon = Js.Dict.get dict icon_key |> Option.withDefault ""
+      })
+    dicts
diff --git a/src/View/Map.ml b/src/View/Map.ml
index 8f74b76..c85a791 100644
--- a/src/View/Map.ml
+++ b/src/View/Map.ml
@@ -1,4 +1,41 @@
-let mapView state =
+let state_from_hash () =
+  let hash = Js.String.sliceToEnd ~from:1 (Location.hash Document.location) in
+  State.from_url_string hash
+
+let rec reload_from_hash state map markers focus =
+  let update_state new_state =
+    let () = History.push_state "" "" ("#" ^ State.to_url_string new_state) () in
+    reload_from_hash state map markers false
+  in
+
+  let on_remove pos =
+    update_state (State.remove !state pos) in
+
+  let on_update previousPos pos name color icon =
+    update_state (State.update !state previousPos { pos = pos; name = name; color = color; icon = icon }) in
+
+  let () =
+    if Js.Array.length (Leaflet.get_layers markers ()) > 0 then
+      Leaflet.clear_layers markers
+    else
+      ()
+  in
+  let () = state := state_from_hash () in
+  let colors = State.colors !state in
+  let () =
+    Js.Array.forEach
+      (fun (m: State.marker_state) -> Leaflet.add_layer markers (Marker.create on_remove on_update colors m.pos m.name m.color m.icon))
+      !state
+  in
+  if focus then
+    if Js.Array.length (Leaflet.get_layers markers ()) > 0 then
+      Leaflet.fit_bounds map (Leaflet.get_bounds markers ()) { padding = [| 50.; 50. |] }
+    else
+      Leaflet.setView map [| 51.505; -0.09 |] 2
+  else
+    ()
+
+let mapView state map markers =
   H.div
     [| HA.class_ "g-Layout__Page" |]
     [| H.div
@@ -8,9 +45,36 @@ let mapView state =
             ;  HA.href "#"
             |]
             [| H.text "Map" |]
-        ;  Button.text
-            [| HE.on_click (fun _ -> File.download "map.csv" (State.to_csv_string !state)) |]
-            [| H.text "Export" |]
+        ;  Layout.line
+            [| |]
+            [| H.input
+                [| HA.id "g-Header__ImportInput"
+                ;  HA.type_ "file"
+                ;  HE.on_change (fun e ->
+                    match !map with
+                    | Some map ->
+                        let reader = File.reader () in
+                        let () = Element.add_event_listener reader "load" (fun _ ->
+                          let str = File.result reader in
+                          let new_state = State.from_dicts (CSV.to_dicts (CSV.parse str)) in
+                          let () = History.push_state "" "" ("#" ^ State.to_url_string new_state) () in
+                          reload_from_hash state map markers true)
+                        in
+                        File.read_as_text reader (
+                            Js.Array.unsafe_get (Element.files (Event.target e)) 0)
+                    | _ ->
+                        ())
+                |]
+                [| |]
+            ;  H.label
+                [| HA.for_ "g-Header__ImportInput"
+                ;  HA.class_ "g-Header__ImportLabel"
+                |]
+                [| H.text "Import" |]
+            ;  Button.text
+                [| HE.on_click (fun _ -> File.download "map.csv" (State.to_csv_string !state)) |]
+                [| H.text "Export" |]
+            |]
         |]
     ; H.div
         [| HA.class_ "g-Map" |]
@@ -20,64 +84,26 @@ let mapView state =
         |]
     |]
 
-let state_from_hash () =
-  let hash = Js.String.sliceToEnd ~from:1 (Location.hash Document.location) in
-  State.from_url_string hash
-
-let installMap state =
-  let map = Leaflet.map "g-Map__Content" in
+let install_map state map_ref markers =
+  let map = Leaflet.map "g-Map__Content" { attributionControl = false } in
+  let () = map_ref := Some map in
   let title_layer = Leaflet.title_layer "http://{s}.tile.osm.org/{z}/{x}/{y}.png" in
-  let markers = Leaflet.feature_group [| |] in
   let () = Leaflet.add_layer map markers in
   let () = Leaflet.add_layer map title_layer in
 
-  let rec reload_from_hash focus =
-    let update_state new_state =
-      let () = History.push_state "" "" ("#" ^ State.to_url_string new_state) () in
-      reload_from_hash false
-    in
-
-    let on_remove pos =
-      update_state (State.remove !state pos) in
-
-    let on_update previousPos pos name color icon =
-      update_state (State.update !state previousPos { pos = pos; name = name; color = color; icon = icon }) in
-
-    let () =
-      if Js.Array.length (Leaflet.get_layers markers ()) > 0 then
-        Leaflet.clear_layers markers
-      else
-        ()
-    in
-    let () = state := state_from_hash () in
-    let colors = State.colors !state in
-    let () =
-      Js.Array.forEach
-        (fun (m: State.marker_state) -> Leaflet.add_layer markers (Marker.create on_remove on_update colors m.pos m.name m.color m.icon))
-        !state
-    in
-    if focus then
-      if Js.Array.length (Leaflet.get_layers markers ()) > 0 then
-        Leaflet.fit_bounds map (Leaflet.get_bounds markers ()) { padding = [| 50.; 50. |] }
-      else
-        Leaflet.setView map [| 51.505; -0.09 |] 2
-    else
-      ()
-  in
-
   (* Init markers from url *)
-  let () = reload_from_hash true in
+  let () = reload_from_hash state map markers true in
 
   (* Reload the map if the URL changes *)
   let () = Element.add_event_listener Window.window "popstate" (fun _ ->
-    reload_from_hash true)
+    reload_from_hash state map markers true)
   in
 
   let add_marker pos name color icon =
     let new_marker = { State.pos = pos; name = name; color = color; icon = icon } in
     let new_state = State.update !state pos new_marker in
     let () = History.push_state "" "" ("#" ^ State.to_url_string new_state) () in
-    reload_from_hash false
+    reload_from_hash state map markers false
   in
 
   (* Context menu *)
@@ -99,5 +125,7 @@ let installMap state =
 
 let render () =
   let state = ref (state_from_hash ()) in
-  let _ = Js.Global.setTimeout (fun _ -> installMap state) 0 in
-  mapView state
+  let map = ref None in
+  let markers = Leaflet.feature_group [| |] in
+  let _ = Js.Global.setTimeout (fun _ -> install_map state map markers) 0 in
+  mapView state map markers