diff --git a/src/api_saisie_autocomplete.ml b/src/api_saisie_autocomplete.ml index a66c194..d46e188 100644 --- a/src/api_saisie_autocomplete.ml +++ b/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,7 +40,8 @@ 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 @@ -34,12 +49,11 @@ let get_list_from_cache conf mode max_res s = | 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 - diff --git a/src/api_saisie_autocomplete.mli b/src/api_saisie_autocomplete.mli index 524abb5..1ff9f5e 100644 --- a/src/api_saisie_autocomplete.mli +++ b/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 diff --git a/src/api_saisie_write.ml b/src/api_saisie_write.ml index edbd127..3cabe11 100644 --- a/src/api_saisie_write.ml +++ b/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 diff --git a/src/api_search.ml b/src/api_search.ml index d28b8cb..2b1ae31 100644 --- a/src/api_search.ml +++ b/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,23 +555,24 @@ 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 @@ -582,84 +580,60 @@ let get_all_data_from_db conf base data compare = |> 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:(Ext_string.tr '_' ' ' 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 diff --git a/src/api_search.mli b/src/api_search.mli index 363deba..cfbc764 100644 --- a/src/api_search.mli +++ b/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 :