examples of applyS

[helm.git] / daemons / whelp / searchEngine.ml

diff --git a/daemons/whelp/searchEngine.ml b/daemons/whelp/searchEngine.ml
index 26c1def3e60c6c7cbb4cd405829136993420f7b4..fc49116196d4cb96ff0518d43527e76ab27ef753 100644 (file)
--- a/daemons/whelp/searchEngine.ml
+++ b/daemons/whelp/searchEngine.ml
@@ -357,7 +357,8 @@ let exec_action dbd (req: Http_types.request) outchan =
       end
     in
     let module Disambiguate' = Disambiguate.Make(Chat) in
-    let ast = Grammar.Entry.parse CicNotationParser.term (Stream.of_string term_str) in
+    let ast =
+      CicNotationParser.parse_term (Ulexing.from_utf8_string term_str) in
     let (id_to_uris, metasenv, term) =
       match
         Disambiguate'.disambiguate_term ~dbd ~context ~metasenv
@@ -402,7 +403,7 @@ let exec_action dbd (req: Http_types.request) outchan =
          ^ " type")))
         req outchan
 
-let callback dbd (req: Http_types.request) outchan =
+let callback (dbd, (req: Http_types.request), outchan) =
   try
     debug_print (sprintf "Received request: %s" req#path);
     (match req#path with
@@ -466,6 +467,11 @@ let callback dbd (req: Http_types.request) outchan =
       bad_request (sprintf "Parameter '%s' is missing" attr_name) outchan
   | CicNotationParser.Parse_error msg ->
       send_results (`Error (MooglePp.pp_error "Parse error" msg)) req outchan
+  | Stdpp.Exc_located (floc, Stream.Error msg) ->
+      send_results (`Error (MooglePp.pp_error "Parse error" msg)) req outchan
+  | Stdpp.Exc_located (floc, exn) ->
+      let msg = Printexc.to_string exn in
+      send_results (`Error (MooglePp.pp_error "Unknown error" msg)) req outchan
   | Unbound_identifier id ->
       send_results (`Error (MooglePp.pp_error "Unbound identifier" id)) req
         outchan
@@ -475,6 +481,11 @@ let callback dbd (req: Http_types.request) outchan =
       let msg = MooglePp.pp_error "Uncaught exception" exn_string in
       send_results (`Error msg) req outchan
 
+let callback dbd req ch =
+  HExtlib.finally
+    (fun () -> try close_out ch with Sys_error _ -> ())
+    callback (dbd, req, ch)
+
 let restore_environment () =
   match
     Helm_registry.get_opt Helm_registry.string "search_engine.environment_dump"
@@ -488,11 +499,10 @@ let restore_environment () =
       printf "done!\n"; flush stdout
 
 let read_notation () =
-  let _ = assert false in ()
-  (*
-  CicNotation.load_notation (Helm_registry.get "search_engine.notations");
-  CicNotation.load_notation (Helm_registry.get "search_engine.interpretations")
-  *)
+  ignore (CicNotation2.load_notation ~include_paths:[]
+   (Helm_registry.get "search_engine.notations"));
+  ignore (CicNotation2.load_notation ~include_paths:[]
+   (Helm_registry.get "search_engine.interpretations"))
   
 let _ =
   printf "%s started and listening on port %d\n" daemon_name port;
@@ -509,6 +519,7 @@ let _ =
   in
   restore_environment ();
   read_notation ();
-  Http_daemon.start' ~port (callback dbd);
+  let d_spec = Http_daemon.daemon_spec ~port ~callback:(callback dbd) () in
+  Http_daemon.main d_spec;
   printf "%s is terminating, bye!\n" daemon_name