aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpukkamustard <pukkamustard@posteo.net>2021-06-22 12:50:53 +0000
committerpukkamustard <pukkamustard@posteo.net>2021-06-22 12:50:53 +0000
commit784bd5dbe1ba8aa4bf59726cf03d557fcd3f389e (patch)
tree406992ac88e42d529fb68f76ae91c5e91b98755c
parent16f435ad13c2bed7deb8f056230faf6ab704fb5e (diff)
parent98456a066d114f7b02fbfb73b7ba5dd6690a94cd (diff)
Merge branch 'graph' into 'main'
Rdf.Graph and Rdf_fragment_graph.t: Reimplement using Map and Set from standard library. See merge request public.dream/dromedar/ocaml-rdf!2
-rw-r--r--guix.scm36
-rw-r--r--lib/core/dune2
-rw-r--r--lib/core/graph.ml158
-rw-r--r--lib/core/literal.ml17
-rw-r--r--lib/core/rdf.mli30
-rw-r--r--lib/fragment_graph/rdf_fragment_graph.ml390
-rw-r--r--lib/fragment_graph/rdf_fragment_graph.mli47
-rw-r--r--test/fragment_graph/main.ml183
-rw-r--r--test/gen/rdf_gen.ml4
9 files changed, 578 insertions, 289 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/graph.ml b/lib/core/graph.ml
index b097af1..b5ad5fc 100644
--- a/lib/core/graph.ml
+++ b/lib/core/graph.ml
@@ -1,63 +1,123 @@
-(* This is a simple functional RDF graph structure.
+(* This is a simple functional RDF graph structure using `Map`s and `Set`s.
- It uses CCMultiMap with keys of type Triple.Subject.t and values of type
- (Triple.Predicate.t * Triple.Object.t).
-
- This allows efficient quering in the order subject -> predicate -> object.But
- not in any other.
-
- This can be improved.
+ This allows efficient quering in the order subject -> predicate -> object.
+ But not in any other.This can be improved.
*)
-module OrderedSubject = struct
- type t = Triple.Subject.t
-
- let compare a b =
- Term.compare
- (Triple.Subject.to_term a)
- (Triple.Subject.to_term b)
-end
-
-module OrderedPredicateObject = struct
- type t = Triple.Predicate.t * Triple.Object.t
+module TermMap = Map.Make(Term)
+module TermSet = Set.Make(Term)
- let compare (a_p,a_o) (b_p,b_o) =
- let p_compared = Term.compare
- (Triple.Predicate.to_term a_p)
- (Triple.Predicate.to_term b_p) in
- if p_compared = 0 then
- Term.compare
- (Triple.Predicate.to_term a_o)
- (Triple.Predicate.to_term b_o)
- else
- p_compared
-end
+type t = (TermSet.t TermMap.t) TermMap.t
-module GraphMap = CCMultiMap.Make(OrderedSubject)(OrderedPredicateObject)
+let empty = TermMap.empty
-type t = GraphMap.t
+let singleton (triple:Triple.t) =
+ let s = triple.subject |> Triple.Subject.to_term in
+ let p = triple.predicate |> Triple.Predicate.to_term in
+ let o = triple.object' |> Triple.Object.to_term in
+ TermMap.add s
+ (TermMap.add p (TermSet.singleton o) empty)
+ empty
-let empty = GraphMap.empty
+let union a b =
+ TermMap.union
+ (fun _subject left right ->
+ Some (TermMap.union
+ (fun _predicate left right ->
+ Some (TermSet.union left right))
+ left right))
+ a b
let add graph (triple:Triple.t) =
- GraphMap.add graph triple.subject (triple.predicate, triple.object')
+ triple
+ |> singleton
+ |> union graph
let add_seq graph triples =
Seq.fold_left add graph triples
-let remove_triple graph (triple:Triple.t) =
- GraphMap.remove graph triple.subject (triple.predicate, triple.object')
-
-let union = GraphMap.union
-
-let difference = GraphMap.diff
-
-let intersection = GraphMap.inter
-
-let member_subject =
- GraphMap.mem
+(* Remove object [o] from set of objects [os] but return None if resulting set is empty. *)
+let remove_o o os =
+ let os_removed = TermSet.remove o os in
+ if TermSet.is_empty os_removed then
+ None
+ else
+ Some os_removed
+
+(* Remove object [o] from predicate-objects map [pos]. If resulting map is empty return None. *)
+let remove_p p o pos =
+ let pos_removed =
+ TermMap.update p
+ (fun os_opt -> Option.bind os_opt (remove_o o))
+ pos
+ in
+ if TermMap.is_empty pos_removed then
+ None
+ else
+ Some pos_removed
+
+let remove graph (triple:Triple.t) =
+ let s = triple.subject |> Triple.Subject.to_term in
+ let p = triple.predicate |> Triple.Predicate.to_term in
+ let o = triple.object' |> Triple.Object.to_term in
+ TermMap.update s
+ (fun pos_opt -> Option.bind pos_opt (remove_p p o))
+ graph
+
+let subjects graph =
+ TermMap.to_seq graph
+ |> Seq.map (fun (s, _pos) -> s)
+
+(* Helpers to cast to Triple positional terms *)
+
+let _to_subject s =
+ Term.map s
+ Triple.Subject.of_iri
+ Triple.Subject.of_blank_node
+ (fun _ -> failwith "unexpected literal in subject position")
+
+let _to_predicate p =
+ Term.map p
+ Triple.Predicate.of_iri
+ (fun _ -> failwith "unexpected blank node in predicate position")
+ (fun _ -> failwith "unexpected literal in predicate position")
+
+let _to_object s =
+ Term.map s
+ Triple.Object.of_iri
+ Triple.Object.of_blank_node
+ Triple.Object.of_literal
+
+(* create a stream of triples from a stream of object-sets *)
+let _os_seq_to_triples s =
+ Seq.flat_map (fun (p, os) ->
+ TermSet.to_seq os
+ |> Seq.map (fun o ->
+ Triple.make
+ (_to_subject s)
+ (_to_predicate p)
+ (_to_object o)))
+
+(* Helper to create a stream of triples from a stream of predicate-object-set
+ maps *)
+let _pos_seq_to_triples =
+ Seq.flat_map (fun (s, pos) ->
+ TermMap.to_seq pos
+ |> _os_seq_to_triples s
+ )
+
+let to_triples graph =
+ TermMap.to_seq graph
+ |> _pos_seq_to_triples
+
+let to_triples_s graph subject =
+ TermMap.to_seq_from subject graph
+ |> _pos_seq_to_triples
+
+let to_triples_sp graph subject predicate =
+ match TermMap.find_opt subject graph with
+ | None -> Seq.empty
+ | Some pos ->
+ TermMap.to_seq_from predicate pos
+ |> _os_seq_to_triples subject
-let to_list graph =
- GraphMap.fold graph []
- (fun triples subject (predicate, object') ->
- Triple.make subject predicate object' :: triples)
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/core/rdf.mli b/lib/core/rdf.mli
index 90983fe..4ec8f21 100644
--- a/lib/core/rdf.mli
+++ b/lib/core/rdf.mli
@@ -227,6 +227,12 @@ module Graph : sig
val empty : t
(** [empty] is the empty graph. *)
+ val singleton : Triple.t -> t
+ (** [singleton triple] returns a graph containg only [triple]. *)
+
+ val union : t -> t -> t
+ (** [union a b] returns the union of the graphs. *)
+
val add : t -> Triple.t -> t
(** [add graph triple] returns a new graph containing [triple] (and everything in [graph]).*)
@@ -234,22 +240,20 @@ module Graph : sig
(** [add_seq graph triples] returns a new graph containing all triples in the
sequence [triples]. *)
- val remove_triple : t -> Triple.t -> t
+ val remove: t -> Triple.t -> t
(** [remove_triple graph triple] removes [triple] from [graph]. *)
- val union : t -> t -> t
- (** [union a b] returns the union of the graphs. *)
-
- val difference : t -> t -> t
- (** [difference a b] returns the difference of the graphs. *)
+ val subjects : t -> Term.t Seq.t
+ (** [subjects graph] returns a sequence of subjects that appear in the graph. *)
- val intersection : t -> t -> t
- (** [intersection a b] returns the intersection of the graphs. *)
+ val to_triples: t -> Triple.t Seq.t
+ (** [to_triples graph] returns a sequence of triples in [graph].*)
- val member_subject : t -> Triple.Subject.t -> bool
- (** [member_subject graph subject] returns true if [subject] appears in
- [graph].*)
+ val to_triples_s : t -> Term.t -> Triple.t Seq.t
+ (** [to_seq_s graph subject] returns a sequence of triples in [graph] with
+ [subject] in subject position.*)
- val to_list: t -> Triple.t list
- (** [to_list graph] returns a sequence of triples in [graph].*)
+ val to_triples_sp : t -> Term.t -> Term.t -> Triple.t Seq.t
+ (** [to_seq_sp graph subject predicate] returns a sequence of triples in [graph] with
+ [subject] in subject position and [predicate] in predicate position.*)
end
diff --git a/lib/fragment_graph/rdf_fragment_graph.ml b/lib/fragment_graph/rdf_fragment_graph.ml
index 09821a2..bc2d99e 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,21 +12,30 @@ 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
| 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
@@ -41,7 +45,7 @@ module type T = 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
@@ -49,42 +53,59 @@ module type T = 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
(** 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
+ 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
(** [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]
@@ -93,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
@@ -118,11 +153,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
@@ -131,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
@@ -158,82 +202,144 @@ 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
+
+ (* 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) ->
+ 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 +362,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 +473,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..77dadbf 100644
--- a/lib/fragment_graph/rdf_fragment_graph.mli
+++ b/lib/fragment_graph/rdf_fragment_graph.mli
@@ -31,21 +31,29 @@ 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
| 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
@@ -55,7 +63,7 @@ module type T = 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
@@ -63,46 +71,63 @@ module type T = 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
(** 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
+ 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
(** [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..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)
@@ -14,17 +16,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 +33,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 +48,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 +67,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,9 +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"
@@ -185,10 +256,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 +324,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 ;
@@ -264,8 +380,13 @@ let canonical_unit_test =
let () =
Alcotest.run "rdf_fragment_graph" [
+ "constructors", [
+ predicate_of_iri_test;
+ of_triples_test
+ ];
"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