From a9fc6f3f8232052f13d0ff40a146da7614b31e18 Mon Sep 17 00:00:00 2001 From: James Cheney Date: Mon, 3 Jul 2023 13:30:49 +0100 Subject: [PATCH 01/16] initial steps toward adding simple SPARQL querying --- core/dune | 3 ++- core/query/sparql.ml | 16 ++++++++++++++++ core/query/sparql.mli | 16 ++++++++++++++++ 3 files changed, 34 insertions(+), 1 deletion(-) create mode 100644 core/query/sparql.ml create mode 100644 core/query/sparql.mli diff --git a/core/dune b/core/dune index 6d06059fc..5675681fc 100644 --- a/core/dune +++ b/core/dune @@ -18,7 +18,8 @@ conduit-lwt-unix uri websocket websocket-lwt-unix.cohttp findlib menhirLib links.lens calendar - dynlink) + dynlink + rdf rdf_lwt iri) (preprocess (pps ppx_deriving.std ppx_deriving_yojson))) diff --git a/core/query/sparql.ml b/core/query/sparql.ml new file mode 100644 index 000000000..ea94eda41 --- /dev/null +++ b/core/query/sparql.ml @@ -0,0 +1,16 @@ + +open Rdf_sparql_http_lwt +open Rdf.Sparql_protocol + +let internal_error message = + Errors.internal_error ~filename:"query/sparql.ml" ~message + +let select ~base uri query = + let result = Lwt_main.run (get ~base uri {in_query = query; in_dataset = empty_dataset}) in + match result with + | Result(Rdf.Sparql.Solutions _) -> + Value.box_list [] + | Result(Rdf.Sparql.Bool _) -> raise (internal_error("expected SELECT query, but result is a boolean")) + | Result(Rdf.Sparql.Graph _) -> raise (internal_error("expected SELECT query, but result is a graph")) + | Ok -> raise (internal_error("expected SELECT query, but no result returned")) + | Error(msg) -> raise (internal_error(Rdf.Sparql_protocol.string_of_error msg)) diff --git a/core/query/sparql.mli b/core/query/sparql.mli new file mode 100644 index 000000000..1cbfdea84 --- /dev/null +++ b/core/query/sparql.mli @@ -0,0 +1,16 @@ + +(* Wrapper for running simple SPARQL queries against an endpoint. + * Errors are just thrown as dynamic failures. + * TODO: make better in almost every way. + *) + +(* select base uri query + * - base is the base IRI according to the SPARQL protocol. + * - uri is the URI of the SPARQL endpoint + * - query is the SPARQL query string (unparsed/unchecked) + * it should be a SELECT query returning a list of bindings + * returns: a Links value consisting of a list of association lists + * bound variables in the query result to their bindings + *) + +val select : base:Iri.t -> Uri.t -> string -> Value.t From c7d23ff36127c396930dfd00523ebcfade3c8279 Mon Sep 17 00:00:00 2001 From: James Cheney Date: Sat, 8 Jul 2023 14:30:50 +0100 Subject: [PATCH 02/16] experimentation with allowing primitive functions to run in lwt monad --- core/evalir.ml | 6 ++++-- core/lib.ml | 27 +++++++++++++++------------ core/lib.mli | 4 ++-- 3 files changed, 21 insertions(+), 16 deletions(-) diff --git a/core/evalir.ml b/core/evalir.ml index ef3f92f17..d5ac8cd6e 100644 --- a/core/evalir.ml +++ b/core/evalir.ml @@ -515,9 +515,11 @@ struct apply_cont cont env (`Record []) (*****************) | `PrimitiveFunction (n,None), args -> - apply_cont cont env (Lib.apply_pfun n args (Value.Env.request_data env)) + Lib.apply_pfun n args (Value.Env.request_data env) >>= fun v -> + apply_cont cont env v | `PrimitiveFunction (_, Some code), args -> - apply_cont cont env (Lib.apply_pfun_by_code code args (Value.Env.request_data env)) + Lib.apply_pfun_by_code code args (Value.Env.request_data env) >>= fun v -> + apply_cont cont env v | `ClientFunction name, args -> let req_data = Value.Env.request_data env in client_call req_data name cont args diff --git a/core/lib.ml b/core/lib.ml index b40374545..7a8e3421e 100644 --- a/core/lib.ml +++ b/core/lib.ml @@ -2,6 +2,7 @@ open CommonTypes open Utility open Proc +open Lwt (* Error functions *) let runtime_error msg = raise (Errors.runtime_error msg) @@ -32,7 +33,8 @@ let datatype = DesugarDatatypes.read ~aliases:alias_env type primitive = [ Value.t -| `PFun of RequestData.request_data -> Value.t list -> Value.t ] +| `PFun of RequestData.request_data -> Value.t list -> Value.t +| `PFunLwt of RequestData.request_data -> Value.t list -> Value.t Lwt.t ] type pure = PURE | IMPURE @@ -84,26 +86,26 @@ let float_fn fn pure = (* Functions which also take the request data as an argument -- * for example those which set cookies, change the headers, etc. *) let p1D fn = - `PFun (fun req_data args -> + `PFunLwt (fun req_data args -> match args with | ([a]) -> fn a req_data | _ -> assert false) let p2D fn = - `PFun (fun req_data args -> + `PFunLwt (fun req_data args -> match args with | [a; b] -> fn a b req_data | _ -> assert false) let p3D fn = - `PFun (fun req_data args -> + `PFunLwt (fun req_data args -> match args with | [a;b;c] -> fn a b c req_data | _ -> assert false) -let p1 fn = p1D (fun x _ -> fn x) -let p2 fn = p2D (fun x y _ -> fn x y) -let p3 fn = p3D (fun x y z _ -> fn x y z) +let p1 fn = p1D (fun x _ -> Lwt.return (fn x)) +let p2 fn = p2D (fun x y _ -> Lwt.return (fn x y)) +let p3 fn = p3D (fun x y z _ -> Lwt.return (fn x y z)) let rec equal l r = match l, r with @@ -690,7 +692,7 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ IMPURE); "print", - (p1 (fun msg -> print_string (Value.unbox_string msg); flush stdout; `Record []), + (p1D (fun msg _ -> Lwt_io.print (Value.unbox_string msg) >>= fun _ -> Lwt.return (`Record [])), datatype "(String) ~> ()", IMPURE); @@ -1029,7 +1031,7 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ let resp_headers = RequestData.get_http_response_headers req_data in RequestData.set_http_response_headers req_data (("Set-Cookie", cookieName ^ "=" ^ cookieVal) :: resp_headers); - `Record [] + Lwt.return (`Record []) (* Note: perhaps this should affect cookies returned by getcookie during the current request. *)), datatype "(String, String) ~> ()", @@ -1058,7 +1060,7 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ else "" in - Value.box_string value), + Lwt.return (Value.box_string value)), datatype "(String) ~> String", IMPURE); @@ -1069,7 +1071,7 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ let resp_headers = RequestData.get_http_response_headers req_data in RequestData.set_http_response_headers req_data (("Location", url) :: resp_headers); RequestData.set_http_response_code req_data 302; - `Record [] + Lwt.return (`Record []) ), datatype "(String) ~> ()", IMPURE); (* Should this function really return? @@ -1809,7 +1811,8 @@ let apply_pfun_by_code var args req_data = | Some #Value.t -> raise (runtime_type_error ("Attempt to apply primitive non-function " ^ "(#" ^string_of_int var^ ").")) - | Some (`PFun p) -> p req_data args + | Some (`PFun p) -> Lwt.return (p req_data args) + | Some (`PFunLwt p) -> p req_data args | None -> assert false diff --git a/core/lib.mli b/core/lib.mli index b0d1a534c..96a7c5d50 100644 --- a/core/lib.mli +++ b/core/lib.mli @@ -16,11 +16,11 @@ val nenv : Var.var Env.String.t val primitive_vars : Utility.IntSet.t -val apply_pfun : string -> Value.t list -> RequestData.request_data -> Value.t +val apply_pfun : string -> Value.t list -> RequestData.request_data -> Value.t Lwt.t val primitive_stub : string -> Value.t (* jcheney: added to avoid string comparisons at runtime *) -val apply_pfun_by_code : Var.var -> Value.t list -> RequestData.request_data -> Value.t +val apply_pfun_by_code : Var.var -> Value.t list -> RequestData.request_data -> Value.t Lwt.t val primitive_stub_by_code : Var.var -> Value.t val primitive_name : Var.var -> string From b52f2044601ca67a08a21fc49b7d09d33d3e34e9 Mon Sep 17 00:00:00 2001 From: James Cheney Date: Mon, 10 Jul 2023 13:57:46 +0100 Subject: [PATCH 03/16] embrace PFun being in Lwt.t monad get basic sparql querying working --- core/lib.ml | 76 +++++++++++++++++++++++++------------------ core/query/sparql.ml | 11 ++++--- core/query/sparql.mli | 2 +- 3 files changed, 53 insertions(+), 36 deletions(-) diff --git a/core/lib.ml b/core/lib.ml index 7a8e3421e..e66bdae85 100644 --- a/core/lib.ml +++ b/core/lib.ml @@ -33,15 +33,16 @@ let datatype = DesugarDatatypes.read ~aliases:alias_env type primitive = [ Value.t -| `PFun of RequestData.request_data -> Value.t list -> Value.t -| `PFunLwt of RequestData.request_data -> Value.t list -> Value.t Lwt.t ] +| `PFun of RequestData.request_data -> Value.t list -> Value.t Lwt.t ] type pure = PURE | IMPURE type located_primitive = [ `Client | `Server of primitive | primitive ] +let pure_pfun fn = `PFun(fun _ xs -> Lwt.return (fn xs)) + let mk_binop_fn impl unbox_fn constr = function - | [x; y] -> constr (impl (unbox_fn x) (unbox_fn y)) + | [x; y] -> Lwt.return (constr (impl (unbox_fn x) (unbox_fn y))) | _ -> raise (internal_error "arity error in integer operation") let int_op impl pure : located_primitive * Types.datatype * pure = @@ -65,7 +66,7 @@ let conversion_op' ~unbox ~conv ~(box :'a->Value.t): Value.t list -> Value.t = f let conversion_op ~from ~unbox ~conv ~(box :'a->Value.t) ~into pure : located_primitive * Types.datatype * pure = let open Types in - ((`PFun (fun _ x -> conversion_op' ~unbox:unbox ~conv:conv ~box:box x) : located_primitive), + ((pure_pfun (fun x -> conversion_op' ~unbox:unbox ~conv:conv ~box:box x) : located_primitive), (let q, r = fresh_row_quantifier (lin_any, res_any) in (ForAll ([q], Function (make_tuple_type [from], r, into)) : datatype)), pure) @@ -76,7 +77,7 @@ let string_to_xml : Value.t -> Value.t = function (* The following functions expect 1 argument. Assert false otherwise. *) let float_fn fn pure = - (`PFun (fun _ args -> + (pure_pfun (fun args -> match args with | [c] -> (Value.box_float (fn (Value.unbox_float c))) | _ -> assert false), @@ -86,19 +87,19 @@ let float_fn fn pure = (* Functions which also take the request data as an argument -- * for example those which set cookies, change the headers, etc. *) let p1D fn = - `PFunLwt (fun req_data args -> + `PFun (fun req_data args -> match args with | ([a]) -> fn a req_data | _ -> assert false) let p2D fn = - `PFunLwt (fun req_data args -> + `PFun (fun req_data args -> match args with | [a; b] -> fn a b req_data | _ -> assert false) let p3D fn = - `PFunLwt (fun req_data args -> + `PFun (fun req_data args -> match args with | [a;b;c] -> fn a b c req_data | _ -> assert false) @@ -107,6 +108,7 @@ let p1 fn = p1D (fun x _ -> Lwt.return (fn x)) let p2 fn = p2D (fun x y _ -> Lwt.return (fn x y)) let p3 fn = p3D (fun x y z _ -> Lwt.return (fn x y z)) + let rec equal l r = match l, r with | `Bool l , `Bool r -> l = r @@ -315,14 +317,12 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ PURE); "intToXml", - (`PFun (fun _ -> - string_to_xml -<- (conversion_op' ~unbox:Value.unbox_int ~conv:(string_of_int) ~box:Value.box_string)), + (pure_pfun (string_to_xml -<- (conversion_op' ~unbox:Value.unbox_int ~conv:(string_of_int) ~box:Value.box_string)), datatype "(Int) -> Xml", PURE); "floatToXml", - (`PFun (fun _ -> - string_to_xml -<- (conversion_op' ~unbox:Value.unbox_float ~conv:(string_of_float') ~box:Value.box_string)), + (pure_pfun (string_to_xml -<- (conversion_op' ~unbox:Value.unbox_float ~conv:(string_of_float') ~box:Value.box_string)), datatype "(Float) -> Xml", PURE); @@ -362,12 +362,12 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ IMPURE); "self", - (`PFun (fun _ _ -> `Pid (`ServerPid (Proc.get_current_pid()))), + (pure_pfun (fun _ -> `Pid (`ServerPid (Proc.get_current_pid()))), datatype "() {hear{a}|e}~> Process ({ hear{a} })", IMPURE); "here", - (`PFun (fun _ _ -> `SpawnLocation (`ServerSpawnLoc)), + (pure_pfun (fun _ -> `SpawnLocation (`ServerSpawnLoc)), datatype "() ~> Location", IMPURE ); @@ -375,13 +375,13 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ "there", (`PFun (fun req_data _ -> let client_id = RequestData.get_client_id req_data in - `SpawnLocation (`ClientSpawnLoc client_id)), + Lwt.return (`SpawnLocation (`ClientSpawnLoc client_id))), datatype "() ~> Location", IMPURE ); "haveMail", - (`PFun(fun _ -> + (`PFun(fun _ _ -> runtime_error "The haveMail function is not implemented on the server yet"), datatype "() {:_|_}~> Bool", IMPURE); @@ -1101,32 +1101,32 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ "serverTime", (`Server - (`PFun (fun _ _ -> + (pure_pfun (fun _ -> Value.box_int(int_of_float(Unix.time())))), datatype "() ~> Int", IMPURE); "lensQueryTimeMilliseconds", (`Server - (`PFun (fun _ _ -> Value.box_int (Lens.Statistics.get_query_time ()))), + (pure_pfun (fun _ -> Value.box_int (Lens.Statistics.get_query_time ()))), datatype "() ~> Int", IMPURE); "lensQueryCount", (`Server - (`PFun (fun _ _ -> Value.box_int (Lens.Statistics.get_query_count ()))), + (pure_pfun (fun _ -> Value.box_int (Lens.Statistics.get_query_count ()))), datatype "() ~> Int", IMPURE); "lensQueryStatisticsReset", (`Server - (`PFun (fun _ _ -> Value.box_unit (Lens.Statistics.reset ()))), + (pure_pfun (fun _ -> Value.box_unit (Lens.Statistics.reset ()))), datatype "() ~> ()", IMPURE); "serverTimeMilliseconds", (`Server - (`PFun (fun _ _ -> + (pure_pfun (fun _ -> Value.box_int(time_milliseconds()))), datatype "() ~> Int", IMPURE); @@ -1199,14 +1199,14 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ IMPURE); "now", - (`PFun (fun _ _ -> Value.box_datetime (Timestamp.now ())), + (pure_pfun (fun _ -> Value.box_datetime (Timestamp.now ())), datatype "() -> DateTime", IMPURE); (* Returns UTC offset of local time. For example, if local time is British Summer Time, then utcOffset() would return 1. *) "utcOffset", - (`PFun (fun _ _ -> + (pure_pfun (fun _ -> CalendarLib.Time_Zone.(gap UTC Local) |> Value.box_int), datatype "() ~> Int", @@ -1302,8 +1302,8 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ IMPURE); "getDatabaseConfig", - (`PFun - (fun _ _ -> + (pure_pfun + (fun _ -> let args = from_option "" (Settings.get Database.connection_info) in match Settings.get DatabaseDriver.driver with | None -> @@ -1341,7 +1341,7 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ let cgi_params = RequestData.get_cgi_parameters req_data in let makestrpair (x1, x2) = `Record [("1", Value.box_string x1); ("2", Value.box_string x2)] in let is_internal s = Str.string_match (Str.regexp "^_") s 0 in - `List (List.map makestrpair (List.filter (not -<- is_internal -<- fst) cgi_params))), + Lwt.return (`List (List.map makestrpair (List.filter (not -<- is_internal -<- fst) cgi_params)))), datatype "() ~> [(String,String)]", IMPURE)); @@ -1498,7 +1498,7 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ (* non-deterministic random number generator *) "random", - (`PFun (fun _ _ -> (Value.box_float (Random.float 1.0))), + (pure_pfun (fun _ -> (Value.box_float (Random.float 1.0))), datatype "() -> Float", IMPURE); @@ -1610,7 +1610,7 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ "gensym", (let idx = ref 0 in - `PFun (fun _ _ -> let i = !idx in idx := i+1; (Value.box_int i)), + pure_pfun (fun _ -> let i = !idx in idx := i+1; (Value.box_int i)), datatype "() -> Int", IMPURE); @@ -1695,10 +1695,25 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ (* CLI *) "getArgs", (`Server - (`PFun (fun _ _ -> + (pure_pfun (fun _ -> Value.(box_list (List.map box_string (Settings.get_rest_arguments ()))))), datatype "() ~> [String]", + IMPURE); + + (* SPARQL *) + "sparql", + (`Server + (p3D (fun base uri query _ -> + let base = Iri.of_string (Value.unbox_string base) in + let uri = Uri.of_string(Value.unbox_string uri) in + let query = Value.unbox_string query in + Sparql.select ~base uri query >>= fun result -> + Lwt.return (Value.box_list (List.map (fun s -> + Value.box_list (List.map (fun (k,v) -> + (Value.box_pair (Value.box_string k) (Value.box_string v))) s)) result)))), + datatype "(String,String,String) ~> [[(String,String)]]", IMPURE) + ] let impl : located_primitive -> primitive option = function @@ -1811,8 +1826,7 @@ let apply_pfun_by_code var args req_data = | Some #Value.t -> raise (runtime_type_error ("Attempt to apply primitive non-function " ^ "(#" ^string_of_int var^ ").")) - | Some (`PFun p) -> Lwt.return (p req_data args) - | Some (`PFunLwt p) -> p req_data args + | Some (`PFun p) -> p req_data args | None -> assert false diff --git a/core/query/sparql.ml b/core/query/sparql.ml index ea94eda41..5b0c40a1c 100644 --- a/core/query/sparql.ml +++ b/core/query/sparql.ml @@ -1,15 +1,18 @@ -open Rdf_sparql_http_lwt +open Lwt open Rdf.Sparql_protocol +open Rdf_sparql_http_lwt let internal_error message = Errors.internal_error ~filename:"query/sparql.ml" ~message + + let select ~base uri query = - let result = Lwt_main.run (get ~base uri {in_query = query; in_dataset = empty_dataset}) in + get ~base ~accept:"application/json" uri {in_query = query; in_dataset = empty_dataset} >>= fun result -> match result with - | Result(Rdf.Sparql.Solutions _) -> - Value.box_list [] + | Result(Rdf.Sparql.Solutions ss) -> + Lwt.return (List.map (fun s -> Rdf.Sparql.solution_fold (fun x t l -> (x, Rdf.Term.string_of_term t)::l) s []) ss) | Result(Rdf.Sparql.Bool _) -> raise (internal_error("expected SELECT query, but result is a boolean")) | Result(Rdf.Sparql.Graph _) -> raise (internal_error("expected SELECT query, but result is a graph")) | Ok -> raise (internal_error("expected SELECT query, but no result returned")) diff --git a/core/query/sparql.mli b/core/query/sparql.mli index 1cbfdea84..493190ede 100644 --- a/core/query/sparql.mli +++ b/core/query/sparql.mli @@ -13,4 +13,4 @@ * bound variables in the query result to their bindings *) -val select : base:Iri.t -> Uri.t -> string -> Value.t +val select : base:Iri.t -> Uri.t -> string -> (string * string) list list Lwt.t From 63354556cded42a53d206c7b0b61f59dcbd7a011 Mon Sep 17 00:00:00 2001 From: James Cheney Date: Mon, 10 Jul 2023 14:09:53 +0100 Subject: [PATCH 04/16] fix whitespace --- core/evalir.ml | 2 +- core/lib.ml | 2 +- core/query/sparql.ml | 2 +- core/query/sparql.mli | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/core/evalir.ml b/core/evalir.ml index d5ac8cd6e..b34644326 100644 --- a/core/evalir.ml +++ b/core/evalir.ml @@ -515,7 +515,7 @@ struct apply_cont cont env (`Record []) (*****************) | `PrimitiveFunction (n,None), args -> - Lib.apply_pfun n args (Value.Env.request_data env) >>= fun v -> + Lib.apply_pfun n args (Value.Env.request_data env) >>= fun v -> apply_cont cont env v | `PrimitiveFunction (_, Some code), args -> Lib.apply_pfun_by_code code args (Value.Env.request_data env) >>= fun v -> diff --git a/core/lib.ml b/core/lib.ml index e66bdae85..2c98f3c8b 100644 --- a/core/lib.ml +++ b/core/lib.ml @@ -1713,7 +1713,7 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ (Value.box_pair (Value.box_string k) (Value.box_string v))) s)) result)))), datatype "(String,String,String) ~> [[(String,String)]]", IMPURE) - + ] let impl : located_primitive -> primitive option = function diff --git a/core/query/sparql.ml b/core/query/sparql.ml index 5b0c40a1c..28238308a 100644 --- a/core/query/sparql.ml +++ b/core/query/sparql.ml @@ -11,7 +11,7 @@ let internal_error message = let select ~base uri query = get ~base ~accept:"application/json" uri {in_query = query; in_dataset = empty_dataset} >>= fun result -> match result with - | Result(Rdf.Sparql.Solutions ss) -> + | Result(Rdf.Sparql.Solutions ss) -> Lwt.return (List.map (fun s -> Rdf.Sparql.solution_fold (fun x t l -> (x, Rdf.Term.string_of_term t)::l) s []) ss) | Result(Rdf.Sparql.Bool _) -> raise (internal_error("expected SELECT query, but result is a boolean")) | Result(Rdf.Sparql.Graph _) -> raise (internal_error("expected SELECT query, but result is a graph")) diff --git a/core/query/sparql.mli b/core/query/sparql.mli index 493190ede..5424fcd3f 100644 --- a/core/query/sparql.mli +++ b/core/query/sparql.mli @@ -12,5 +12,5 @@ * returns: a Links value consisting of a list of association lists * bound variables in the query result to their bindings *) - + val select : base:Iri.t -> Uri.t -> string -> (string * string) list list Lwt.t From fa139ab437743cc9109b805ef1ea4030f4ddd3a2 Mon Sep 17 00:00:00 2001 From: James Cheney Date: Mon, 10 Jul 2023 14:24:27 +0100 Subject: [PATCH 05/16] add rdf_lwt dependency to links.opam --- links.opam | 1 + 1 file changed, 1 insertion(+) diff --git a/links.opam b/links.opam index 55a6cbae5..7cb998335 100644 --- a/links.opam +++ b/links.opam @@ -37,4 +37,5 @@ depends: [ "menhir" {>= "20210419"} "ppx_sexp_conv" {<= "v0.15.1"} "calendar" {>= "2.0.4"} + "rdf_lwt {>= "0.14.0"} ] From 3bf4372a4c65e781d34d362d7d8c15ec69a502e6 Mon Sep 17 00:00:00 2001 From: James Cheney Date: Mon, 10 Jul 2023 14:25:25 +0100 Subject: [PATCH 06/16] tab --- core/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/dune b/core/dune index 5675681fc..4ad604cb4 100644 --- a/core/dune +++ b/core/dune @@ -19,7 +19,7 @@ websocket websocket-lwt-unix.cohttp findlib menhirLib links.lens calendar dynlink - rdf rdf_lwt iri) + rdf rdf_lwt iri) (preprocess (pps ppx_deriving.std ppx_deriving_yojson))) From 7909b8e2e8d822b677c6a29145f4454c4effb340 Mon Sep 17 00:00:00 2001 From: James Cheney Date: Mon, 10 Jul 2023 14:28:19 +0100 Subject: [PATCH 07/16] argh --- links.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/links.opam b/links.opam index 7cb998335..904df64a5 100644 --- a/links.opam +++ b/links.opam @@ -37,5 +37,5 @@ depends: [ "menhir" {>= "20210419"} "ppx_sexp_conv" {<= "v0.15.1"} "calendar" {>= "2.0.4"} - "rdf_lwt {>= "0.14.0"} + "rdf_lwt" {>= "0.14.0"} ] From cf67f6dcb6d1a705fd4ca679455096c5af594ecb Mon Sep 17 00:00:00 2001 From: James Cheney Date: Mon, 10 Jul 2023 14:36:46 +0100 Subject: [PATCH 08/16] relax version of rdf_lwt --- links.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/links.opam b/links.opam index 904df64a5..8e3d8bebe 100644 --- a/links.opam +++ b/links.opam @@ -37,5 +37,5 @@ depends: [ "menhir" {>= "20210419"} "ppx_sexp_conv" {<= "v0.15.1"} "calendar" {>= "2.0.4"} - "rdf_lwt" {>= "0.14.0"} + "rdf_lwt" {>= "0.13.0"} ] From bacb126566f5016d8328af2977ca8b21065127b9 Mon Sep 17 00:00:00 2001 From: James Cheney Date: Mon, 10 Jul 2023 14:48:07 +0100 Subject: [PATCH 09/16] use ocaml 4.14.1 for rule check workflow --- .github/workflows/default.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/default.yml b/.github/workflows/default.yml index e0b02b0ab..fc319c969 100644 --- a/.github/workflows/default.yml +++ b/.github/workflows/default.yml @@ -17,7 +17,7 @@ jobs: os: - ubuntu-20.04 ocaml-compiler: - - 4.08.1 + - 4.14.1 runs-on: ${{ matrix.os }} From 1d19a9c43c8ef4977e8e67ffc95dee2458a56d0f Mon Sep 17 00:00:00 2001 From: James Cheney Date: Mon, 10 Jul 2023 14:52:56 +0100 Subject: [PATCH 10/16] Update default.yml Use OCaml 4.14.1 for rule check, for consistency with other checks --- .github/workflows/default.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/default.yml b/.github/workflows/default.yml index e0b02b0ab..fc319c969 100644 --- a/.github/workflows/default.yml +++ b/.github/workflows/default.yml @@ -17,7 +17,7 @@ jobs: os: - ubuntu-20.04 ocaml-compiler: - - 4.08.1 + - 4.14.1 runs-on: ${{ matrix.os }} From b99d5e7eece6c30bfcab6755c096eebf4b4aaad3 Mon Sep 17 00:00:00 2001 From: James Cheney Date: Mon, 10 Jul 2023 15:53:11 +0100 Subject: [PATCH 11/16] revert print library function to not use Lwt --- core/lib.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/lib.ml b/core/lib.ml index 2c98f3c8b..d7787602a 100644 --- a/core/lib.ml +++ b/core/lib.ml @@ -692,7 +692,7 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ IMPURE); "print", - (p1D (fun msg _ -> Lwt_io.print (Value.unbox_string msg) >>= fun _ -> Lwt.return (`Record [])), + (p1 (fun msg -> print_string (Value.unbox_string msg); flush stdout; `Record []), datatype "(String) ~> ()", IMPURE); From 3892ac3d9ecf5fe4f84a6d64a67fd5d7af48adc1 Mon Sep 17 00:00:00 2001 From: James Cheney Date: Mon, 10 Jul 2023 15:54:16 +0100 Subject: [PATCH 12/16] Update .github/workflows/default.yml most recent version compativle with ocamlformat 0.19.0 --- .github/workflows/default.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/default.yml b/.github/workflows/default.yml index fc319c969..d273b9b9c 100644 --- a/.github/workflows/default.yml +++ b/.github/workflows/default.yml @@ -17,7 +17,7 @@ jobs: os: - ubuntu-20.04 ocaml-compiler: - - 4.14.1 + - 4.13.1 runs-on: ${{ matrix.os }} From e4c1f995aa618dfb72086004404a7d3a5915a4cd Mon Sep 17 00:00:00 2001 From: James Cheney Date: Tue, 10 Oct 2023 10:11:18 +0100 Subject: [PATCH 13/16] Update core/lib.ml --- core/lib.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/lib.ml b/core/lib.ml index d7787602a..2f35a69a9 100644 --- a/core/lib.ml +++ b/core/lib.ml @@ -66,7 +66,7 @@ let conversion_op' ~unbox ~conv ~(box :'a->Value.t): Value.t list -> Value.t = f let conversion_op ~from ~unbox ~conv ~(box :'a->Value.t) ~into pure : located_primitive * Types.datatype * pure = let open Types in - ((pure_pfun (fun x -> conversion_op' ~unbox:unbox ~conv:conv ~box:box x) : located_primitive), + ((pure_pfun (fun x -> conversion_op' ~unbox ~conv:conv ~box:box x) : located_primitive), (let q, r = fresh_row_quantifier (lin_any, res_any) in (ForAll ([q], Function (make_tuple_type [from], r, into)) : datatype)), pure) From e6cd5096c388ab028ba4838bc5b08cfe0ba05a89 Mon Sep 17 00:00:00 2001 From: James Cheney Date: Tue, 10 Oct 2023 10:11:25 +0100 Subject: [PATCH 14/16] Update core/query/sparql.ml --- core/query/sparql.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/query/sparql.ml b/core/query/sparql.ml index 28238308a..d3e059bc8 100644 --- a/core/query/sparql.ml +++ b/core/query/sparql.ml @@ -16,4 +16,4 @@ let select ~base uri query = | Result(Rdf.Sparql.Bool _) -> raise (internal_error("expected SELECT query, but result is a boolean")) | Result(Rdf.Sparql.Graph _) -> raise (internal_error("expected SELECT query, but result is a graph")) | Ok -> raise (internal_error("expected SELECT query, but no result returned")) - | Error(msg) -> raise (internal_error(Rdf.Sparql_protocol.string_of_error msg)) + | Error(msg) -> raise (internal_error("SPARQL error: " ^ (Rdf.Sparql_protocol.string_of_error msg))) From 1fbb407c738812848c3734dee5eceeb9c48c829a Mon Sep 17 00:00:00 2001 From: James Cheney Date: Tue, 10 Oct 2023 10:11:35 +0100 Subject: [PATCH 15/16] Update core/lib.ml --- core/lib.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/lib.ml b/core/lib.ml index 2f35a69a9..19f9a03f3 100644 --- a/core/lib.ml +++ b/core/lib.ml @@ -1703,7 +1703,7 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ (* SPARQL *) "sparql", (`Server - (p3D (fun base uri query _ -> + (p3 (fun base uri query -> let base = Iri.of_string (Value.unbox_string base) in let uri = Uri.of_string(Value.unbox_string uri) in let query = Value.unbox_string query in From 7729619514c6eea17d46394a22adbcd74b1a1ca4 Mon Sep 17 00:00:00 2001 From: James Cheney Date: Tue, 10 Oct 2023 10:33:10 +0100 Subject: [PATCH 16/16] Update core/lib.ml --- core/lib.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/lib.ml b/core/lib.ml index 877b094e4..f5b6e2e44 100644 --- a/core/lib.ml +++ b/core/lib.ml @@ -1729,7 +1729,7 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [ (* SPARQL *) "sparql", (`Server - (p3 (fun base uri query -> + (p3D (fun base uri query _ -> let base = Iri.of_string (Value.unbox_string base) in let uri = Uri.of_string(Value.unbox_string uri) in let query = Value.unbox_string query in