aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpukkamustard <pukkamustard@posteo.net>2021-06-22 10:33:24 +0200
committerpukkamustard <pukkamustard@posteo.net>2021-06-22 10:46:54 +0200
commit67797a14aaf932c7ff6503d062447d8b59e4446e (patch)
treea294db5b091d638f9499583fa01834ab309f2d80
parent9d992a8137b9a36be032dcecced141048507c7a2 (diff)
Rdf_fragment_graph: Reimplement using standard library Map and Set.
This gets rid of the containers dependency and cleans up implementaiton a bit.
-rw-r--r--guix.scm36
-rw-r--r--lib/core/dune2
-rw-r--r--lib/core/literal.ml17
-rw-r--r--lib/fragment_graph/rdf_fragment_graph.ml289
-rw-r--r--lib/fragment_graph/rdf_fragment_graph.mli35
-rw-r--r--test/fragment_graph/main.ml113
-rw-r--r--test/gen/rdf_gen.ml4
7 files changed, 274 insertions, 222 deletions
diff --git a/guix.scm b/guix.scm
index 0b3ca4e..1239eb0 100644
--- a/guix.scm
+++ b/guix.scm
@@ -33,39 +33,6 @@
(description #f)
(license license:agpl3+)))
-(define-public ocaml-containers
- (package
- (name "ocaml-containers")
- (version "3.4")
- (home-page "https://github.com/c-cube/ocaml-containers/")
- (source
- (origin
- (method git-fetch)
- (uri (git-reference
- (url home-page)
- (commit (string-append "v" version))))
- (sha256
- (base32
- "0ixpy81p6rc3lq71djfndb2sg2hfj20j1jbzzrrmgqsysqdjsgzz"))))
- (build-system dune-build-system)
- (arguments
- ;; too lazy to add deps
- `(#:tests? #f))
- (propagated-inputs
- `(("ocaml-seq" ,ocaml-seq)
- ("ocaml-odoc" ,ocaml-odoc)))
- ;; (native-inputs
- ;; `(("ocaml-qtest" ,ocaml-qtest)
- ;; ("ocaml-qcheck" ,ocaml-qcheck)
- ;; ("ocaml-ounit" ,ocaml-ounit)
- ;; ("ocaml-iter" ,ocaml-iter)
- ;; ("ocaml-gen" ,ocaml-gen)
- ;; ("ocaml-uutf" ,ocaml-uutf)))
- (synopsis
- "A modular, clean and powerful extension of the OCaml standard library")
- (description #f)
- (license license:bsd-2)))
-
(define-public ocaml-rdf
(package
(name "ocaml-rdf")
@@ -81,8 +48,7 @@
("yojson" ,ocaml-yojson)
("cbor" ,ocaml-cbor)
("angstrom" ,ocaml-angstrom)
- ("fmt" ,ocaml-fmt)
- ("containers" ,ocaml-containers)))
+ ("fmt" ,ocaml-fmt)))
(home-page "https://gitlab.com/public.dream/DROMEDAR/ocaml-rdf")
(synopsis "RDF library for OCaml")
(description #f)
diff --git a/lib/core/dune b/lib/core/dune
index 7602290..734b027 100644
--- a/lib/core/dune
+++ b/lib/core/dune
@@ -1,4 +1,4 @@
(library
(name rdf)
- (libraries uri fmt containers-data)
+ (libraries uri fmt)
(public_name rdf))
diff --git a/lib/core/literal.ml b/lib/core/literal.ml
index 42e31e7..fbff07b 100644
--- a/lib/core/literal.ml
+++ b/lib/core/literal.ml
@@ -33,13 +33,14 @@ let equal a b =
(Option.equal String.equal a.language b.language)
let compare a b =
- let result = String.compare
- (Iri.to_string a.datatype ^ canonical a)
- (Iri.to_string b.datatype ^ canonical b)
- in
- Format.printf "compare literal: %d\n" result;
- result
+ String.compare
+ (Iri.to_string a.datatype ^ canonical a ^
+ (Option.value ~default:"" a.language))
+ (Iri.to_string b.datatype ^ canonical b ^
+ (Option.value ~default:"" b.language))
let pp ppf literal =
- (* TODO print the datatype and language *)
- Fmt.pf ppf "@[<h 1><literal@ %s>@]" (canonical literal)
+ (* TODO print language. Maybe use the Turtle pp for nicer pp. *)
+ Fmt.pf ppf "@[<h 1><literal@ %s^^%a>@]"
+ (canonical literal)
+ Iri.pp (datatype literal)
diff --git a/lib/fragment_graph/rdf_fragment_graph.ml b/lib/fragment_graph/rdf_fragment_graph.ml
index 09821a2..20ba39f 100644
--- a/lib/fragment_graph/rdf_fragment_graph.ml
+++ b/lib/fragment_graph/rdf_fragment_graph.ml
@@ -5,11 +5,6 @@
* SPDX-License-Identifier: AGPL-3.0-or-later
*)
-(* TODO this implementation uses CCMultiMaps. This is not so good as CCMultiMaps
- adds duplicate values. This must be manually checked when entering statements
- (see `add_statemen_unique`). Find a better solution.
-*)
-
module type HASH = sig
(*** Signature of a hash that is used to compute identifiers. *)
@@ -17,9 +12,15 @@ module type HASH = sig
(** [hash v] returns the hash of [v] as an iri. *)
end
-module type T = sig
+module type S = sig
(** RDF Fragment Graph *)
+ (** {1 Predicate and Object} *)
+
+ (** Fragment Graphs can not reuse the {!module:Rdf.Triple.Predicate} and
+ {!module:Rdf.Triple.Object} modules as they do not allow Blank Nodes and in
+ addition to IRIs, references to fragments are allowed.*)
+
module Predicate : sig
type t =
| FragmentReference of string
@@ -54,37 +55,47 @@ module type T = sig
type t
(** Type of a Fragment Graph *)
+ (** {1 Constructors} *)
+
val empty : t
(** [empty] is the empty fragment graph *)
- val equal : t -> t -> bool
- (** [equal a b] returns true if [a] is the same Fragment Graph as [b]. *)
-
val add_statement : Predicate.t -> Object.t -> t -> t
(** [add_statement fragment_graph predicate object'] adds a statement to the fragment graph *)
val add_fragment_statement : string -> Predicate.t -> Object.t -> t -> t
(** [add_fragment_statement] adds a fragment statement to the fragment graph *)
- val statements : t -> (Predicate.t * Object.t) list
+ (** {1 Accessors} *)
+
+ val statements : t -> (Predicate.t * Object.t) Seq.t
(** [statements fragment_graph] returns a list of statements in
[fragment_graph]. *)
- val fragment_statements : t -> (string * Predicate.t * Object.t) list
+ val fragment_statements : t -> (string * Predicate.t * Object.t) Seq.t
(** [fragment_statements fragment_graph] returns a list of fragment statements
in [fragment_graph]. *)
+ val to_triples : t -> Rdf.Triple.t Seq.t
+ (** [to_triples fragment_graph] returns a list of statements in [fragment_graph] as triples. *)
+
+
+ (** {1 Content-addressing} *)
+
val base_subject : t -> Rdf.Iri.t
(** [base_subject fragment_graph] returns the base subject of the fragment graph. *)
+ val equal : t -> t -> bool
+ (** [equal a b] returns true if [a] is the same Fragment Graph as [b].
+ Equality is implemnted by checking the base subject.*)
+
val canonical : t -> string
(** [canonical fragment_graph] returns the canonical serialization of the fragment graph. *)
val of_canonical : string -> (t, string) result
(** [of_canonical s] attempts to decode the fragment graph from the canonical serialization in [s]*)
- val to_triples : t -> Rdf.Triple.t list
- (** [to_triples fragment_graph] returns a list of statements in [fragment_graph] as triples. *)
+ (** {1 (Pretty) Printing} *)
val pp : t Fmt.t
[@@ocaml.toplevel_printer]
@@ -118,11 +129,11 @@ module Make(H: HASH) = struct
iri
|> Rdf.Triple.Predicate.of_iri
- (* let pp ppf = function
- * | FragmentReference id ->
- * Fmt.pf ppf "%s" id
- * | Iri iri ->
- * Fmt.pf ppf "%a" Rdf.Iri.pp iri *)
+ let pp ppf = function
+ | FragmentReference id ->
+ Fmt.pf ppf "@[<2><f %s>@]" id
+ | Iri iri ->
+ Fmt.pf ppf "@[<4><iri %a>@]" Rdf.Iri.pp iri
end
module Object = struct
@@ -158,82 +169,84 @@ module Make(H: HASH) = struct
literal
|> Rdf.Triple.Object.of_literal
- (* let pp ppf = function
- * | FragmentReference id ->
- * Fmt.pf ppf "%s" id
- * | Iri iri ->
- * Fmt.pf ppf "%a" Rdf.Iri.pp iri
- * | Literal literal ->
- * Fmt.pf ppf "%a" Rdf.Literal.pp literal *)
+ let pp ppf = function
+ | FragmentReference id ->
+ Fmt.pf ppf "@[<2><f %s>@]" id
+ | Iri iri ->
+ Fmt.pf ppf "@[<4><iri %a>@]" Rdf.Iri.pp iri
+ | Literal lit ->
+ Fmt.pf ppf "@[<4><lit %a>@]" Rdf.Literal.pp lit
end
- module StatementMap = CCMultiMap.Make(Predicate)(Object)
- module FragmentStatementsMap = CCHashTrie.Make(struct
- type t = string
- let equal = String.equal
- let hash = Hashtbl.hash
- end)
+ module FragmentMap = Map.Make(String)
+ module PredicateMap = Map.Make(Predicate)
+ module ObjectSet = Set.Make(Object)
type t =
- { statements : StatementMap.t;
- fragment_statements : StatementMap.t FragmentStatementsMap.t
+ { statements : ObjectSet.t PredicateMap.t;
+ fragment_statements : ObjectSet.t PredicateMap.t FragmentMap.t
}
let empty =
- { statements = StatementMap.empty;
- fragment_statements = FragmentStatementsMap.empty
+ { statements = PredicateMap.empty;
+ fragment_statements = FragmentMap.empty
}
- (* Helper to return list of statements *)
- let list_of_statements statements =
- let l = ref [] in
- StatementMap.iter statements
- (fun p o -> l := (p,o) :: !l) ;
- !l
-
- (* Adds statement if it is not already present. *)
- let add_statement_unique predicate object' statements =
- let open StatementMap in
- match find statements predicate with
- | [] -> add statements predicate object'
- | objs ->
- if List.mem object' objs then
- statements
- else
- add statements predicate object'
+ let statements_signleton p o =
+ PredicateMap.add
+ p (ObjectSet.singleton o)
+ PredicateMap.empty
+
+ let statements_union a b =
+ PredicateMap.union
+ (fun _predicate objects_a objects_b ->
+ ObjectSet.union objects_a objects_b
+ |> Option.some)
+ a b
let add_statement predicate object' fragment_graph =
- {fragment_graph with
- statements =
- add_statement_unique
- predicate object'
- fragment_graph.statements
+ { fragment_graph with
+ statements = statements_signleton predicate object'
+ |> statements_union fragment_graph.statements
}
- let statements fragment_graph =
- list_of_statements fragment_graph.statements
-
- let add_fragment_statement fragment_reference predicate object' fragment_graph =
- {fragment_graph with
- fragment_statements = FragmentStatementsMap.update fragment_reference
- ~f:(function
- | Some statements ->
- Some (add_statement_unique predicate object' statements)
- | None ->
- Some (StatementMap.add StatementMap.empty
- predicate object'))
- fragment_graph.fragment_statements
+ let fragment_statements_singleton fragment predicate object' =
+ FragmentMap.add
+ fragment
+ (statements_signleton predicate object')
+ FragmentMap.empty
+
+ let fragment_statement_union a b =
+ FragmentMap.union
+ (fun _fragment statements_a statements_b ->
+ Some (statements_union statements_a statements_b)
+ )
+ a b
+
+ let add_fragment_statement fragment predicate object' fragment_graph =
+ { fragment_graph with
+ fragment_statements = fragment_statements_singleton fragment predicate object'
+ |> fragment_statement_union fragment_graph.fragment_statements
}
- let fragment_statements fragment_graph =
- FragmentStatementsMap.fold
- ~f:(fun fs fragment_id statements ->
- List.(append fs
- (list_of_statements statements
- |> map (fun (o,p) -> (fragment_id, o, p)))))
- ~x:[]
- fragment_graph.fragment_statements
+ let statements_to_seq statements =
+ PredicateMap.to_seq statements
+ |> Seq.flat_map (fun (predicate, os) ->
+ ObjectSet.to_seq os
+ |> Seq.map (fun o -> predicate,o))
+
+ let statements fg =
+ fg.statements
+ |> statements_to_seq
+
+ let fragment_statements fg =
+ fg.fragment_statements
+ |> FragmentMap.to_seq
+ |> Seq.flat_map (fun (fragment, statements) ->
+ statements_to_seq statements
+ |> Seq.map (fun (p,o) -> (fragment, p, o))
+ )
module Serialization = struct
@@ -256,35 +269,33 @@ module Make(H: HASH) = struct
(Cbor.encode a)
(Cbor.encode b)
- let cbor_of_statements fragment_graph =
- StatementMap.fold fragment_graph.statements []
- (fun acc predicate object' ->
+ let cbor_of_statements fg =
+ fg
+ |> statements
+ |> Seq.map
+ (fun (predicate, object') ->
Cbor.Array [
cbor_of_predicate predicate;
cbor_of_object object'
- ] :: acc)
+ ] )
let cbor_of_fragment_statements fragment_graph =
- let cbor_of_statements fragment_id statements =
- StatementMap.fold statements []
- (fun acc predicate object' ->
- Cbor.Array [
- Cbor.TextString fragment_id;
- cbor_of_predicate predicate;
- cbor_of_object object'
- ] :: acc)
- in
- FragmentStatementsMap.fold
- ~x:[]
- ~f:(fun acc fragment_id statements ->
- List.append (cbor_of_statements fragment_id statements) acc)
- fragment_graph.fragment_statements
-
- let cbor_of_fragment_graph fragment_graph =
- List.append
- (cbor_of_statements fragment_graph)
- (cbor_of_fragment_statements fragment_graph)
- |> List.sort compare
+ fragment_graph
+ |> fragment_statements
+ |> Seq.map (fun (f, p, o) ->
+ Cbor.Array [
+ Cbor.TextString f;
+ cbor_of_predicate p;
+ cbor_of_object o
+ ]
+ )
+
+ let cbor_of_fragment_graph fg =
+ Seq.append
+ (cbor_of_statements fg)
+ (cbor_of_fragment_statements fg)
+ |> List.of_seq
+ |> List.sort_uniq compare
|> (fun s -> Cbor.Array s)
let encode fragment_graph =
@@ -369,45 +380,53 @@ module Make(H: HASH) = struct
|> canonical
|> H.hash
- (* TODO: equality is broken as CCMultiMap cares about order of inseration.
- This equality just uses the canonicalization to test equality. Think about
- if there is better way. *)
+
+ (* Order of insertion matters so we use *)
let equal a b =
Rdf.Iri.equal
(base_subject a)
(base_subject b)
- let fold_statements base_iri subject statements acc f =
- StatementMap.fold statements acc
- (fun acc predicate object' ->
- f acc @@
- Rdf.Triple.make subject
- (Predicate.expand base_iri predicate)
- (Object.expand base_iri object'))
-
- let fold fragment_graph acc f =
- let base_iri = base_subject fragment_graph in
- let subject = base_iri
- |> Rdf.Triple.Subject.of_iri
- in
- FragmentStatementsMap.fold
- ~f:(fun acc fragment_id statements ->
- let subject = Rdf.Iri.with_fragment base_iri (Some fragment_id)
- |> Rdf.Triple.Subject.of_iri
- in
- fold_statements base_iri subject statements acc f)
- ~x:(fold_statements base_iri subject
- fragment_graph.statements
- acc f)
- fragment_graph.fragment_statements
-
-
let to_triples fragment_graph =
- fold fragment_graph []
- (fun triples triple -> triple :: triples)
+ let base_subject = base_subject fragment_graph in
+ let subject = base_subject |> Rdf.Triple.Subject.of_iri in
+ Seq.append
+ (fragment_graph
+ |> statements
+ |> Seq.map
+ (fun (p, o) ->
+ Rdf.Triple.make
+ subject
+ (Predicate.expand base_subject p)
+ (Object.expand base_subject o)))
+ (fragment_graph
+ |> fragment_statements
+ |> Seq.map
+ (fun (f,p,o) ->
+ let subject = Rdf.Iri.with_fragment base_subject (Some f)
+ |> Rdf.Triple.Subject.of_iri
+ in
+ Rdf.Triple.make
+ subject
+ (Predicate.expand base_subject p)
+ (Object.expand base_subject o)))
+
+
+ let pp_statement ppf (p,o) =
+ Fmt.pf ppf "@[<2><s %a %a>@]"
+ Predicate.pp p
+ Object.pp o
+
+ let pp_fragment_statement ppf (f,p,o) =
+ Fmt.pf ppf "@[<3><fs %s %a %a>@]"
+ f
+ Predicate.pp p
+ Object.pp o
- (* TODO nicer pp *)
let pp ppf fragment_graph =
- Fmt.pf ppf "%a" Cbor.pp
- @@ Serialization.cbor_of_fragment_graph fragment_graph
+ Fmt.pf ppf "@[<v>%a@]@[<v>%a@]"
+ Fmt.(seq pp_statement)
+ (statements fragment_graph)
+ Fmt.(seq pp_fragment_statement)
+ (fragment_statements fragment_graph)
end
diff --git a/lib/fragment_graph/rdf_fragment_graph.mli b/lib/fragment_graph/rdf_fragment_graph.mli
index 44edddd..68d8c3b 100644
--- a/lib/fragment_graph/rdf_fragment_graph.mli
+++ b/lib/fragment_graph/rdf_fragment_graph.mli
@@ -31,9 +31,15 @@ module type HASH = sig
(** [hash v] returns the hash of [v] as an iri. *)
end
-module type T = sig
+module type S = sig
(** RDF Fragment Graph *)
+ (** {1 Predicate and Object} *)
+
+ (** Fragment Graphs can not reuse the {!module:Rdf.Triple.Predicate} and
+ {!module:Rdf.Triple.Object} modules as they do not allow Blank Nodes and in
+ addition to IRIs, references to fragments are allowed.*)
+
module Predicate : sig
type t =
| FragmentReference of string
@@ -68,41 +74,52 @@ module type T = sig
type t
(** Type of a Fragment Graph *)
+ (** {1 Constructors} *)
+
val empty : t
(** [empty] is the empty fragment graph *)
- val equal : t -> t -> bool
- (** [equal a b] returns true if [a] is the same Fragment Graph as [b]. *)
-
val add_statement : Predicate.t -> Object.t -> t -> t
(** [add_statement fragment_graph predicate object'] adds a statement to the fragment graph *)
val add_fragment_statement : string -> Predicate.t -> Object.t -> t -> t
(** [add_fragment_statement] adds a fragment statement to the fragment graph *)
- val statements : t -> (Predicate.t * Object.t) list
+ (** {1 Accessors} *)
+
+ val statements : t -> (Predicate.t * Object.t) Seq.t
(** [statements fragment_graph] returns a list of statements in
[fragment_graph]. *)
- val fragment_statements : t -> (string * Predicate.t * Object.t) list
+ val fragment_statements : t -> (string * Predicate.t * Object.t) Seq.t
(** [fragment_statements fragment_graph] returns a list of fragment statements
in [fragment_graph]. *)
+ val to_triples : t -> Rdf.Triple.t Seq.t
+ (** [to_triples fragment_graph] returns a list of statements in [fragment_graph] as triples. *)
+
+
+ (** {1 Content-addressing} *)
+
val base_subject : t -> Rdf.Iri.t
(** [base_subject fragment_graph] returns the base subject of the fragment graph. *)
+ val equal : t -> t -> bool
+ (** [equal a b] returns true if [a] is the same Fragment Graph as [b].
+ Equality is implemnted by checking the base subject.*)
+
val canonical : t -> string
(** [canonical fragment_graph] returns the canonical serialization of the fragment graph. *)
val of_canonical : string -> (t, string) result
(** [of_canonical s] attempts to decode the fragment graph from the canonical serialization in [s]*)
- val to_triples : t -> Rdf.Triple.t list
- (** [to_triples fragment_graph] returns a list of statements in [fragment_graph] as triples. *)
+ (** {1 (Pretty) Printing} *)
val pp : t Fmt.t
[@@ocaml.toplevel_printer]
(** [pp ppf t] will output a debug output of the Fragment Graph [t] to the formatter [ppf] *)
end
-module Make(H: HASH) : T
+module Make(H: HASH) : S
+(** Constructor of a Fragment Graph *)
diff --git a/test/fragment_graph/main.ml b/test/fragment_graph/main.ml
index d7e0460..5a168a7 100644
--- a/test/fragment_graph/main.ml
+++ b/test/fragment_graph/main.ml
@@ -14,17 +14,15 @@ module FragmentGraph = Rdf_fragment_graph.Make(struct
module Gen = struct
let fragment_reference =
- QCheck.Gen.(string ~gen:(char_range 'a' 'z'))
-
+ QCheck.Gen.(string_size ~gen:(char_range 'a' 'z') small_nat)
+ |> QCheck.make
let predicate =
QCheck.choose
[
- QCheck.Gen.(
- fragment_reference
- >|= (fun id -> FragmentGraph.Predicate.FragmentReference id)
- )
- |> QCheck.make ;
+ fragment_reference
+ |> QCheck.map
+ FragmentGraph.Predicate.make_fragment_reference;
Rdf_gen.iri
|> QCheck.map FragmentGraph.Predicate.of_iri
@@ -33,11 +31,9 @@ module Gen = struct
let object' =
QCheck.choose
[
- QCheck.Gen.(
- fragment_reference
- >|= (fun id -> FragmentGraph.Object.FragmentReference id)
- )
- |> QCheck.make ;
+ fragment_reference
+ |> QCheck.map
+ FragmentGraph.Object.make_fragment_reference;
Rdf_gen.iri
|> QCheck.map FragmentGraph.Object.of_iri;
@@ -50,7 +46,17 @@ module Gen = struct
QCheck.pair predicate object'
let fragment_statement =
- QCheck.triple (QCheck.make fragment_reference) predicate object'
+ QCheck.triple fragment_reference predicate object'
+
+ let fragment_graph_add_statements statements fg =
+ List.fold_left (fun fg (p,o) -> FragmentGraph.add_statement p o fg)
+ fg
+ statements
+
+ let fragment_graph_add_fragment_statements fragment_statements fg =
+ List.fold_left (fun fg (f, p,o) -> FragmentGraph.add_fragment_statement f p o fg)
+ fg
+ fragment_statements
let fragment_graph =
QCheck.(
@@ -59,14 +65,12 @@ module Gen = struct
(list fragment_statement)
|> map
~rev:(fun fragment_graph ->
- (FragmentGraph.statements fragment_graph,
- FragmentGraph.fragment_statements fragment_graph))
+ (FragmentGraph.statements fragment_graph |> List.of_seq,
+ FragmentGraph.fragment_statements fragment_graph |> List.of_seq))
(fun (statements, fragment_statements) ->
- List.fold_left (fun fg (p, o) -> FragmentGraph.add_statement p o fg)
- (List.fold_left (fun fg (f, p, o) -> FragmentGraph.add_fragment_statement f p o fg)
- FragmentGraph.empty
- fragment_statements)
- statements
+ FragmentGraph.empty
+ |> fragment_graph_add_statements statements
+ |> fragment_graph_add_fragment_statements fragment_statements
)
)
end
@@ -74,7 +78,6 @@ end
let fragment_graph_testable =
Alcotest.testable FragmentGraph.pp FragmentGraph.equal
-
let ex = Rdf.Namespace.make_namespace "http://example.com/"
let equal_unit_test =
@@ -185,10 +188,64 @@ let equal_unit_test =
|> add_fragment_statement
"hi"
(Predicate.of_iri @@ ex "foo")
- (Object.of_iri @@ ex "bar2")))
+ (Object.of_iri @@ ex "bar2")));
+
+
+ check bool
+ "adding same literal twice results in equal fragment graph"
+ true
+ FragmentGraph.(equal
+ (empty
+ |> add_statement
+ (Predicate.of_iri @@ ex "prop")
+ (Object.of_literal @@ Rdf.Literal.make "hi" (ex "type")))
+ (empty
+ |> add_statement
+ (Predicate.of_iri @@ ex "prop")
+ (Object.of_literal @@ Rdf.Literal.make "hi" (ex "type"))
+ |> add_statement
+ (Predicate.of_iri @@ ex "prop")
+ (Object.of_literal @@ Rdf.Literal.make
+ (* do some transformations to make sure it is not physically equal *)
+ (String.lowercase_ascii (String.uppercase_ascii "hi"))
+ (ex "type"))))
)
+
+let shuffle lst =
+ let shuffle arr =
+ for n = Array.length arr - 1 downto 1 do
+ let k = Random.int (n + 1) in
+ let temp = arr.(n) in
+ arr.(n) <- arr.(k);
+ arr.(k) <- temp
+ done
+ in
+ let array = Array.of_list lst in
+ shuffle array;
+ Array.to_list array
+
+let equal_property_test =
+ QCheck.Test.make
+ ~name:"equality of fragment graphs when order of adding statements is shuffled"
+ (QCheck.pair
+ (QCheck.list Gen.statement)
+ (QCheck.list Gen.fragment_statement))
+ (fun (statements, fragment_statements) ->
+ let a =
+ FragmentGraph.empty
+ |> Gen.fragment_graph_add_statements statements
+ |> Gen.fragment_graph_add_fragment_statements fragment_statements
+ in
+ (* shuffle the order of insertions in b *)
+ let b =
+ FragmentGraph.empty
+ |> Gen.fragment_graph_add_statements (shuffle statements)
+ |> Gen.fragment_graph_add_fragment_statements (shuffle fragment_statements)
+ in
+ FragmentGraph.equal a b)
+
let canoncial_encode_decode_test =
QCheck.Test.make
~name:"encode/decode canonical serialization"
@@ -199,15 +256,6 @@ let canoncial_encode_decode_test =
|> FragmentGraph.of_canonical
|> Result.get_ok
) in
-
- if FragmentGraph.equal fragment_graph b then
- ()
- else
- Format.printf "NOT EQUAL: \n%a\n%a\n"
-
- FragmentGraph.pp fragment_graph
- FragmentGraph.pp b;
-
Alcotest.check fragment_graph_testable
"encoded/decoded value is same as original"
fragment_graph b ;
@@ -265,7 +313,8 @@ let canonical_unit_test =
let () =
Alcotest.run "rdf_fragment_graph" [
"equal", [
- equal_unit_test
+ equal_unit_test;
+ QCheck_alcotest.to_alcotest equal_property_test
];
"canonical serializaton", [
canonical_unit_test;
diff --git a/test/gen/rdf_gen.ml b/test/gen/rdf_gen.ml
index 741f0b0..c4d3c41 100644
--- a/test/gen/rdf_gen.ml
+++ b/test/gen/rdf_gen.ml
@@ -25,13 +25,13 @@ let iri =
let blank_node =
QCheck.Gen.(
Blank_node.of_string
- <$> oneofl ["a"])
+ <$> string_readable)
|> QCheck.make ~print:Blank_node.identifier
let literal =
QCheck.Gen.(
(fun s -> Literal.make s (Rdf.Namespace.xsd "string"))
- <$> oneofl ["b"]
+ <$> string_readable
)
|> QCheck.make ~print:Literal.canonical