From ad6abcd5fc5e4e66062c8a01b511a1bd4bda2e94 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 9 Aug 2020 08:37:18 +0200
Subject: Export as CSV

---
 src/Lib/Dom/Element.ml |  3 +++
 src/Lib/Dom/HA.ml      |  2 ++
 src/Lib/File.ml        | 12 ++++++++++++
 src/Lib/Fun.ml         |  2 ++
 src/Lib/URI.ml         |  2 ++
 src/State.ml           | 23 ++++++++++++++++++++---
 src/View/Form.ml       |  2 +-
 src/View/Map.ml        | 19 +++++++++++--------
 8 files changed, 53 insertions(+), 12 deletions(-)
 create mode 100644 src/Lib/File.ml
 create mode 100644 src/Lib/Fun.ml
 create mode 100644 src/Lib/URI.ml

(limited to 'src')

diff --git a/src/Lib/Dom/Element.ml b/src/Lib/Dom/Element.ml
index 3c63ef4..90c0321 100644
--- a/src/Lib/Dom/Element.ml
+++ b/src/Lib/Dom/Element.ml
@@ -27,6 +27,9 @@ external first_child : Dom.element -> Dom.element Js.Nullable.t = "firstChild"
 external remove_child : Dom.element -> Dom.element -> unit = "removeChild"
   [@@bs.send]
 
+external click : Dom.element -> unit = "click"
+  [@@bs.send]
+
 let remove_first_child element =
   match Js.toOption (first_child element) with
   | Some child ->
diff --git a/src/Lib/Dom/HA.ml b/src/Lib/Dom/HA.ml
index 53fb84d..ce02f2a 100644
--- a/src/Lib/Dom/HA.ml
+++ b/src/Lib/Dom/HA.ml
@@ -39,3 +39,5 @@ let style v = H.TextAttr ("style", v)
 let href v = H.TextAttr ("href", v)
 
 let autocomplete v = H.TextAttr ("autocomplete", v)
+
+let download v = H.TextAttr ("download", v)
diff --git a/src/Lib/File.ml b/src/Lib/File.ml
new file mode 100644
index 0000000..0089001
--- /dev/null
+++ b/src/Lib/File.ml
@@ -0,0 +1,12 @@
+let download filename content =
+  let a =
+    H.a
+      [| HA.href ("data:text/plain;charset=utf-8," ^ URI.encode content)
+      ;  HA.download filename
+      ;  HA.style "display:none"
+      |]
+      [| |]
+  in
+  let () = Element.append_child Document.body a in
+  let () = Element.click a in
+  Element.remove_child Document.body a
diff --git a/src/Lib/Fun.ml b/src/Lib/Fun.ml
new file mode 100644
index 0000000..bf1eb38
--- /dev/null
+++ b/src/Lib/Fun.ml
@@ -0,0 +1,2 @@
+let flip f b a =
+  f a b
diff --git a/src/Lib/URI.ml b/src/Lib/URI.ml
new file mode 100644
index 0000000..705bc7b
--- /dev/null
+++ b/src/Lib/URI.ml
@@ -0,0 +1,2 @@
+external encode : string -> string = "encodeURIComponent"
+  [@@bs.val]
diff --git a/src/State.ml b/src/State.ml
index 59391d2..4c6cedb 100644
--- a/src/State.ml
+++ b/src/State.ml
@@ -17,7 +17,7 @@ let last_added state =
   else
     None
 
-(* Serialization *)
+(* URL Serialization *)
 
 let sep = "|"
 
@@ -30,13 +30,13 @@ let marker_to_string marker =
   |]
     |> Js.Array.joinWith sep
 
-let to_string state =
+let to_url_string state =
   state
     |> Js.Array.map marker_to_string
     |> Js.Array.joinWith sep
     |> String.encode
 
-let from_string str =
+let from_url_string str =
   let (_, _, res) = Js.Array.reduce
     (fun (acc_str, acc_marker, acc_state) c ->
       let length = Js.Array.length acc_marker in
@@ -60,6 +60,23 @@ let from_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 colors =
diff --git a/src/View/Form.ml b/src/View/Form.ml
index cc95210..53fbb7d 100644
--- a/src/View/Form.ml
+++ b/src/View/Form.ml
@@ -47,7 +47,7 @@ let color_input default_colors id label init_value on_input =
                 ;  HA.type_ "button"
                 |]
                 [| |])
-        |> (fun xs -> Js.Array.concat xs [| input |]))
+        |> Fun.flip Js.Array.concat [| input |])
     |]
 
 let textarea id label init_value on_input =
diff --git a/src/View/Map.ml b/src/View/Map.ml
index eda934c..8f74b76 100644
--- a/src/View/Map.ml
+++ b/src/View/Map.ml
@@ -1,4 +1,4 @@
-let mapView =
+let mapView state =
   H.div
     [| HA.class_ "g-Layout__Page" |]
     [| H.div
@@ -8,6 +8,9 @@ let mapView =
             ;  HA.href "#"
             |]
             [| H.text "Map" |]
+        ;  Button.text
+            [| HE.on_click (fun _ -> File.download "map.csv" (State.to_csv_string !state)) |]
+            [| H.text "Export" |]
         |]
     ; H.div
         [| HA.class_ "g-Map" |]
@@ -19,10 +22,9 @@ let mapView =
 
 let state_from_hash () =
   let hash = Js.String.sliceToEnd ~from:1 (Location.hash Document.location) in
-  State.from_string hash
+  State.from_url_string hash
 
-let installMap () =
-  let state = ref (state_from_hash ()) in
+let installMap state =
   let map = Leaflet.map "g-Map__Content" in
   let title_layer = Leaflet.title_layer "http://{s}.tile.osm.org/{z}/{x}/{y}.png" in
   let markers = Leaflet.feature_group [| |] in
@@ -31,7 +33,7 @@ let installMap () =
 
   let rec reload_from_hash focus =
     let update_state new_state =
-      let () = History.push_state "" "" ("#" ^ State.to_string new_state) () in
+      let () = History.push_state "" "" ("#" ^ State.to_url_string new_state) () in
       reload_from_hash false
     in
 
@@ -74,7 +76,7 @@ let installMap () =
   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_string new_state) () in
+    let () = History.push_state "" "" ("#" ^ State.to_url_string new_state) () in
     reload_from_hash false
   in
 
@@ -96,5 +98,6 @@ let installMap () =
       |])
 
 let render () =
-  let _ = Js.Global.setTimeout installMap 0 in
-  mapView
+  let state = ref (state_from_hash ()) in
+  let _ = Js.Global.setTimeout (fun _ -> installMap state) 0 in
+  mapView state
-- 
cgit v1.2.3