X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2FsearchEngine%2FsearchEngine.ml;h=35650c8c6cf7e50ab4ee59273bbd60d7496c830a;hb=66eccd131232e49fdb0790ee5b48cc41829157fe;hp=6e3b846d2ea3ff6d6db6450e15e6aaabcc7b5ab8;hpb=0e74e8e94eada756157addce67e4adeb8dff1feb;p=helm.git diff --git a/helm/searchEngine/searchEngine.ml b/helm/searchEngine/searchEngine.ml index 6e3b846d2..35650c8c6 100644 --- a/helm/searchEngine/searchEngine.ml +++ b/helm/searchEngine/searchEngine.ml @@ -213,7 +213,7 @@ let get_constraints term = U.universe_for_search_pattern, (constr_obj, constr_rel, constr_sort), (None,None,None) | req_path -> - let must = MQueryLevels2.get_constraints term in + let must = CGSearchPattern.get_constraints term in refine_constraints must req_path ;; @@ -242,20 +242,21 @@ let add_user_constraints ~constraints (* to be used on "obj" *) let add_user_must33 user_must must = List.map2 - (fun (b, i) (p, u) -> U.set_full_position p (if b then i else None), u) - user_must must + (fun (b, i) (p, u) -> + if b then Some (U.set_full_position p i, u) else None) + user_must must in (* to be used on "rel" *) let add_user_must22 user_must must = List.map2 - (fun (b, i) p -> U.set_main_position p (if b then i else None)) - user_must must + (fun (b, i) p -> if b then Some (U.set_main_position p i) else None) + user_must must in (* to be used on "sort" *) let add_user_must32 user_must must = List.map2 - (fun (b, i) (p, s) -> U.set_main_position p (if b then i else None), s) - user_must must + (fun (b, i) (p, s)-> if b then Some (U.set_main_position p i, s) else None) + user_must must in match Pcre.split ~pat:":" constraints with | [user_obj;user_rel;user_sort;user_only_obj;user_only_rel;user_only_sort] -> @@ -275,9 +276,15 @@ let add_user_constraints ~constraints (if user_only_sort then only_sort else None) in let must' = - add_user_must33 user_obj obj, - add_user_must22 user_rel rel, - add_user_must32 user_sort sort + let rec filter_some = + function + [] -> [] + | None::tl -> filter_some tl + | (Some x)::tl -> x::(filter_some tl) + in + filter_some (add_user_must33 user_obj obj), + filter_some (add_user_must22 user_rel rel), + filter_some (add_user_must32 user_sort sort) in (must', only') | _ -> failwith ("Can't parse constraint string: " ^ constraints) @@ -305,6 +312,14 @@ let callback (req: Http_types.request) outchan = let result = MQueryInterpreter.execute mqi_handle query in C.close mqi_handle; Http_daemon.respond ~headers:[contype] ~body:(pp_result result) outchan + | "/unreferred" -> + let mqi_handle = C.init mqi_flags debug_print in + let target = req#param "target" in + let source = req#param "source" in + let query = G.unreferred target source in + let result = MQueryInterpreter.execute mqi_handle query in + C.close mqi_handle; + Http_daemon.respond ~headers:[contype] ~body:(pp_result result) outchan | "/getpage" -> (* TODO implement "is_permitted" *) (let is_permitted _ = true in