summaryrefslogtreecommitdiffabout
path: root/dict.ml
blob: 1b52327252a1a4b2fcb0b4a794ee9939b8e58714 (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
open Batteries
open Tyxml_js
open Tyxml_js.Html5
open Lwt

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

let parse_dict s =
  String.nsplit ~by:"\n" s
  |> List.filter (fun l ->
    try Scanf.sscanf l " #" false with
      End_of_file | Scanf.Scan_failure _ -> true)
  |> List.map (String.nsplit ~by:"::" %> List.map String.strip)
  |> 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
  =
  React.S.l2 (fun dict search ->
    let len_search = String.length search in
    let search = String.lowercase 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 ->
          String.Exceptionless.find (String.lowercase s) search
          |> Option.map_default (fun i ->
            matching := true;
            let s' =
              [pcdata (String.slice ~first:0 ~last:i s);
               b [pcdata (String.slice ~first:i ~last:(i + len) s)];
               pcdata (String.slice ~first:(i + len) s)] in
            (s', Some (i, String.length s))
          ) ([pcdata s], None)
        ) l in
      if !matching then
        Some (
          List.split l'
          |> Tuple2.map2 (List.filter_map identity
                          %> 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 [pcdata 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"]] [pcdata lang]) :: s)
         ) l
       )
     ) res)
  ) results in

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

let () =
  let main = Dom_html.getElementById "main" in
  let input_node = To_dom.of_input input_box in
  Lwt.async (fun _ ->
    Lwt_js_events.domContentLoaded () >>= fun _ ->
    main##appendChild (To_dom.of_node search_box) |> ignore;
    main##appendChild (To_dom.of_node results_html) |> ignore;
    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 ((To_dom.of_input input_box)##.value) in
        set_search text;
        return ()
      )
  )