summaryrefslogtreecommitdiffabout
diff options
context:
space:
mode:
authorArmaël Guéneau <armael.gueneau@ens-lyon.org>2020-11-02 23:31:30 (CET)
committer Armaël Guéneau <armael.gueneau@ens-lyon.org>2020-11-02 23:31:30 (CET)
commitfe12ced01a7db69f960cc3cbdc48df7b6f300ce9 (patch)
tree965b393783f90dac699d982d28b4e31305b1b21f
parentc457432a3a7bdd037bbb60ebe48e96091362aded (diff)
downloaddict-fe12ced01a7db69f960cc3cbdc48df7b6f300ce9.tar.gz
dict-fe12ced01a7db69f960cc3cbdc48df7b6f300ce9.tar.bz2
Use the hash property and avoid uri parsing
-rw-r--r--dict.ml22
-rw-r--r--dune2
2 files changed, 14 insertions, 10 deletions
diff --git a/dict.ml b/dict.ml
index c23dc8d..3a19176 100644
--- a/dict.ml
+++ b/dict.ml
@@ -108,18 +108,23 @@ let results_html =
let () =
let main = Dom_html.getElementById "main" in
let input_node = Tyxml_js.To_dom.of_input input_box in
- let page_uri = Dom_html.window##.location##.href |> Js.to_string |> Uri.of_string in
+ let anchor () =
+ Dom_html.window##.location##.hash |> Js.to_string
+ |> String.chop_prefix ~pre:"#"
+ |> Option.get_or ~default:""
+ in
+ let set_anchor s =
+ Dom_html.window##.location##.hash := Js.string ("#" ^ s) in
Lwt.async (fun _ ->
Lwt_js_events.domContentLoaded () >>= fun _ ->
main##appendChild (Tyxml_js.To_dom.of_node search_box) |> ignore;
main##appendChild (Tyxml_js.To_dom.of_node results_html) |> ignore;
- begin match Uri.fragment page_uri with
- | Some frag ->
- input_node##.value := (Js.string frag);
- set_search frag
- | None -> ()
- end;
+ let query = anchor () in
+ if not (String.is_empty query) then (
+ set_search query;
+ input_node##.value := Js.string query;
+ );
return ()
);
@@ -128,8 +133,7 @@ let () =
Lwt_js_events.input input_node (fun _ _ ->
let text = Js.to_string ((Tyxml_js.To_dom.of_input input_box)##.value) in
set_search text;
- let uri = Uri.with_fragment page_uri (Some text) in
- Dom_html.window##.location##.href := Js.string (Uri.to_string uri);
+ set_anchor text;
return ()
)
)
diff --git a/dune b/dune
index e8c8c15..ae1c471 100644
--- a/dune
+++ b/dune
@@ -1,7 +1,7 @@
(executable
(name dict)
(modes js)
- (libraries containers js_of_ocaml-lwt js_of_ocaml-tyxml uri)
+ (libraries containers js_of_ocaml-lwt js_of_ocaml-tyxml)
(preprocess (pps js_of_ocaml-ppx))
(link_flags (:standard -no-check-prims))
)