Source file nq.ml

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
(** Reading and writing N-quads. *)

type error = Parse_error of Loc.loc * string
exception Error of error

let string_of_error = function
  Parse_error (loc, s) ->
    (Loc.string_of_loc loc) ^ s
;;

let () = Printexc.register_printer
  (function
   | Error e ->
       Some (Printf.sprintf "Parse error: %s" (string_of_error e))
   | _ -> None)


open Lexing;;

let add_quad ds (sub,pred,obj,name) =
  match name with
  | None -> ds.Ds.default.add_triple ~sub ~pred ~obj
  | Some name ->
      match ds.get_named ~add:true name with
      | None -> Log.err (fun m -> m "No graph %a" Ds.pp_name name)
      | Some g -> g.add_triple ~sub ~pred ~obj

let from_lexbuf (ds:Ds.dataset) ?fname lexbuf =
  let parse = Sedlex.menhir_with_ulex Ttl_parser.nq Ttl_lex.main ?fname in
  let quads =
    try parse lexbuf
    with Sedlex.Parse_error (e, pos)->
        let msg =
          match e with
            Ttl_parser.Error ->
              let lexeme = Sedlexing.Utf8.lexeme lexbuf in
              Printf.sprintf "Error on lexeme %S" lexeme
          | Failure msg -> msg
          | Iri.Error e -> Iri.string_of_error e
          | e -> Printexc.to_string e
        in
        let loc = { Loc.loc_start = pos ; loc_end = pos } in
        raise (Error (Parse_error (loc,msg)))
  in
  List.iter (add_quad ds) quads
;;

let from_string ds s =
  let lexbuf = Sedlexing.Utf8.from_string s in
  from_lexbuf ds lexbuf
;;

let from_file ds file =
  let ic = open_in_bin file in
  let lexbuf = Sedlexing.Utf8.from_channel ic in
  try from_lexbuf ds ~fname: file lexbuf; close_in ic
  with e ->
      close_in ic;
      raise e
;;

let string_of_term t =
  let t = match t with
    | Term.Literal ({ Term.lit_language = None ; lit_type = Some iri } as lit)
        when Iri.equal iri Rdf_.xsd_string ->
        Term.Literal { lit with lit_type = None }
    | Term.Literal ({ lit_language = Some _ ; lit_type = Some iri } as lit)
        when Iri.equal iri Rdf_.dt_langString ->
        Term.Literal { lit with lit_type = None }
    | _ -> t
  in
  Ttl.string_of_term t

let print_quad print ~name ~sub ~pred ~obj =
  let sub = string_of_term sub in
  let pred = string_of_term (Term.Iri pred) in
  let obj = string_of_term obj in
  print (Printf.sprintf "%s %s %s" sub pred obj);
  (match name with
   | None -> ()
   | Some n ->
       print " " ;
       match n with
       | `I iri -> print (string_of_term (Term.Iri iri))
       | `B id -> print (string_of_term (Term.Blank_ id))
  );
  print ".\n"
;;

let graph_to_ print name g =
  List.iter (fun (sub,pred,obj) ->
      print_quad print ~name ~sub ~pred ~obj)
   (g.Graph.find())

let to_ print ds =
  Ds.iter (fun name g -> graph_to_ print name g) ds

let to_string ds =
  let b = Buffer.create 256 in
  let print s = Buffer.add_string b s in
  to_ print ds;
  Buffer.contents b
;;

let to_file ds file =
  let oc = open_out_bin file in
  try
    let print s = output_string oc s in
    to_ print ds;
    close_out oc
  with e ->
      close_out oc;
      raise e
;;

let graph_to_string g =
  let b = Buffer.create 256 in
  let print s = Buffer.add_string b s in
  graph_to_ print None g;
  Buffer.contents b
;;

let graph_to_file g file =
  let oc = open_out_bin file in
  try
    let print s = output_string oc s in
    graph_to_ print None g;
    close_out oc
  with e ->
      close_out oc;
      raise e
;;