From ad6abcd5fc5e4e66062c8a01b511a1bd4bda2e94 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 9 Aug 2020 08:37:18 +0200 Subject: Export as CSV --- public/main.css | 1 + 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 +++++++++++-------- 9 files changed, 54 insertions(+), 12 deletions(-) create mode 100644 src/Lib/File.ml create mode 100644 src/Lib/Fun.ml create mode 100644 src/Lib/URI.ml diff --git a/public/main.css b/public/main.css index 9b94186..fdedc4c 100644 --- a/public/main.css +++ b/public/main.css @@ -19,6 +19,7 @@ body { .g-Layout__Header { display: flex; align-items: center; + justify-content: space-between; width: 100%; background-color: var(--color-header); color: white; 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