Gnt place autocomplete

src/api_saisie_autocomplete.ml

@@ -7,12 +7,26 @@ let cache_file_of_cache_data base_file = function
   | `source -> Caches.source_cache_fname base_file
   | `occupation -> Caches.occupation_cache_fname base_file
 
-let has_cache conf mode =
+let has_cache ~conf ~mode =
   let base_file = Geneweb.Util.bpath (conf.Geneweb.Config.bname ^ ".gwb") in
   let file = cache_file_of_cache_data base_file mode in
   Sys.file_exists file
 
-let get_list_from_cache conf mode max_res s =
+let starts_with ~ini ~candidate =
+  Utf8.start_with_wildcard ini 0 (Name.lower candidate)
+
+let is_valid_suggestion ~mode ~place_mode = match mode, place_mode with
+  | `place, (None | Some (`area_code | `country | `county | `region | `town)) ->
+    fun ~ini ~candidate ->
+      let suburb, no_suburb = Geneweb.Place.split_suburb candidate in
+      if suburb <> "" then
+        starts_with ~ini ~candidate:suburb || starts_with ~ini ~candidate:no_suburb || starts_with ~ini ~candidate
+      else
+        starts_with ~ini ~candidate
+  | (`source | `occupation | `firstname | `lastname | `place), _ ->
+    starts_with
+
+let get_list_from_cache ~conf ~mode ~place_mode ~n ~ini =
   let bfile = Geneweb.Util.bpath (conf.Geneweb.Config.bname ^ ".gwb") in
   let cache_file = cache_file_of_cache_data bfile mode in
   let cache =
@@ -26,20 +40,20 @@ let get_list_from_cache conf mode max_res s =
       close_in ic;
       []
   in
-  let ini = Name.lower @@ Ext_string.tr '_' ' ' s in
+  let ini = Name.lower @@ Ext_string.tr '_' ' ' ini in
+  let is_valid = is_valid_suggestion ~mode ~place_mode in
   (* optim : on sait que la liste est triée. *)
   let rec loop list accu nb_res =
     match list with
     | [] -> List.rev accu
     | name :: l ->
       let k = Ext_string.tr '_' ' ' name in
       let (accu, nb_res) =
-        if Utf8.start_with_wildcard ini 0 (Name.lower k)
+        if is_valid ~ini ~candidate:k
         then name :: accu, nb_res + 1
         else accu, nb_res
       in
-      if nb_res < max_res then loop l accu nb_res
+      if nb_res < n then loop l accu nb_res
       else List.rev accu
   in
   loop cache [] 0
-

src/api_saisie_autocomplete.mli

@@ -1,11 +1,19 @@
 val has_cache :
-  Geneweb.Config.config ->
-  [< `firstname | `lastname | `place | `source | `occupation ] ->
+  conf:Geneweb.Config.config ->
+  mode:Api_saisie_write_piqi.auto_complete_field ->
   bool
 
 val get_list_from_cache :
-  Geneweb.Config.config ->
-  [< `firstname | `lastname | `place | `source | `occupation ] ->
-  int ->
-  string ->
+  conf:Geneweb.Config.config ->
+  mode:Api_saisie_write_piqi.auto_complete_field ->
+  place_mode:Api_saisie_write_piqi.auto_complete_place_field option ->
+  n:int ->
+  ini:string ->
   string list
+
+val is_valid_suggestion :
+  mode:Api_saisie_write_piqi.auto_complete_field ->
+  place_mode:Api_saisie_write_piqi.auto_complete_place_field option ->
+  ini:string ->
+  candidate:string ->
+  bool

src/api_saisie_write.ml

@@ -1,13 +1,13 @@
 (**/**) (* Fonctions pour l'auto-completion. *)
 
 let complete_with_cache conf assets mode place_mode max_res s =
-  let cache = Api_saisie_autocomplete.get_list_from_cache conf mode max_res s in
+  let cache = Api_saisie_autocomplete.get_list_from_cache ~conf ~mode ~place_mode ~n:max_res ~ini:s in
   let ini = Name.lower @@ Ext_string.tr '_' ' ' s in
   match mode with
   | `place | `source | `lastname | `firstname ->
-    Api_search.complete_with_dico assets conf (ref @@ List.length cache) max_res place_mode ini cache
+    Api_search.complete_with_dico assets conf (List.length cache) max_res place_mode ini cache
   | `occupation ->
-    Api_search.complete_with_dico assets conf (ref @@ List.length cache) max_res (Some `profession) ini cache
+    Api_search.complete_with_dico assets conf (List.length cache) max_res (Some `profession) ini cache
 
 let print_auto_complete assets conf base =
   let params = Api_util.get_params conf Api_saisie_write_piqi_ext.parse_auto_complete in
@@ -18,15 +18,15 @@ let print_auto_complete assets conf base =
   let list =
     let nb_of_persons = Gwdb.nb_of_persons base in
     if nb_of_persons > 100_000 then
-      if Api_saisie_autocomplete.has_cache conf mode then
+      if Api_saisie_autocomplete.has_cache ~conf ~mode then
         complete_with_cache conf assets mode place_mode max_res s
       else []
     else if nb_of_persons > Caches.node_threshold &&
-            Api_saisie_autocomplete.has_cache conf mode
+            Api_saisie_autocomplete.has_cache ~conf ~mode
     then
       complete_with_cache conf assets mode place_mode max_res s
     else
-      Api_search.search_auto_complete assets conf base mode place_mode max_res s
+      Api_search.search_auto_complete ~assets ~conf ~base ~mode ~place_mode ~max:max_res ~ini:s
   in
   let result = { Api_saisie_write_piqi.Auto_complete_result. result = list } in
   let data = Api_saisie_write_piqi_ext.gen_auto_complete_result result in

src/api_search.ml

@@ -488,52 +488,49 @@ let complete_with_dico assets conf nb max mode ini list =
       None -> true
     | Some codes -> List.mem country_code codes
   in
-  let reduce_dico mode ignored format list =
+  let reduce_dico n mode ignored format list =
     let len = Array.length list in
-    let rec loop acc i =
-      if i = len
-      then acc
+    let rec loop n acc i =
+      if i = len || n >= max
+      then n, acc
       else
         let hd = Array.unsafe_get list i in
-        let acc =
-          let k =  Ext_string.tr '_' ' ' hd in
-          let k =
+        let k =  Ext_string.tr '_' ' ' hd in
+        let k =
+          match mode with
+          | `area_code | `country | `county | `region | `town ->
+            Geneweb.Place.without_suburb k
+          | `subdivision | `profession -> k
+        in
+        if string_start_with ini (Name.lower k) then begin
+          let row = Api_csv.row_of_string hd in
+          let hd_opt =
             match mode with
-            | `area_code | `country | `county | `region | `town ->
-               Geneweb.Place.without_suburb k
-            | `subdivision | `profession -> k
+            | `profession -> Some (String.concat ", " row)
+            | #Api_saisie_write_piqi.auto_complete_place_field ->
+              let country_code, expl_hd = split_country_code row in
+              if belongs_to_preferred_countries country_code then
+                if format <> [] then
+                  Some (String.concat ", " @@
+                        List.filter_map begin function
+                          | `town -> List.nth_opt expl_hd 0
+                          | `area_code -> List.nth_opt expl_hd 1
+                          | `county -> List.nth_opt expl_hd 2
+                          | `region -> List.nth_opt expl_hd 3
+                          | `country -> List.nth_opt expl_hd 4
+                          | _ -> None
+                        end
+                          format)
+                else Some (String.concat ", " expl_hd)
+              else None
           in
-          if string_start_with ini (Name.lower k) then begin
-            let row = Api_csv.row_of_string hd in
-            let hd_opt =
-              match mode with
-              | `profession -> Some (String.concat ", " row)
-              | #Api_saisie_write_piqi.auto_complete_place_field ->
-                 let country_code, expl_hd = split_country_code row in
-                 if belongs_to_preferred_countries country_code then
-                   if format <> [] then
-                     Some (String.concat ", " @@
-                           List.filter_map begin function
-                             | `town -> List.nth_opt expl_hd 0
-                             | `area_code -> List.nth_opt expl_hd 1
-                             | `county -> List.nth_opt expl_hd 2
-                             | `region -> List.nth_opt expl_hd 3
-                             | `country -> List.nth_opt expl_hd 4
-                             | _ -> None
-                           end
-                             format)
-                   else Some (String.concat ", " expl_hd)
-                 else None
-            in
-            if Option.is_none hd_opt
-            || List.mem (Option.get hd_opt) ignored
-            then acc
-            else begin incr nb ; Option.get hd_opt :: acc end
-          end
-          else acc
-        in
-        if !nb < max then loop acc (i + 1) else acc
-    in loop [] 0
+          if Option.is_none hd_opt
+          || List.mem (Option.get hd_opt) ignored
+          then loop n acc (i + 1)
+          else loop (n + 1) (Option.get hd_opt :: acc) (i + 1)
+        end
+        else loop n acc (i + 1)
+    in loop n [] 0
   in
   let unmarshal_dico ~assets ~lang ~data_type =
     match dico_fname ~assets ~lang ~data_type with
@@ -542,7 +539,7 @@ let complete_with_dico assets conf nb max mode ini list =
   in
   match mode with
   | Some (#Api_saisie_write_piqi.auto_complete_place_field as mode)
-       when !nb < max ->
+       when nb < max ->
     let format =
       match List.assoc_opt "places_format" conf.Geneweb.Config.base_env with
       | None -> []
@@ -558,108 +555,85 @@ let complete_with_dico assets conf nb max mode ini list =
           end
           (Api_csv.row_of_string s)
     in
-    let dico =
+    let _nb, dico =
       unmarshal_dico ~assets ~lang:conf.Geneweb.Config.lang ~data_type:mode
-      |> reduce_dico mode list format
+      |> reduce_dico nb mode list format
     in
     append list (List.sort Geneweb.Place.compare_places dico)
-  | Some `profession when !nb < max ->
+  | Some `profession when nb < max ->
      let dictionary =
        unmarshal_dico
          ~assets ~lang:conf.Geneweb.Config.lang ~data_type:`profession
      in
      dictionary
-     |> reduce_dico `profession list []
+     |> reduce_dico nb `profession list []
+     |> snd
      |> List.sort Utf8.alphabetic_order
      |> append list
   | None
-    | Some (#Api_saisie_write_piqi.auto_complete_place_field | `profession) ->
-     list
+  | Some (#Api_saisie_write_piqi.auto_complete_place_field | `profession) ->
+    list
 
 let get_all_data_from_db conf base data compare =
   let conf = { conf with Geneweb.Config.env = ("data", Mutil.encode data) :: conf.Geneweb.Config.env } in
   Geneweb.UpdateData.get_all_data conf base
   |> List.map (Gwdb.sou base)
   |> List.sort compare
 
-type kind =
-  | Source
-  | Occupation
-  | Place of
-      {field : Api_saisie_write_piqi.auto_complete_place_field option}
-
-type query = {kind : kind; limit : int; term : string}
-
-let is_completion_suggestion ~query:{kind; term} candidate =
-  match kind with
-  | Source | Occupation ->
-     string_start_with term (Name.lower @@ Ext_string.tr '_' ' ' candidate)
-  | Place {field} ->
-     let hd' =
-       match field with
-       | None | Some (`area_code | `country | `county | `region | `town) ->
-          Geneweb.Place.without_suburb candidate
-       | Some `subdivision -> candidate
-     in
-     Utf8.start_with_wildcard term 0 @@ Name.lower @@ Ext_string.tr '_' ' ' hd'
+let is_completion_suggestion ~mode ~place_mode ~ini ~candidate =
+  match mode with
+  | `source | `occupation ->
+     string_start_with ini (Name.lower @@ Ext_string.tr '_' ' ' candidate)
+  | `place as mode ->
+    Api_saisie_autocomplete.is_valid_suggestion ~mode ~place_mode ~ini ~candidate
 
-let complete_with_db ~conf ~base ~nb query =
+let complete_with_db ~conf ~base ~max ~(mode : [`source | `occupation | `place]) ~place_mode ~ini =
   let list =
     let data, compare =
-      match query.kind with
-      | Source -> "src", Utf8.alphabetic_order
-      | Occupation -> "occu", Utf8.alphabetic_order
-      | Place _ -> "place", Geneweb.Place.compare_places
+      match mode with
+      | `source -> "src", Utf8.alphabetic_order
+      | `occupation -> "occu", Utf8.alphabetic_order
+      | `place -> "place", Geneweb.Place.compare_places
     in
     get_all_data_from_db conf base data compare
   in
-  let rec reduce acc = function
-    | [] -> acc
-    | hd :: tl ->
-       let acc =
-         if is_completion_suggestion ~query hd
-         then (incr nb ; hd :: acc)
-         else acc
-       in
-       if !nb < query.limit then reduce acc tl
-       else acc
+  let rec reduce n acc = function
+    | [] -> n, acc
+    | candidate :: tl when n < max ->
+      if is_completion_suggestion ~mode ~place_mode ~ini ~candidate
+      then reduce (n + 1) (candidate :: acc) tl
+      else reduce n acc tl
+    | _candidate :: _tl -> n, acc
   in
-  List.rev @@ reduce [] list
+  let n, res = reduce 0 [] list in
+  n, List.rev res
 
-let search_auto_complete assets conf base mode place_mode max term =
-  match mode with
+let search_auto_complete ~assets ~conf ~base ~mode ~place_mode ~max ~ini =
+  match (mode : Api_saisie_write_piqi.auto_complete_field) with
 
-  | `place ->
-    let nb = ref 0 in
-    let ini = Name.lower @@ Ext_string.tr '_' ' ' term in
-    let reduced_list =
-      let field =
-        (place_mode :> Api_saisie_write_piqi.auto_complete_place_field option)
-      in
-      complete_with_db
-        ~conf ~base ~nb {kind = Place {field}; limit = max; term = ini}
+  | `place as mode ->
+    let ini = Name.lower @@ Ext_string.tr '_' ' ' ini in
+    let n, reduced_list =
+      complete_with_db ~conf ~base ~max ~mode ~place_mode ~ini
     in
-    complete_with_dico assets conf nb max place_mode ini reduced_list
+    complete_with_dico assets conf n max place_mode ini reduced_list
 
-  | `source ->
-    let nb = ref 0 in
-    let ini = Name.lower @@ Ext_string.tr '_' ' ' term in
-    let query = {kind = Source; limit = max; term = ini} in
-    complete_with_db ~conf ~base ~nb query
+  | `source as mode ->
+    let ini = Name.lower @@ Ext_string.tr '_' ' ' ini in
+    snd (complete_with_db ~conf ~base ~max ~mode ~place_mode ~ini)
 
   | `firstname | `lastname as mode ->
-    if Name.lower term = "" then []
+    if Name.lower ini = "" then []
     else ( Gwdb.load_strings_array base
-         ; select_start_with_auto_complete base mode max term )
+         ; select_start_with_auto_complete base mode max ini )
 
-  | `occupation ->
-    let nb = ref 0 in
-    let term = Name.lower @@ Ext_string.tr '_' ' ' term in
-    let suggestions_from_db =
-      complete_with_db ~conf ~base ~nb {kind = Occupation; limit = max; term}
+  | `occupation as mode ->
+    let ini = Name.lower @@ Ext_string.tr '_' ' ' ini in
+    let n, suggestions_from_db =
+      complete_with_db ~conf ~base ~max ~mode ~place_mode ~ini
     in
     complete_with_dico
-      assets conf nb max (Some `profession) term suggestions_from_db
+      assets conf n max (Some `profession) ini suggestions_from_db
 
 let search_person_list base surname first_name =
   let _ = Gwdb.load_strings_array base in

src/api_search.mli

@@ -11,7 +11,7 @@ val dico_fname :
 val complete_with_dico :
   string ->
   Geneweb.Config.config ->
-  int ref ->
+  int ->
   int ->
   [< Api_saisie_write_piqi.auto_complete_place_field | `profession]
   option ->
@@ -24,14 +24,13 @@ val complete_with_dico :
 *)
 
 val search_auto_complete :
-  string ->
-  Geneweb.Config.config ->
-  Gwdb.base ->
-  [< Api_saisie_write_piqi.auto_complete_field ] ->
-  [< Api_saisie_write_piqi.auto_complete_place_field ]
-  option ->
-  int ->
-  string ->
+  assets:string ->
+  conf:Geneweb.Config.config ->
+  base:Gwdb.base ->
+  mode:Api_saisie_write_piqi.auto_complete_field ->
+  place_mode:Api_saisie_write_piqi.auto_complete_place_field option ->
+  max:int ->
+  ini:string ->
   string list
 
 val search_person_list :