Rdf.Term: Fix compare.

compare was not correctly implemented which was breaking equality checks
in Map and Set (used in Graph).

7 files changed, 174 insertions, 8 deletions

diff --git a/lib/core/blank_node.ml b/lib/core/blank_node.ml
index 31e7735..0e1c7b1 100644
--- a/lib/core/blank_node.ml
+++ b/lib/core/blank_node.ml
@@ -16,5 +16,10 @@ let equal a b =
     (identifier a)
     (identifier b)
 
+let compare a b =
+  String.compare
+    (identifier a)
+    (identifier b)
+
 let pp ppf bnode =
   Fmt.pf ppf "@[<h 1><blank_node@ %s>@]" (identifier bnode)
diff --git a/lib/core/graph.ml b/lib/core/graph.ml
index 5d98842..32bf790 100644
--- a/lib/core/graph.ml
+++ b/lib/core/graph.ml
@@ -125,3 +125,7 @@ let to_triples_sp subject predicate graph =
     TermMap.to_seq_from predicate pos
     |> _os_seq_to_triples subject
 
+let pp ppf graph =
+  Fmt.pf ppf "%a"
+    (Fmt.seq Triple.pp)
+    (to_triples graph)
diff --git a/lib/core/rdf.mli b/lib/core/rdf.mli
index 90a3f5d..fa2d2f8 100644
--- a/lib/core/rdf.mli
+++ b/lib/core/rdf.mli
@@ -22,6 +22,10 @@ module Blank_node : sig
   val equal : t -> t -> bool
   (** [equal a b] returns true if [a] and [b] identify the same blank node. *)
 
+  val compare : t -> t -> int
+  (** [compare a b] compares two blank nodes by using the lexicographical sorting
+      of the string identifiers. *)
+
   val pp : t Fmt.t
   [@@ocaml.toplevel_printer]
   (**  [pp ppf t] will output a human readable version of the Blank_node [t] to the formatter [ppf] *)
@@ -260,4 +264,9 @@ module Graph : sig
   val to_triples_sp : Term.t -> Term.t -> t -> Triple.t Seq.t
   (** [to_seq_sp subject predicate graph] returns a sequence of triples in [graph] with
       [subject] in subject position and [predicate] in predicate position.*)
+
+  val pp : t Fmt.t
+  [@@ocaml.toplevel_printer]
+  (**  [pp ppf t] will output a human readable version of the Graph [t] to
+       the formatter [ppf] *)
 end
diff --git a/lib/core/term.ml b/lib/core/term.ml
index 003a2c3..25a1fc0 100644
--- a/lib/core/term.ml
+++ b/lib/core/term.ml
@@ -54,13 +54,21 @@ let compare a b =
   match (a,b) with
   | (Iri a, Iri b) ->
     Iri.compare a b
+
   | (Blank_node a, Blank_node b) ->
-    String.compare (Blank_node.identifier a) (Blank_node.identifier b)
+    Blank_node.compare a b
+
   | (Literal a, Literal b) ->
     Literal.compare a b
-  | (Blank_node _, _)  -> -1
-  | (Literal _, _) -> -1
-  | (Iri _, _) -> 1
+
+  | (Iri _, _) -> -1
+
+  | (_, Iri _) -> 1
+
+  | (Blank_node _, Literal _)  -> -1
+
+  | (Literal _, Blank_node _) -> 1
+
 
 let pp_iri ppf iri =
   Fmt.pf ppf "@[<4><iri@ %a>@]" Iri.pp iri
diff --git a/lib/core/triple.ml b/lib/core/triple.ml
index 62fba58..9148c6d 100644
--- a/lib/core/triple.ml
+++ b/lib/core/triple.ml
@@ -85,7 +85,7 @@ let equal {subject = s1; predicate = p1; object' = o1} {subject = s2; predicate
 
 let pp ppf triple =
   Fmt.pf ppf
-    "@[<8><triple@ %a@ %a@ %a>@]"
+    "@[<8><triple@ %a@ %a@ %a>@]@."
     Term.pp triple.subject
     Term.pp triple.predicate
     Term.pp triple.object'
diff --git a/test/core/main.ml b/test/core/main.ml
index 0bf439c..cee23ad 100644
--- a/test/core/main.ml
+++ b/test/core/main.ml
@@ -9,6 +9,45 @@
 let ex = Rdf.Namespace.make_namespace "http://example.com/"
 let ex2 = Rdf.Namespace.make_namespace "http://example2.com/"
 
+module TermTest = struct
+  let compare_unit_test =
+    let open Alcotest in
+    test_case "Rdf.Term.compare"
+      `Quick
+      (fun () ->
+         check int "lu" 1
+           Rdf.Term.(
+             compare
+               (of_literal @@ Rdf.Literal.make "hi"
+                  (Rdf.Namespace.xsd "string"))
+               (of_blank_node @@ Rdf.Blank_node.of_string "hi")))
+
+  let compare_bnode_literal_property_test =
+    QCheck.Test.make
+      ~name:"order between blank nodes and literals"
+      (QCheck.pair Rdf_gen.blank_node Rdf_gen.literal)
+      (fun (bnode, literal) ->
+         Alcotest.check Alcotest.int
+           "compare bnode to literal is always -1"
+           (-1)
+           Rdf.Term.(compare
+                       (of_blank_node bnode)
+                       (of_literal literal));
+         Alcotest.check Alcotest.int
+           "compare bnode to literal is always 1"
+           (1)
+           Rdf.Term.(compare
+                       (of_literal literal)
+                       (of_blank_node bnode));
+         true
+      )
+
+
+  let test_cases = [compare_unit_test;
+                    QCheck_alcotest.to_alcotest compare_bnode_literal_property_test
+                   ]
+end
+
 module GraphTest = struct
 
   let equal_unit_test =
@@ -31,6 +70,20 @@ module GraphTest = struct
                                                     (Predicate.of_iri @@ ex "prop")
                                                     (Object.of_iri @@ ex "bar"))));
 
+         check bool
+           "graph with one element removed is equal to empty graph"
+           true
+           Rdf.Graph.(equal empty
+                        (empty
+                         |> add Rdf.Triple.(make
+                                              (Subject.of_iri @@ ex "foo")
+                                              (Predicate.of_iri @@ ex "prop")
+                                              (Object.of_iri @@ ex "bar"))
+                         |> remove Rdf.Triple.(make
+                                                 (Subject.of_iri @@ ex "foo")
+                                                 (Predicate.of_iri @@ ex "prop")
+                                                 (Object.of_iri @@ ex "bar"))));
+
 
          check bool
            "graph with one element is equal"
@@ -48,6 +101,26 @@ module GraphTest = struct
                                               (Object.of_iri @@ ex "bar"))));
 
          check bool
+           "graph with same literal is equal"
+           true
+           Rdf.Graph.(equal
+                        (empty
+                         |> add Rdf.Triple.(make
+                                              (Subject.of_iri @@ ex "foo")
+                                              (Predicate.of_iri @@ ex "prop")
+                                              (Object.of_literal @@
+                                               Rdf.Literal.make "hello"
+                                                 (Rdf.Namespace.xsd "string"))))
+                        (empty
+                         |> add Rdf.Triple.(make
+                                              (Subject.of_iri @@ ex "foo")
+                                              (Predicate.of_iri @@ ex "prop")
+                                              (Object.of_literal @@
+                                               (* Try and force physical inequality *)
+                                               Rdf.Literal.make ("h" ^ "ello")
+                                                 (Rdf.Namespace.xsd "string")))));
+
+         check bool
            "graph with two different elements is not equal"
            false
            Rdf.Graph.(equal
@@ -62,12 +135,76 @@ module GraphTest = struct
                                               (Predicate.of_iri @@ ex "prop")
                                               (Object.of_iri @@ ex "bar"))));
 
-      )
+         check bool
+           "graph with blank node and literal added in different order is equal"
+           true
+           Rdf.Graph.(equal
+                        (empty
+                         |> add Rdf.Triple.(make
+                                              (Subject.of_iri @@ ex "foo")
+                                              (Predicate.of_iri @@ ex "prop")
+                                              (Object.of_blank_node @@
+                                               Rdf.Blank_node.of_string "b0"))
+                         |> add Rdf.Triple.(make
+                                              (Subject.of_iri @@ ex "foo")
+                                              (Predicate.of_iri @@ ex "prop")
+                                              (Object.of_literal @@
+                                               Rdf.Literal.make "hi"
+                                                 (Rdf.Namespace.xsd "string")))
+                        )
+                        (empty
+                         |> add Rdf.Triple.(make
+                                              (Subject.of_iri @@ ex "foo")
+                                              (Predicate.of_iri @@ ex "prop")
+                                              (Object.of_literal @@
+                                               Rdf.Literal.make "hi"
+                                                 (Rdf.Namespace.xsd "string")))
+                         |> add Rdf.Triple.(make
+                                              (Subject.of_iri @@ ex "foo")
+                                              (Predicate.of_iri @@ ex "prop")
+                                              (Object.of_blank_node @@
+                                               Rdf.Blank_node.of_string "b0"))));)
+
+
+
+
+  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 graph_testable =
+    Alcotest.testable Rdf.Graph.pp Rdf.Graph.equal
+
+  let property_based_equality_test =
+    QCheck.Test.make
+      ~name:"property based equality of graphs"
+      Rdf_gen.triples
+      (fun triples ->
+         let a = Rdf.Graph.(empty
+                            |> add_seq (List.to_seq triples)) in
+         let b = Rdf.Graph.(empty
+                            |> add_seq (List.to_seq @@ shuffle triples)) in
+         Alcotest.check graph_testable
+           "shuffling order of triples does not change graph"
+           a b;
+         true)
 
-  let testcases = [equal_unit_test]
+  let test_cases = [equal_unit_test;
+                    QCheck_alcotest.to_alcotest property_based_equality_test
+                   ]
 end
 
 let () =
   Alcotest.run "rdf" [
-    "Rdf.Graph", GraphTest.testcases
+    "Rdf.Term", TermTest.test_cases;
+    "Rdf.Graph", GraphTest.test_cases;
   ]
diff --git a/test/gen/rdf_gen.ml b/test/gen/rdf_gen.ml
index c4d3c41..bcf5b5e 100644
--- a/test/gen/rdf_gen.ml
+++ b/test/gen/rdf_gen.ml
@@ -68,6 +68,9 @@ let triple =
     object'
   |> QCheck.map (fun(s,p,o) -> Triple.make s p o)
 
+let triples =
+  QCheck.list triple
+
 let rdf =
   QCheck.string
   |> QCheck.map(Namespace.rdf)