diff options
author | Joris | 2020-08-09 14:44:02 +0200 |
---|---|---|
committer | Joris | 2020-08-09 14:44:02 +0200 |
commit | 225068497c5fd41da12030a6bbf58a0fc9c294d0 (patch) | |
tree | a2432c1c8004a3e5897a4a9b445e256a3ca6c651 /src/Lib | |
parent | ad6abcd5fc5e4e66062c8a01b511a1bd4bda2e94 (diff) |
Import from CSV
Diffstat (limited to 'src/Lib')
-rw-r--r-- | src/Lib/CSV.ml | 76 | ||||
-rw-r--r-- | src/Lib/Dom/Element.ml | 3 | ||||
-rw-r--r-- | src/Lib/Dom/HE.ml | 2 | ||||
-rw-r--r-- | src/Lib/File.ml | 9 | ||||
-rw-r--r-- | src/Lib/Leaflet.ml | 6 | ||||
-rw-r--r-- | src/Lib/Option.ml | 9 |
6 files changed, 104 insertions, 1 deletions
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 |