Commit 4f8f8d45 authored by Josh Kunz's avatar Josh Kunz

Adds querying support.

parent 469ed7d8
......@@ -14,16 +14,24 @@ open Buffer
let graph = ref (KG.empty ());;
let g = Mutex.create ();;
let json_for_graph g =
let rec json_for_edge e =
let is_titlecase s =
String.length s > 0
&& 'A' <= s.[0] && s.[0] <= 'Z';;
(* Yield some cannonical json for the given graph *)
let cjson_for_graph g =
let json_for_edge e =
Object [
("label", String e.label)
;("to", String e.out)] in
let json_for_adj_list k v l =
(k, Array (List.map json_for_edge v)) :: l in
Object (KG.Graph.fold json_for_adj_list g []);;
let json_for_graph g =
let buf = Buffer.create 100 in
let enc = Jsonm.encoder (`Buffer buf) in
Object (KG.Graph.fold json_for_adj_list g [])
cjson_for_graph g
|> JsonExt.decannonize enc |> ignore;
Buffer.contents buf;;
......@@ -44,10 +52,6 @@ let graph_for_json j =
let graph = KG.empty () in
JsonExt.cannonize dec |> parse_graph graph; graph;;
let is_titlecase s =
String.length s > 0
&& 'A' <= s.[0] && s.[0] <= 'Z';;
let query_for_json j =
let parse_item i =
if is_titlecase i then Variable i else Value i in
......@@ -63,6 +67,21 @@ let query_for_json j =
let dec = Jsonm.decoder (`String j) in
JsonExt.cannonize dec |> parse_query;;
(* Cannonical json for a query context *)
let cjson_for_context c =
Object (List.map (fun (k, v) -> (k, String v)) c);;
(* Json string for a list of query result pairs *)
let json_for_query_results qr =
let render_pair (graph, cntxt) =
Object [ ("graph", cjson_for_graph graph)
;("context", cjson_for_context cntxt) ] in
let buf = Buffer.create 100 in
let enc = Jsonm.encoder (`Buffer buf) in
Array (List.map render_pair qr)
|> JsonExt.decannonize enc |> ignore;
Buffer.contents buf;;
(* Close the connection that backs the given streams *)
let terminate (ic, oc) =
Unix.shutdown (descr_of_out_channel oc) SHUTDOWN_ALL;
......@@ -72,7 +91,7 @@ let terminate (ic, oc) =
(* Run the function 'f' over the data-structure 'a' under the lock 'l'.
* It ensures that the code is always run under with a locked data-structure
* and that the structure is always unlocked after the function exits. *)
let sync f l a =
let sync l f a =
Mutex.lock l;
try
let out = f a in
......@@ -80,6 +99,7 @@ let sync f l a =
with
| x -> Mutex.unlock l; raise x;;
(* Handle a connection from a client *)
let handle_client (ic, oc, addr) =
let open Request in
let handle_request request =
......@@ -87,22 +107,32 @@ let handle_client (ic, oc, addr) =
| "/graph" ->
begin match request.meth with
| "GET" ->
sync (fun _ -> json_for_graph !graph) g ()
sync g (fun _ -> json_for_graph !graph) ()
|> Response.make 200;
| "POST" ->
graph_for_json request.body
|> sync (fun ug -> mjoin_graph_left !graph ug) g;
|> sync g (fun ug -> mjoin_graph_left !graph ug);
Response.make 200 "";
| _ -> Response.make 405 ""
end;
| "/query" ->
begin match request.meth with
| "POST" ->
query_for_json request.body
|> sync g (fun q -> Query.query_graph !graph q)
|> json_for_query_results
|> Response.make 200
| _ -> Response.make 405 "";
end;
| _ -> Response.make 404 "";
in begin try
Request.read ic |> handle_request |> Response.write oc;
terminate (ic, oc);
with
(* | x -> Response.make 500 "" |> Response.write oc; *)
| x -> raise x
end;
terminate (ic, oc);;
| e ->
Response.make 500 "" |> Response.write oc;
terminate (ic, oc);
end;;
let main port =
let tcp = (getprotobyname "tcp").p_proto in
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment