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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
(** *)
open Term;;
module Irimap = Iri.Map
module SSet = Types.SSet;;
let apply_namespaces namespaces iri =
let len_iri = String.length iri in
let rec iter = function
[] -> ("",iri)
| (pref,ns) :: q ->
let len = String.length ns in
if len <= len_iri && String.sub iri 0 len = ns then
(pref, String.sub iri len (len_iri - len))
else
iter q
in
iter namespaces
;;
let build_namespaces ?(namespaces=[]) g =
let l = (g.Graph.namespaces ()) @ namespaces in
let f (map, set) (iri, pref) =
try
ignore(Irimap.find iri map);
(map, set)
with Not_found ->
if SSet.mem pref set then
failwith (Printf.sprintf "%S is already the prefix of another namespace." pref)
else
(
let map = Irimap.add iri pref map in
let set = SSet.add pref set in
(map, set)
)
in
let (map, _) = List.fold_left f (Irimap.empty, SSet.empty) l in
Irimap.fold (fun iri s acc -> (s, Iri.to_string iri) :: acc) map []
;;
let string_of_literal lit =
let s =
(lit.lit_value) ^
(match lit.lit_language with
None -> ""
| Some l -> "@" ^ l
) ^
(match lit.lit_type with
None -> ""
| Some t -> "^^<" ^ (Iri.to_string t) ^ ">"
)
in
Printf.sprintf "\"%s\"" (Utf8.utf8_backslash_quotes s)
let dot_of_graph ?namespaces ?href ?iri g =
let namespaces = build_namespaces ?namespaces g in
let b = Buffer.create 256 in
Buffer.add_string b "digraph g {\nrankdir=LR;\nfontsize=10;\n";
let triples =
match iri with
None -> g.Graph.find ()
| Some iri ->
let node = Term.Iri iri in
let to_iri = g.Graph.find ~sub: node () in
let from_iri = g.Graph.find ~obj: node () in
to_iri @ from_iri
in
let label node =
match node with
Iri iri ->
let iri = Iri.to_string iri in
let (pref,s) = apply_namespaces namespaces iri in
let s =
begin
match pref with
"" -> s
| _ -> pref ^ ":" ^ s
end
in
Printf.sprintf "%S" s
| Literal lit -> string_of_literal lit
| Blank_ _ | Blank -> "\"\""
in
let id node =
let s =
match node with
Iri iri -> Iri.to_string iri
| Blank_ id -> "b"^(string_of_blank_id id)
| Literal lit ->
lit.lit_value
^ "^" ^ (match lit.lit_language with None -> "" | Some s -> s)
^ "@" ^ (match lit.lit_type with None -> "" | Some iri -> Iri.to_string iri)
| Blank -> assert false
in
"N" ^ (Digest.to_hex (Digest.string s))
in
let f set (sub, pred, obj) =
Printf.bprintf b "%s -> %s [label=%s];\n" (id sub) (id obj) (label (Iri pred));
Term.TSet.add sub (Term.TSet.add obj set)
in
let set = List.fold_left f Term.TSet.empty triples in
let f_node node =
Printf.bprintf b "%s [ label=%s %s];\n" (id node) (label node)
(match href with
None -> ""
| Some f ->
match f node with
None -> ""
| Some s -> ", href=\""^s^"\""
)
in
Term.TSet.iter f_node set;
Buffer.add_string b "}\n";
Buffer.contents b
;;
let dot_of_iri ?namespaces ?href g iri = dot_of_graph ?namespaces ?href ~iri g;;
let dot_of_graph ?namespaces ?href g = dot_of_graph ?namespaces ?href g;;