aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpukkamustard <pukkamustard@posteo.net>2021-06-22 12:19:31 +0200
committerpukkamustard <pukkamustard@posteo.net>2021-06-22 12:19:31 +0200
commit98456a066d114f7b02fbfb73b7ba5dd6690a94cd (patch)
tree406992ac88e42d529fb68f76ae91c5e91b98755c
parent67797a14aaf932c7ff6503d062447d8b59e4446e (diff)
Rdf_fragment_graph: Add of_triples function.
This is especially useful for converting RDF into content-addressable RDF.
-rw-r--r--lib/fragment_graph/rdf_fragment_graph.ml101
-rw-r--r--lib/fragment_graph/rdf_fragment_graph.mli14
-rw-r--r--test/fragment_graph/main.ml72
3 files changed, 180 insertions, 7 deletions
diff --git a/lib/fragment_graph/rdf_fragment_graph.ml b/lib/fragment_graph/rdf_fragment_graph.ml
index 20ba39f..bc2d99e 100644
--- a/lib/fragment_graph/rdf_fragment_graph.ml
+++ b/lib/fragment_graph/rdf_fragment_graph.ml
@@ -27,12 +27,15 @@ module type S = sig
| Iri of Rdf.Iri.t
(** Predicate that can appear in a Fragment Graph *)
- val of_iri : Rdf.Iri.t -> t
+ val of_iri : ?base_subject:Rdf.Iri.t -> Rdf.Iri.t -> t
(** [of_iri iri] creates an Iri predicate *)
val make_fragment_reference : string -> t
(** [make_fragment_reference fragment] creates a reference to [fragment] *)
+ val pp : t Fmt.t
+ [@@ocaml.toplevel_printer]
+
end
module Object : sig
@@ -42,7 +45,7 @@ module type S = sig
| Literal of Rdf.Literal.t
(** Object that can appear in a Fragment Graph *)
- val of_iri : Rdf.Iri.t -> t
+ val of_iri : ?base_subject:Rdf.Iri.t -> Rdf.Iri.t -> t
(** [of_iri iri] creates an iri object *)
val of_literal : Rdf.Literal.t -> t
@@ -50,6 +53,9 @@ module type S = sig
val make_fragment_reference : string -> t
(** [make_fragment_reference fragment] creates a reference to [fragment] *)
+
+ val pp : t Fmt.t
+ [@@ocaml.toplevel_printer]
end
type t
@@ -66,6 +72,10 @@ module type S = sig
val add_fragment_statement : string -> Predicate.t -> Object.t -> t -> t
(** [add_fragment_statement] adds a fragment statement to the fragment graph *)
+ val of_triples : Rdf.Triple.t Seq.t -> (Rdf.Iri.t * t) Seq.t
+ (** [of_triples triples] returns a sequence of fragment graphs for each base
+ subject appearing in [triples]. *)
+
(** {1 Accessors} *)
val statements : t -> (Predicate.t * Object.t) Seq.t
@@ -104,12 +114,26 @@ end
module Make(H: HASH) = struct
+
+ (* Helper to get the base subject of an IRI *)
+ let get_base_subject iri =
+ Rdf.Iri.with_fragment iri None
+
module Predicate = struct
type t =
| FragmentReference of string
| Iri of Rdf.Iri.t
- let of_iri iri = Iri iri
+ let of_iri ?base_subject iri =
+ match base_subject with
+ | None -> Iri iri
+ | Some base_subject ->
+ if Rdf.Iri.equal base_subject (get_base_subject iri) then
+ Rdf.Iri.fragment iri
+ |> Option.value ~default:""
+ |> (fun f -> FragmentReference f)
+ else
+ Iri iri
let make_fragment_reference id =
FragmentReference id
@@ -142,7 +166,16 @@ module Make(H: HASH) = struct
| Iri of Rdf.Iri.t
| Literal of Rdf.Literal.t
- let of_iri iri = Iri iri
+ let of_iri ?base_subject iri =
+ match base_subject with
+ | None -> Iri iri
+ | Some base_subject ->
+ if Rdf.Iri.equal base_subject (get_base_subject iri) then
+ Rdf.Iri.fragment iri
+ |> Option.value ~default:""
+ |> (fun f -> FragmentReference f)
+ else
+ Iri iri
let of_literal literal = Literal literal
@@ -230,6 +263,66 @@ module Make(H: HASH) = struct
|> fragment_statement_union fragment_graph.fragment_statements
}
+
+ (* Constructor from triples *)
+
+ module IriMap = Map.Make(Rdf.Iri)
+
+ let of_triples triples=
+ triples
+ |> Seq.fold_left
+ (fun fgs (triple:Rdf.Triple.t) ->
+
+ (* extract the subject as IRI *)
+ let subject_iri =
+ Rdf.Triple.Subject.map triple.subject
+ (fun iri -> iri)
+ (fun _bnode -> failwith "Blank Nodes are not allowed in Fragment Graphs.")
+ in
+
+ (* compute the base subject *)
+ let base_subject = get_base_subject subject_iri in
+
+ (* extract Predicate as Predicate *)
+ let predicate =
+ Rdf.Triple.Predicate.map triple.predicate
+ (fun iri -> Predicate.of_iri ~base_subject iri)
+ in
+
+ (* extract object as Object *)
+ let object' =
+ Rdf.Triple.Object.map triple.object'
+ (fun iri -> Object.of_iri ~base_subject iri)
+ (fun _bnode -> failwith "Blank Nodes are not allowed in Fragment Graphs.")
+ Object.of_literal
+ in
+
+
+ match Rdf.Iri.fragment subject_iri with
+
+ (* subject is not a fragment -> add triple as statement *)
+ | None ->
+ IriMap.update base_subject
+ (fun fg_opt ->
+ fg_opt
+ |> Option.value ~default:empty
+ |> add_statement predicate object'
+ |> Option.some)
+ fgs
+
+ (* subject is a fragment of base_subject -> add as fragment statement *)
+ | Some fragment_id ->
+ IriMap.update base_subject
+ (fun fg_opt ->
+ fg_opt
+ |> Option.value ~default:empty
+ |> add_fragment_statement fragment_id predicate object'
+ |> Option.some)
+ fgs
+ )
+ IriMap.empty
+ |> IriMap.to_seq
+
let statements_to_seq statements =
PredicateMap.to_seq statements
|> Seq.flat_map (fun (predicate, os) ->
diff --git a/lib/fragment_graph/rdf_fragment_graph.mli b/lib/fragment_graph/rdf_fragment_graph.mli
index 68d8c3b..77dadbf 100644
--- a/lib/fragment_graph/rdf_fragment_graph.mli
+++ b/lib/fragment_graph/rdf_fragment_graph.mli
@@ -46,12 +46,14 @@ module type S = sig
| Iri of Rdf.Iri.t
(** Predicate that can appear in a Fragment Graph *)
- val of_iri : Rdf.Iri.t -> t
+ val of_iri : ?base_subject:Rdf.Iri.t -> Rdf.Iri.t -> t
(** [of_iri iri] creates an Iri predicate *)
val make_fragment_reference : string -> t
(** [make_fragment_reference fragment] creates a reference to [fragment] *)
+ val pp : t Fmt.t
+ [@@ocaml.toplevel_printer]
end
module Object : sig
@@ -61,7 +63,7 @@ module type S = sig
| Literal of Rdf.Literal.t
(** Object that can appear in a Fragment Graph *)
- val of_iri : Rdf.Iri.t -> t
+ val of_iri : ?base_subject:Rdf.Iri.t -> Rdf.Iri.t -> t
(** [of_iri iri] creates an iri object *)
val of_literal : Rdf.Literal.t -> t
@@ -69,6 +71,9 @@ module type S = sig
val make_fragment_reference : string -> t
(** [make_fragment_reference fragment] creates a reference to [fragment] *)
+
+ val pp : t Fmt.t
+ [@@ocaml.toplevel_printer]
end
type t
@@ -85,6 +90,10 @@ module type S = sig
val add_fragment_statement : string -> Predicate.t -> Object.t -> t -> t
(** [add_fragment_statement] adds a fragment statement to the fragment graph *)
+ val of_triples : Rdf.Triple.t Seq.t -> (Rdf.Iri.t * t) Seq.t
+ (** [of_triples triples] returns a sequence of fragment graphs for each base
+ subject appearing in [triples]. *)
+
(** {1 Accessors} *)
val statements : t -> (Predicate.t * Object.t) Seq.t
@@ -98,7 +107,6 @@ module type S = sig
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
diff --git a/test/fragment_graph/main.ml b/test/fragment_graph/main.ml
index 5a168a7..6cffc2b 100644
--- a/test/fragment_graph/main.ml
+++ b/test/fragment_graph/main.ml
@@ -5,6 +5,8 @@
* SPDX-License-Identifier: AGPL-3.0-or-later
*)
+(* TODO these tests have grown into a mess. needs some cleaning up. *)
+
module FragmentGraph = Rdf_fragment_graph.Make(struct
let hash s =
"urn:dummy_hash:" ^ (string_of_int @@ Hashtbl.hash s)
@@ -78,8 +80,74 @@ end
let fragment_graph_testable =
Alcotest.testable FragmentGraph.pp FragmentGraph.equal
+let predicate_testable =
+ Alcotest.testable FragmentGraph.Predicate.pp (=)
+
let ex = Rdf.Namespace.make_namespace "http://example.com/"
+let predicate_of_iri_test =
+ let open Alcotest in
+ test_case "Predicate.of_iri"
+ `Quick
+ (fun () ->
+ check predicate_testable
+ "no base_subject returns the iri"
+ (FragmentGraph.Predicate.of_iri @@ ex "hello")
+ (FragmentGraph.Predicate.of_iri @@ ex "hello");
+
+ check predicate_testable
+ "with base_subject return a fragment identifier"
+ (FragmentGraph.Predicate.make_fragment_reference "hello")
+ (FragmentGraph.Predicate.of_iri
+ ~base_subject:(Rdf.Iri.of_string "http://example.com/")
+ @@ ex "hello");
+
+ Format.printf "%a\n"
+ Rdf.Iri.pp (Rdf.Iri.with_fragment (ex "hi") (Some "blup")))
+
+let of_triples_test =
+ let open Alcotest in
+ test_case "of_triples"
+ `Quick
+ (fun () ->
+ let fg_direct =
+ FragmentGraph.(empty
+ |> add_statement
+ (Predicate.make_fragment_reference "prop")
+ (Object.make_fragment_reference "something")
+ |> add_fragment_statement "hi"
+ (Predicate.of_iri @@ Rdf.Iri.of_string "urn:example:foo")
+ (Object.of_literal @@ Rdf.Literal.make "blups" (ex "type")))
+ in
+
+ let fg_of_triples =
+ [
+ Rdf.Triple.(make
+ (Subject.of_iri @@ Rdf.Iri.of_string "http://example.com/")
+ (Predicate.of_iri @@ ex "prop")
+ (Object.of_iri @@ ex "something"));
+
+ Rdf.Triple.(make
+ (Subject.of_iri @@ Rdf.Iri.of_string "http://example.com/#hi")
+ (Predicate.of_iri @@ Rdf.Iri.of_string "urn:example:foo")
+ (* TODO! an intersting case I had not thought about.
+ What if the literal datatype makes a reference to the
+ base_subject? *)
+ (Object.of_literal @@ Rdf.Literal.make "blups" (ex "type")))
+ ]
+ |> List.to_seq
+ |> FragmentGraph.of_triples
+ |> List.of_seq
+ |> List.hd
+ |> (fun (_,fg) -> fg)
+
+ in
+
+ check fragment_graph_testable
+ "of_triples and directly creating is equal"
+ fg_direct
+ fg_of_triples)
+
let equal_unit_test =
let open Alcotest in
test_case "unit tests"
@@ -312,6 +380,10 @@ let canonical_unit_test =
let () =
Alcotest.run "rdf_fragment_graph" [
+ "constructors", [
+ predicate_of_iri_test;
+ of_triples_test
+ ];
"equal", [
equal_unit_test;
QCheck_alcotest.to_alcotest equal_property_test