aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorarie <arie@alleycat.cc>2021-05-27 22:48:58 +0200
committerarie <arie@alleycat.cc>2021-06-28 21:02:44 +0200
commit69ae7300da09315ffec8b3699b032dbfc3863e4f (patch)
treed6f83cbae937780c6ac193f5d1cc878a93dcb633
parent8c9bc8478842a393f85259f1350bf04711c190fa (diff)
Rdf_turtle:
improve tests for parsers, and include more. Add equality functions and pp functions for more types, especially the recursive ones. Not polished at all (a lot of copy paste), but dune build works (that's a start I guess).
-rw-r--r--lib/turtle/rdf_turtle.ml85
-rw-r--r--lib/turtle/rdf_turtle.mli21
-rw-r--r--test/turtle/main.ml106
3 files changed, 159 insertions, 53 deletions
diff --git a/lib/turtle/rdf_turtle.ml b/lib/turtle/rdf_turtle.ml
index af55784..20360f0 100644
--- a/lib/turtle/rdf_turtle.ml
+++ b/lib/turtle/rdf_turtle.ml
@@ -6,6 +6,13 @@
* SPDX-License-Identifier: AGPL-3.0-or-later
*)
+(* From ocaml 4.12. Move to util functions or something? *)
+let rec list_equal eq l1 l2 =
+ match l1, l2 with
+ | [], [] -> true
+ | [], _::_ | _::_, [] -> false
+ | a1::l1, a2::l2 -> eq a1 a2 && list_equal eq l1 l2
+
module Ordered_string = struct
type t = string
@@ -141,7 +148,9 @@ module AST = struct
let pp ppf literal =
(* TODO print the datatype and language *)
Fmt.pf ppf
- "@[<8><literal@ value@ %s>@]" (canonical literal)
+ "@[<8><literal@ value@ %s@ iri %a>@]"
+ (canonical literal)
+ Iri.pp (datatype literal)
end
@@ -178,6 +187,62 @@ module AST = struct
and bnodep = BNodeP of predobjs
and predobjs = (Predicate.t * object' list) list
+ let rec object_equal a b =
+ match (a, b) with
+ | (Obj_iri ia, Obj_iri ib) -> Iri.equal ia ib
+ | (Obj_blank_node ba, Obj_blank_node bb) -> Blank_node.equal ba bb
+ | (Obj_literal la, Obj_literal lb) -> Literal.equal la lb
+ | (Obj_coll ca, Obj_coll cb) -> collection_equal ca cb
+ | (Obj_BnodPs bas, Obj_BnodPs bbs) -> list_equal bnodep_equal bas bbs
+ | _ -> false
+ and collection_equal (Collection obsa) (Collection obsb) =
+ list_equal object_equal obsa obsb
+ and subject_equal a b =
+ match (a, b) with
+ | (Sub_iri ia, Sub_iri ib) -> Iri.equal ia ib
+ | (Sub_blank_node ba, Sub_blank_node bb) -> Blank_node.equal ba bb
+ | (Sub_coll ca, Sub_coll cb) -> collection_equal ca cb
+ | _ -> false
+ and bnodep_equal (BNodeP poa) (BNodeP pob) =
+ predobjs_equal poa pob
+ and predobjs_equal a b =
+ list_equal
+ (fun (p, obsa) (q, obsb) -> Predicate.equal p q && list_equal object_equal obsa obsb)
+ a b
+
+ let rec object_pp ppf = function
+ | Obj_iri iri -> Fmt.pf ppf "@[<h 1><obj_iri@ %a>@]" Iri.pp iri
+ | Obj_blank_node bnode -> Fmt.pf ppf "@[<h 1><obj_blank_node@ %a>@]" Blank_node.pp bnode
+ | Obj_literal lit -> Fmt.pf ppf "@[<h 1><obj_literal@ %a>@]" Literal.pp lit
+ | Obj_coll coll -> Fmt.pf ppf "@[<h 1><obj_coll@ %a>@]" collection_pp coll
+ | Obj_BnodPs bnodps ->
+ List.iter
+ (fun bnodp -> Fmt.pf ppf "@[<h 1><obj_bnodps@ %a>@]" bnodep_pp bnodp)
+ bnodps
+ and collection_pp ppf (Collection objs) =
+ List.iter
+ (fun obj -> Fmt.pf ppf "@[<h 1><collection obj@ %a>@]" object_pp obj)
+ objs
+ and subject_pp ppf = function
+ | Sub_iri iri ->Fmt.pf ppf "@[<h 1><obj_iri@ %a>@]" Iri.pp iri
+ | Sub_blank_node bnode -> Fmt.pf ppf "@[<h 1><obj_blank_node@ %a>@]" Blank_node.pp bnode
+ | Sub_coll collection -> Fmt.pf ppf "@[<h 1><obj_collection@ %a>@]" collection_pp collection
+ and bnodep_pp ppf (BNodeP predobjs) =
+ Fmt.pf ppf "@[<h 1><obj_bnodep@ %a>@]" predobjs_pp predobjs
+ and predobjs_pp ppf l =
+ let objlist_pp ppf l =
+ List.iter
+ (fun o -> Fmt.pf ppf "@[<h 1><object@ %a>@]" object_pp o)
+ l in
+ List.iter
+ (fun (p, objlist) ->
+ Fmt.pf ppf "@[<h 1><predicate %a object_list %a>@"
+ Predicate.pp p
+ objlist_pp objlist)
+ l
+
+
+
type triples =
SubjPredObjs of subject * predobjs
| BNodePs of (bnodep list)
@@ -219,12 +284,6 @@ module Parser = struct
*> take_while (fun d -> not @@ Char.equal c2 d)
<* char c2
-(* let iriref = *)
-(* char '<' *)
-(* *> take_while (fun c -> not @@ Char.equal '>' c) *)
-(* <* char '>' *)
-(* >>| (fun s -> Iriref.of_string s) *)
-
let iriref =
lift
AST.Iriref.of_string
@@ -255,16 +314,22 @@ module Parser = struct
<|>
(lift AST.Iri.of_prefixed_name prefixed_name)
+ (* TODO the iri of the literal defaults to xds:string. This is the case,
+ * according to the spec, but it can also happen elsewhere.
+ * Moreover: an absent language results in an empty string. This could also be different. *)
let literal =
lift3
(fun value lang_opt iri -> match lang_opt with
| "" -> AST.Literal.make value iri
| lang -> AST.Literal.make value ~language:lang iri)
(delimiters '"' '"')
- (char '@'
- *> (take_while (char_is_not_equal_to ':'))
+ (option
+ ""
+ (char '@' *> take_while (char_is_not_equal_to ':'))
)
- (string "^^" *> iri)
+ (option
+ (AST.Iri.of_prefixed_name @@ AST.Prefixed_name.of_strings "xsd" "string")
+ (string "^^" *> iri))
let predicate =
lift AST.Predicate.of_iri iri
diff --git a/lib/turtle/rdf_turtle.mli b/lib/turtle/rdf_turtle.mli
index 6df01c7..3be6a58 100644
--- a/lib/turtle/rdf_turtle.mli
+++ b/lib/turtle/rdf_turtle.mli
@@ -144,6 +144,27 @@ module AST : sig
SubjPredObjs of subject * predobjs
| BNodePs of (bnodep list)
+ val object_equal : object' -> object' -> bool
+ val collection_equal : collection -> collection -> bool
+ val subject_equal : subject -> subject -> bool
+ val bnodep_equal : bnodep -> bnodep -> bool
+ val predobjs_equal : predobjs -> predobjs -> bool
+
+ val object_pp : object' Fmt.t
+ [@@ocaml.toplevel_printer]
+
+ val collection_pp : collection Fmt.t
+ [@@ocaml.toplevel_printer]
+
+ val subject_pp : subject Fmt.t
+ [@@ocaml.toplevel_printer]
+
+ val bnodep_pp : bnodep Fmt.t
+ [@@ocaml.toplevel_printer]
+
+ val predobjs_pp : predobjs Fmt.t
+ [@@ocaml.toplevel_printer]
+
type directive = PrefixID of string * Iriref.t | Base of Iriref.t
type statement = Directive of directive | Triples of triples
diff --git a/test/turtle/main.ml b/test/turtle/main.ml
index 7f96981..e6ee3c3 100644
--- a/test/turtle/main.ml
+++ b/test/turtle/main.ml
@@ -9,13 +9,19 @@ let parse p =
p
let iriref_test_case =
+ let cases = [
+ "<http://one.example/subject1>",
+ Turtle.Iriref.of_string "http://one.example/subject1" ;
+ ] in
test_case "iriref" `Quick
(fun () ->
- check (result Rdf_alcotest.ast_iriref string)
- "can parse"
- (parse Parser.iriref "<http://one.example/subject1>")
- (Result.ok @@ Turtle.Iriref.of_string "http://one.example/subject1")
- )
+ List.iter
+ (fun (enc, v) ->
+ check (result Rdf_alcotest.ast_iriref string)
+ "can parse"
+ (parse Parser.iriref enc)
+ (Result.ok @@ v))
+ cases)
let language_test_case =
test_case "language" `Quick
@@ -27,23 +33,21 @@ let language_test_case =
)
let prefixed_name_test_case =
+ let cases = [
+ "rdf:first",
+ Turtle.Prefixed_name.of_strings "rdf" "first" ;
+ ":first",
+ Turtle.Prefixed_name.of_strings "" "first" ;
+ ] in
test_case "prefixed_name" `Quick
(fun () ->
- check (result Rdf_alcotest.ast_prefixed_name string)
- "can parse"
- (parse Parser.prefixed_name "rdf:first")
- (Result.ok @@ Turtle.Prefixed_name.of_strings "rdf" "first")
- )
-
-let prefixed_name_test_case2 =
- test_case "prefixed_name2" `Quick
- (fun () ->
- check (result Rdf_alcotest.ast_prefixed_name string)
- "can parse"
- (parse Parser.prefixed_name ":first")
- (Result.ok @@ Turtle.Prefixed_name.of_strings "" "first")
- )
-
+ List.iter
+ (fun (enc, v) ->
+ check (result Rdf_alcotest.ast_prefixed_name string)
+ "can parse"
+ (parse Parser.prefixed_name enc)
+ (Result.ok @@ v))
+ cases)
let blank_node_test_case =
test_case "blank_node" `Quick
@@ -55,33 +59,51 @@ let blank_node_test_case =
)
let iri_test_case =
+ let cases = [
+ "<http://one.example/subject1>",
+ Turtle.Iri.of_iriref @@ Turtle.Iriref.of_string "http://one.example/subject1" ;
+ "p:subject3",
+ Turtle.Iri.of_prefixed_name @@ Turtle.Prefixed_name.of_strings "p" "subject3" ;
+ ] in
test_case "iri" `Quick
(fun () ->
- check (result Rdf_alcotest.ast_iri string)
- "can parse"
- (parse Parser.iri "<http://one.example/subject1>")
- (Result.ok @@ Turtle.Iri.of_iriref @@ Turtle.Iriref.of_string "http://one.example/subject1")
- )
-
-let iri_test_case2 =
- test_case "iri2" `Quick
- (fun () ->
- check (result Rdf_alcotest.ast_iri string)
- "can parse"
- (parse Parser.iri "p:subject3")
- (Result.ok @@ Turtle.Iri.of_prefixed_name @@ Turtle.Prefixed_name.of_strings "p" "subject3")
- )
+ List.iter
+ (fun (enc, v) ->
+ check (result Rdf_alcotest.ast_iri string)
+ "can parse"
+ (parse Parser.iri enc)
+ (Result.ok @@ v))
+ cases)
let literal_test_case =
+ let cases = [
+ "\"That Seventies Show\"^^xsd:string",
+ Turtle.Literal.make
+ ("That Seventies Show")
+ (Turtle.Iri.of_prefixed_name @@ Turtle.Prefixed_name.of_strings "xsd" "string") ;
+ "\"That Seventies Show\"^^<http://www.w3.org/2001/XMLSchema#string>",
+ Turtle.Literal.make
+ ("That Seventies Show")
+ (Turtle.Iri.of_iriref @@ Turtle.Iriref.of_string "http://www.w3.org/2001/XMLSchema#string");
+ "\"That Seventies Show\"",
+ Turtle.Literal.make
+ ("That Seventies Show")
+ (Turtle.Iri.of_prefixed_name @@ Turtle.Prefixed_name.of_strings "xsd" "string") ;
+ "\"Cette Série des Années Septantei\"@fr-be",
+ Turtle.Literal.make
+ "Cette Série des Années Septantei"
+ (Turtle.Iri.of_prefixed_name @@ Turtle.Prefixed_name.of_strings "xsd" "string")
+ ~language:"fr-be" ;
+ ] in
test_case "literal" `Quick
(fun () ->
- check (result Rdf_alcotest.ast_literal string)
- "can parse"
- (parse Parser.literal "\"That Seventies Show\"^^xsd:string")
- (Result.ok @@ (Turtle.Literal.make
- ("That Seventies Show")
- (Turtle.Iri.of_prefixed_name @@ Turtle.Prefixed_name.of_strings "xsd" "string")))
- )
+ List.iter
+ (fun (enc, v) ->
+ check (result Rdf_alcotest.ast_literal string)
+ "can parse"
+ (parse Parser.literal enc)
+ (Result.ok @@ v))
+ cases)
let () =
Alcotest.run "Turtle" [
@@ -89,10 +111,8 @@ let () =
iriref_test_case;
language_test_case;
prefixed_name_test_case;
- prefixed_name_test_case2;
blank_node_test_case;
iri_test_case;
- iri_test_case2;
literal_test_case;
]
]