summaryrefslogtreecommitdiffabout
path: root/dict.ml
blob: c23dc8dd27d85183d16c8ebe429c747486266045 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
open Containers
open Js_of_ocaml
open Js_of_ocaml_tyxml
open Js_of_ocaml_lwt
open Tyxml_js.Html5
open Lwt

let langs = ["Toki-pona"; "English"]
let dict_name = "toki.txt"

let parse_dict s =
  String.split ~by:"\n" s
  |> List.filter (fun l ->
    try Scanf.sscanf l " #" false with
      End_of_file | Scanf.Scan_failure _ -> true)
  |> List.map Fun.(String.split ~by:"::" %> List.map String.trim)
  |> List.filter (fun l -> not (List.for_all String.is_empty l))

(** Reactive values *)

(* Dictionnary *)
let dict, set_dict =
  let initial_dict =
    match Dict_init.read dict_name with
    | None -> []
    | Some contents -> parse_dict contents in
  React.S.create initial_dict

(* Search pattern *)
let search, set_search = React.S.create ""

(* List of results *)
let results :
  Html_types.div_content_fun Tyxml_js.Html5.elt list list list React.signal
  =
  let open Tyxml_js.Html5 in
  React.S.l2 (fun dict search ->
    let len_search = String.length search in
    let search = String.lowercase_ascii search in
    let len = String.length search in

    let res_compare x y =
      let h (i, len) = if len = len_search then 0 else i+1 in
      compare (h x) (h y) in

    List.filter_map (fun l ->
      let matching = ref false in
      let l' =
        List.map (fun s ->
          let i = String.find (String.lowercase_ascii s) ~sub:search in
          if i = -1 then ([txt s], None)
          else begin
            matching := true;
            let s' =
              [txt (String.sub s 0 i);
               b [txt (String.sub s i len)];
               txt (String.sub s (i + len) (String.length s - i - len))] in
            (s', Some (i, String.length s))
          end
        ) l in
      if !matching then
        Some (
          List.split l'
          |> Pair.map2 Fun.(List.filter_map id %> List.stable_sort res_compare %> List.hd)
        )
      else None
    ) dict
    |> List.stable_sort (fun (_, x) (_, y) -> res_compare x y)
    |> List.map fst
  ) dict search


(** Webpage html elements *)

let input_box =
  input ~a:[a_input_type `Text;
            a_placeholder ""; ]
    ()

let search_box =
  div ~a:[a_class ["search"]] [
    div ~a:[a_class ["container"]] [
      form [input_box]
    ]
  ]

let results_html =
  let open ReactiveData in
  let results' = React.S.map (fun res ->
    (div ~a:[a_class ["head"]] (List.map (fun s -> h2 [txt s]) langs)) ::
    (List.map (fun l ->
       div ~a:[a_class ["trad"]] (
         List.mapi (fun i s ->
           let lang = try List.nth langs i with _ -> "" in
           div ~a:[a_class ["trad" ^ (string_of_int i)]]
             ((div ~a:[a_class ["trad_info"]] [txt lang]) :: s)
         ) l
       )
     ) res)
  ) results in

  div ~a:[a_class ["container"]] [
    Tyxml_js.R.Html5.div ~a:[a_class ["results"]] (
      RList.from_signal results'
    )
  ]

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

  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;
    return ()
  );

  Lwt.async (fun _ ->
    Lwt_js_events.limited_loop ~elapsed_time:0.2
      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);
        return ()
      )
  )