Rewrite in TSmain

7 files changed, 0 insertions, 441 deletions

diff --git a/src/View/Button.ml b/src/View/Button.ml
deleted file mode 100644
index b4641d2..0000000
--- a/src/View/Button.ml
+++ /dev/null
@@ -1,19 +0,0 @@
-let raw attrs content =
-  H.button
-    (HA.concat [| HA.class_ "g-Button__Raw" |] attrs)
-    content
-
-let text attrs content =
-  H.button
-    (HA.concat [| HA.class_ "g-Button__Text" |] attrs)
-    content
-
-let action attrs content =
-  H.button
-    (HA.concat [| HA.class_ "g-Button__Action" |] attrs)
-    content
-
-let cancel attrs content =
-  H.button
-    (HA.concat [| HA.class_ "g-Button__Cancel" |] attrs)
-    content
diff --git a/src/View/Form.ml b/src/View/Form.ml
deleted file mode 100644
index cec49d6..0000000
--- a/src/View/Form.ml
+++ /dev/null
@@ -1,65 +0,0 @@
-let input id label attrs =
-  H.div
-    [| HA.class_ "g-Form__Field" |]
-    [| H.div
-        [| HA.class_ "g-Form__Label" |]
-        [| H.label
-          [| HA.for_ id |]
-          [| H.text label |]
-        |]
-    ;  H.input
-        (HA.concat attrs [| HA.id id |])
-        [| |]
-    |]
-
-let color_input default_colors id label init_value on_input =
-  let
-    input =
-      H.input
-          [| HA.id id
-          ;  HE.on_input (fun e -> on_input (Element.value (Event.target e)))
-          ;  HA.value init_value
-          ;  HA.type_ "color"
-          |]
-          [| |]
-  in
-  H.div
-    [| HA.class_ "g-Form__Field" |]
-    [| H.div
-        [| HA.class_ "g-Form__Label" |]
-        [| H.label
-          [| HA.for_ id |]
-          [| H.text label |]
-        |]
-    ;  Layout.line
-        [| |]
-        (default_colors
-          |> Js.Array.map (fun color ->
-              Button.raw
-                [| HA.class_ "g-Form__DefaultColor"
-                ;  HA.style ("background-color: " ^ color)
-                ;  HE.on_click (fun _ ->
-                    let () = Element.set_value input color in
-                    on_input color)
-                ;  HA.type_ "button"
-                |]
-                [| |])
-        |> Fun.flip Js.Array.concat [| input |])
-    |]
-
-let textarea id label init_value on_input =
-  H.div
-    [| HA.class_ "g-Form__Field" |]
-    [| H.div
-        [| HA.class_ "g-Form__Label" |]
-        [| H.label
-          [| HA.for_ id |]
-          [| H.text label |]
-        |]
-    ;  H.textarea
-        [| HA.id id
-        ;  HA.class_ "g-Form__Textarea"
-        ;  HE.on_input (fun e -> on_input (Element.value (Event.target e)))
-        |]
-        [| H.text init_value |]
-    |]
diff --git a/src/View/Form/Autocomplete.ml b/src/View/Form/Autocomplete.ml
deleted file mode 100644
index 98e4b43..0000000
--- a/src/View/Form/Autocomplete.ml
+++ /dev/null
@@ -1,80 +0,0 @@
-let search s xs =
-  Js.Array.filter (Js.String.includes s) xs
-
-let render_completion render_entry on_select entries =
-  H.div
-    [| HA.class_ "g-Autocomplete__Completion" |]
-    (entries
-      |> Js.Array.map (fun c ->
-          Button.raw
-            [| HA.class_ "g-Autocomplete__Entry"
-            ;  HA.type_ "button"
-            ;  HE.on_click (fun e ->
-                let () = Event.stop_propagation e in
-                let () = Event.prevent_default e in
-                on_select c)
-            |]
-            (render_entry c)))
-
-let create attrs id values render_entry on_input =
-
-  let completion =
-    H.div [| |] [| |]
-  in
-
-  let update_completion target value =
-    let entries = search value values in
-    Element.mount_on completion (render_completion
-      render_entry
-      (fun selected ->
-        let () = Element.set_value target selected in
-        let () = Element.remove_children completion in
-        on_input selected)
-      entries)
-  in
-
-  let hide_completion () =
-    Element.mount_on completion (H.text "")
-  in
-
-  let
-    input =
-      H.input
-        (HA.concat
-          attrs
-          [| HA.id id
-          ;  HA.class_ "g-Autocomplete__Input"
-          ;  HA.autocomplete "off"
-          ;  HE.on_focus (fun e ->
-              let target = Event.target e in
-              let value = Element.value target in
-              update_completion target value)
-          ;  HE.on_input (fun e ->
-              let target = Event.target e in
-              let value = Element.value target in
-              let () = update_completion target value in
-              on_input value)
-          |])
-        [| |]
-  in
-
-  let () =
-    Element.add_event_listener input "blur" (fun e ->
-      if Js.isNullable (Event.related_target e) then
-        hide_completion ())
-  in
-
-  H.div
-    [| HA.class_ "g-Autocomplete" |]
-    [| input
-    ;  completion
-    ;  Button.raw
-        [| HA.class_ "g-Autocomplete__Clear fa fa-close"
-        ;  HA.type_ "button"
-        ;  HE.on_click (fun _ ->
-            let () = on_input "" in
-            let () = Element.set_value input "" in
-            Element.focus input)
-        |]
-        [| |]
-    |]
diff --git a/src/View/Layout.ml b/src/View/Layout.ml
deleted file mode 100644
index db1e234..0000000
--- a/src/View/Layout.ml
+++ /dev/null
@@ -1,9 +0,0 @@
-let section attrs content =
-  H.div
-    (HA.concat attrs [| HA.class_ "g-Layout__Section" |])
-    content
-
-let line attrs content =
-  H.div
-    (HA.concat attrs [| HA.class_ "g-Layout__Line" |])
-    content
diff --git a/src/View/Map.ml b/src/View/Map.ml
deleted file mode 100644
index 6e2611e..0000000
--- a/src/View/Map.ml
+++ /dev/null
@@ -1,131 +0,0 @@
-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
-        [| HA.class_ "g-Layout__Header" |]
-        [| H.a
-            [| HA.class_ "g-Layout__Home"
-            ;  HA.href "#"
-            |]
-            [| H.text "Map" |]
-        ;  Layout.line
-            [| HA.class_ "g-Layout__HeaderImportExport" |]
-            [| 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-Button__Text"
-                |]
-                [| 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" |]
-        [| H.div
-            [| HA.id "g-Map__Content" |]
-            [||]
-        |]
-    |]
-
-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 () = Leaflet.add_layer map markers in
-  let () = Leaflet.add_layer map title_layer in
-
-  (* Init markers from url *)
-  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 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 state map markers false
-  in
-
-  (* Context menu *)
-  Leaflet.on map "contextmenu" (fun event ->
-    ContextMenu.show
-      (Leaflet.original_event event)
-      [| { label = "Add a marker"
-         ; action = (fun _ ->
-             let pos = Leaflet.lat_lng event in
-             let marker =
-               match State.last_added !state with
-               | Some m -> { m with pos = pos; name = "" }
-               | _ -> { pos = pos; name = ""; color = "#3f92cf"; icon = "" }
-             in
-            let colors = State.colors !state in
-             Modal.show (Marker.form (add_marker pos) colors marker.name marker.color marker.icon))
-         }
-      |])
-
-let render () =
-  let state = ref (state_from_hash ()) in
-  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
diff --git a/src/View/Map/Icon.ml b/src/View/Map/Icon.ml
deleted file mode 100644
index 8737f43..0000000
--- a/src/View/Map/Icon.ml
+++ /dev/null
@@ -1,32 +0,0 @@
-let create name color =
-  let c = Color.from_raw color in
-  let crBlack = Color.contrast_ratio { r = 0.; g = 0.; b = 0. } c in
-  let crWhite = Color.contrast_ratio { r = 255.; g = 255.; b = 255. } c in
-  let textCol = if crBlack > crWhite then "black" else "white" in
-  Leaflet.div_icon
-    { className = ""
-    ; popupAnchor = [| 0.; -34. |]
-    ; html =
-        H.div
-          [| HA.class_ "g-Marker" |]
-          [| H.div
-              [| HA.class_ "g-Marker__Round"
-              ;  HA.style ("background-color: " ^ color)
-              |]
-              [| |]
-          ;  H.div [| HA.class_ "g-Marker__PeakBorder" |] [| |]
-          ;  H.div
-              [| HA.class_ "g-Marker__PeakInner"
-              ;  HA.style ("border-top-color: " ^ color)
-              |]
-              [| |]
-          ;  H.div
-              [| HA.class_ "g-Marker__Icon" |]
-              [| H.i
-                  [| HA.class_ ("fa fa-" ^ name)
-                  ;  HA.style ("color: " ^ textCol)
-                  |]
-                  [| |]
-              |]
-          |]
-    }
diff --git a/src/View/Map/Marker.ml b/src/View/Map/Marker.ml
deleted file mode 100644
index 1c0c0d6..0000000
--- a/src/View/Map/Marker.ml
+++ /dev/null
@@ -1,105 +0,0 @@
-let form on_validate colors init_name init_color init_icon =
-  let name = ref init_name in
-  let color = ref init_color in
-  let icon = ref init_icon in
-  let on_validate () =
-        let () = on_validate !name !color !icon in
-        Modal.hide ()
-  in
-  H.div
-    [| |]
-    [| Layout.section
-        [| |]
-        [| H.form
-            [| HA.class_ "g-MarkerForm"
-            ;  HE.on_submit (fun e ->
-                let () = Event.prevent_default e in
-                on_validate ())
-            |]
-            [| Layout.section
-                [| |]
-                [| Form.input
-                    "g-MarkerForm__Name"
-                    "Name"
-                    [| HE.on_input (fun e -> name := (Element.value (Event.target e)))
-                    ;  HA.value init_name
-                    |]
-                ;  Form.color_input colors "g-MarkerForm__Color" "Color" init_color (fun newColor -> color := newColor)
-                ;  H.div
-                    [| HA.class_ "g-Form__Field" |]
-                    [| H.div
-                        [| HA.class_ "g-Form__Label" |]
-                        [| H.label
-                          [| HA.for_ "g-MarkerForm__IconInput" |]
-                          [| H.text "Icon" |]
-                        |]
-                    ; let dom_icon = H.div [| HA.class_ ("fa fa-" ^ !icon) |] [| |] in
-                      Layout.line
-                        [| HA.class_ "g-MarkerForm__AutocompleteAndIcon" |]
-                        [| Autocomplete.create
-                            [| HA.value init_icon
-                            ;  HA.class_ "g-MarkerForm__Autocomplete"
-                            |]
-                            "g-MarkerForm__IconInput"
-                            FontAwesome.icons
-                            (fun icon ->
-                              [| H.div
-                                  [| HA.class_ ("g-MarkerForm__IconEntry fa fa-" ^ icon) |]
-                                  [| |]
-                              ;  H.text icon
-                              |])
-                            (fun newIcon ->
-                              let () = icon := newIcon in
-                              Element.set_class_name dom_icon ("fa fa-" ^ newIcon))
-                        ;  H.div [| HA.class_ "g-MarkerForm__Icon" |] [| dom_icon |]
-                        |]
-                    |]
-                |]
-            ;  Layout.line
-                [| |]
-                [| Button.action
-                    [| HE.on_click (fun _ -> on_validate ()) |]
-                    [| H.text "Save" |]
-                ;  Button.cancel
-                    [| HE.on_click (fun _ -> Modal.hide ())
-                    ;  HA.type_ "button"
-                    |]
-                    [| H.text "Cancel" |]
-                |]
-            |]
-        |]
-    |]
-
-
-let create on_remove on_update colors pos init_name init_color init_icon =
-  let marker =
-    Leaflet.marker pos
-      { title = init_name
-      ; icon = Icon.create init_icon init_color
-      ; draggable = true
-      }
-  in
-
-  (* Context menu *)
-  let () = Leaflet.on marker "contextmenu" (fun event ->
-    ContextMenu.show
-      (Leaflet.original_event event)
-      [| { label = "Modify"
-         ; action = fun _ ->
-           Modal.show (form (on_update pos pos) colors init_name init_color init_icon)
-         }
-      ;  { label = "Remove"
-         ; action = fun _ -> on_remove pos
-         }
-      |])
-  in
-
-  (* Move the cursor on drag *)
-  let () = Leaflet.on marker "dragend" (fun e ->
-    let newPos = Leaflet.get_lat_lng (Leaflet.target e) () in
-    on_update pos newPos init_name init_color init_icon) in
-
-  let () = Leaflet.on marker "dblclick" (fun _ ->
-    Modal.show (form (on_update pos pos) colors init_name init_color init_icon)) in
-
-  marker