aboutsummaryrefslogtreecommitdiff
path: root/lib/turtle/ast.ml
blob: c9a4fe360285367caef02df929fc923cf9ced33a (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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
(*
* SPDX-FileCopyrightText: 2021 alleycat <info@alleycat.cc>
* SPDX-FileCopyrightText: 2021 petites singularités <ps-dream@lesoiseaux.io>
* SPDX-FileCopyrightText: 2021 pukkamustard <pukkamustard@posteo.net>
*
* SPDX-License-Identifier: AGPL-3.0-or-later
*)

(* From ocaml 4.12. Move to util functions or something? *)
let rec list_equal eq l1 l2 =
  match l1, l2 with
  | [], [] -> true
  | [], _::_ | _::_, [] -> false
  | a1::l1, a2::l2 -> eq a1 a2 && list_equal eq l1 l2

module Ordered_string = struct

  type t = string

  let compare = String.compare

end

module SMap = Map.Make (Ordered_string)

let _empty_map = SMap.empty

module Iriref = struct

  type t = string

  let of_string s = s

  let to_string s = s

  let equal a b =
    String.equal
      (to_string a)
      (to_string b)

  let pp ppf iriref =
    Fmt.pf ppf "@[<hov 1><%s>@]" (to_string iriref)

end

module Language = struct

  type t = string

  let of_string s = s

  let to_string s = s

  let equal a b =
    String.equal
      (to_string a)
      (to_string b)

  let pp ppf language =
    Fmt.pf ppf "@[<hov 1>@%s@]" (to_string language)

end

module Prefixed_name = struct

  type t = string * string

  let of_strings s1 s2 = (s1, s2)

  let equal a b =
    String.equal (fst a) (fst b)
    &&
    String.equal (snd a) (snd b)

  (* TODO check whether this is nice *)
  let pp ppf prefixed_name =
    Fmt.pf ppf "@[<hov 1>%s:%s@]"
      (fst prefixed_name)
      (snd prefixed_name)

end

module Blank_node = struct

  type t = string

  let of_string s = s

  let to_string s = s

  let equal a b =
    String.equal
      (to_string a)
      (to_string b)

  (* TODO check whether this is nice (for all the pp functions)*)
  let pp ppf blank_node =
    Fmt.pf ppf "@[<hov 1>_:%s@]" (to_string blank_node)

end

module Iri = struct

  type t = Iriref of Iriref.t | Prefixed_name of Prefixed_name.t

  let of_iriref ref = Iriref ref

  let of_prefixed_name pname = Prefixed_name pname

  let equal a b =
    match (a, b) with
    | (Iriref refa), (Iriref refb) -> Iriref.equal refa refb
    | (Prefixed_name pa), (Prefixed_name pb) -> Prefixed_name.equal pa pb
    | _ -> false

  let pp ppf = function
    | Iriref iriref -> Iriref.pp ppf iriref
    | Prefixed_name pname -> Prefixed_name.pp ppf pname

end

module Literal = struct
  type t = {
    value: string;
    datatype: Iri.t;
    language: string option;
  }

  let make value ?language datatype =
    { value; datatype; language}

  let canonical literal =
    literal.value

  let language literal =
    literal.language

  let datatype literal =
    literal.datatype

  let equal a b =
    (String.equal a.value b.value)
    &&
    (Option.equal String.equal a.language b.language)
    &&
    (Iri.equal a.datatype b.datatype)

  let pp ppf literal =
    (* TODO print the datatype and language *)
    Fmt.pf ppf
      "@[<hov 8> \"%s\"%a^^%a @]"
      (canonical literal)
      (Fmt.option Language.pp) (language literal)
      Iri.pp (datatype literal)
                              

end

module Predicate = struct

  type t = Pred_iri of Iri.t | Pred_a

  let of_iri iri = Pred_iri iri
  let a = Pred_a

  let equal a b =
    match (a, b) with
    | (Pred_a, Pred_a) -> true
    | (Pred_iri ia, Pred_iri ib) -> Iri.equal ia ib
    | _ -> false

  let pp ppf = function
    | Pred_a -> Fmt.pf ppf "a"
    | Pred_iri i -> Fmt.pf ppf "@[<hov 1>%a@]" Iri.pp i

end

type object' =
  |  Obj_iri of Iri.t
  | Obj_blank_node of Blank_node.t
  | Obj_literal of Literal.t
  | Obj_coll of collection
  | Obj_bnodps of bnodps
and collection =
  |  Collection of object' list
and subject =
  | Sub_iri of Iri.t
  | Sub_blank_node of Blank_node.t
  | Sub_coll of collection
(* This deviates a little from the w3c specs. *)
  | Sub_bnodps of bnodps
and bnodps = BnodPs of predobjs
and predobjs = (Predicate.t * object' list) list

let rec object_equal a b =
  match a, b with
  | Obj_iri ia, Obj_iri ib -> Iri.equal ia ib
  | Obj_blank_node ba, Obj_blank_node bb -> Blank_node.equal ba bb
  | Obj_literal la, Obj_literal lb -> Literal.equal la lb
  | Obj_coll ca, Obj_coll cb -> collection_equal ca cb
  | Obj_bnodps bas, Obj_bnodps bbs -> bnodps_equal bas bbs
  | _ -> false
and collection_equal (Collection obsa) (Collection obsb) =
  list_equal object_equal obsa obsb
and subject_equal a b =
  match a, b with
  | Sub_iri ia, Sub_iri ib -> Iri.equal ia ib
  | Sub_blank_node ba, Sub_blank_node bb -> Blank_node.equal ba bb
  | Sub_coll ca, Sub_coll cb -> collection_equal ca cb
  | Sub_bnodps ba, Sub_bnodps bb -> bnodps_equal ba bb
  | _ -> false
and bnodps_equal (BnodPs a) (BnodPs b) =
  predobjs_equal a b
and predobjs_equal a b =
  list_equal
    (fun (p, obsa) (q, obsb) -> Predicate.equal p q && list_equal object_equal obsa obsb)
    a b

let rec object_pp ppf = function
  | Obj_iri iri -> Fmt.pf ppf "@[<hov 1>%a@]" Iri.pp iri
  | Obj_blank_node bnode -> Fmt.pf ppf "@[<hov 1>%a@]" Blank_node.pp bnode
  | Obj_literal lit -> Fmt.pf ppf "@[<hov 1>%a>@]" Literal.pp lit
  | Obj_coll coll -> Fmt.pf ppf "@[<hov 1>%a@]" collection_pp coll
  | Obj_bnodps bnodps -> Fmt.pf ppf "@[<hov 1>%a@]" bnodps_pp bnodps
and collection_pp ppf (Collection objs) =
  let object_pp_space ppf = Fmt.pf ppf " %a" object_pp in
  Fmt.pf ppf "@[<hov 1>(%a )@]" (Fmt.list object_pp_space) objs
and subject_pp ppf = function
  | Sub_iri iri ->Fmt.pf ppf "@[<hov 1>%a@]" Iri.pp iri
  | Sub_blank_node bnode -> Fmt.pf ppf "@[<hov 1>%a@]" Blank_node.pp bnode
  | Sub_bnodps bnodps -> Fmt.pf ppf "@[<hov 1>%a@]" bnodps_pp bnodps
  | Sub_coll collection -> Fmt.pf ppf "@[<hov 1>%a@]" collection_pp collection
and bnodps_pp ppf (BnodPs predobjs) =
  Fmt.pf ppf "@[<hov 1>[%a]@]" predobjs_pp predobjs
and predobjs_pp ppf predobjs =
  let objlist_pp ppf objs =
    match objs with
    | [obj] -> object_pp ppf obj
    | head :: tail ->
      object_pp ppf head;
      (List.iter
      (fun o -> Fmt.pf ppf "@[<hov 1>,%a@]" object_pp o) tail)
    | _ -> raise @@ Invalid_argument "An empty list should not be possible"
  in
  match predobjs with
  | [(p, objs)] ->
    Fmt.pf ppf "@[<hov 1>%a %a@]"
      Predicate.pp p
      objlist_pp objs
  | (p, objs) :: tail ->
    Fmt.pf ppf "@[<hov 1>%a %a@]"
      Predicate.pp p
      objlist_pp objs;
    List.iter
      (fun (p, objs) ->
         Fmt.pf ppf "@[<hov 1> ;\n    %a %a@]"
           Predicate.pp p
           objlist_pp objs)
      tail
  | _ -> raise @@ Invalid_argument "An empty list should not be possible"


module Triples = struct

  type t = SubjPredObjs of subject * predobjs
         | BnodPs of bnodps

  let of_subject_and_predobjs subject predobjs =
    SubjPredObjs (subject, predobjs)

  let of_bnodps bnodps =
    BnodPs bnodps

  let equal a b =
    match a, b with
    | SubjPredObjs (asub, ap), SubjPredObjs (bsub, bp) ->
      subject_equal asub bsub && predobjs_equal ap bp
    | BnodPs abs, BnodPs bbs ->
      bnodps_equal abs bbs
    | _, _ -> false

  let pp ppf = function
    | SubjPredObjs (s, ps) ->
      Fmt.pf ppf "@[<h 1><triples@ subject %a@ predicate %a>@]"
        subject_pp s
        predobjs_pp ps
    | BnodPs bs ->
      Fmt.pf ppf "@[<h 1><triples@ bnodps %a >@]"
        bnodps_pp bs

end

module Directive = struct

  type t = PrefixID of string * Iriref.t | Base of Iriref.t

  let of_string_and_iriref s i =
    PrefixID (s, i)

  let of_iriref i =
    Base i

  let equal a b =
    match a, b with
    | PrefixID (ast, ai), PrefixID (bst, bi) ->
      String.equal ast bst && Iriref.equal ai bi
    | Base ai, Base bi ->
      Iriref.equal ai bi
    | _, _ -> false

  let pp ppf = function
    | PrefixID (s, i) ->
      Fmt.pf ppf "@[<h 1><directive@ prefixID %a@ iriref %a@]"
        Fmt.string s
        Iriref.pp i
    | Base i ->
      Fmt.pf ppf "@[<h 1><directive@ base %a>@]" Iriref.pp i
end

module Statement = struct

  type t = Directive of Directive.t | Triples of Triples.t

  let of_directive d =
    Directive d

  let of_triples t =
    Triples t

  let equal a b =
    match a, b with
    | Directive a, Directive b -> Directive.equal a b
    | Triples a, Triples b -> Triples.equal a b
    | _, _ -> false

  let pp ppf = function
    | Directive d ->
      Fmt.pf ppf "@[<h 1><statement@ directive@ %a@]" Directive.pp d
    | Triples t ->
      Fmt.pf ppf "@[<h 1><statement@ triples %a>@]" Triples.pp t

end

module Turtle = struct

  type t = Statement.t list

  let of_statement_lst lst =
    lst

  let equal a b =
    list_equal Statement.equal a b

  let pp ppf l =
    Fmt.pf ppf "@[<h 1><turtle@ statement list %a>@]" (Fmt.list Statement.pp) l

end

type parser_state = {
  base_uri : Rdf.Iri.t;
  namespaces : Rdf.Iri.t SMap.t;
  bnode_labels : Blank_node.t SMap.t;
  cur_subject: Rdf.Triple.Subject.t;
  cur_predicate: Rdf.Triple.Predicate.t;
}