aboutsummaryrefslogtreecommitdiff
path: root/lib/core/graph.ml
blob: b5ad5fcdfca468bace6434267c4e1aeb94a80011 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
(* This is a simple functional RDF graph structure using `Map`s and `Set`s.

   This allows efficient quering in the order subject -> predicate -> object.
   But not in any other.This can be improved.
*)

module TermMap = Map.Make(Term)
module TermSet = Set.Make(Term)

type t = (TermSet.t TermMap.t) TermMap.t

let empty = TermMap.empty

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 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) =
  triple
  |> singleton
  |> union graph

let add_seq graph triples =
  Seq.fold_left add graph triples

(* 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