Source file nq.ml

(*********************************************************************************)
(*                OCaml-RDF                                                      *)
(*                                                                               *)
(*    Copyright (C) 2012-2024 Institut National de Recherche en Informatique     *)
(*    et en Automatique. All rights reserved.                                    *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Lesser General Public License version        *)
(*    3 as published by the Free Software Foundation.                            *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
(*    GNU General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public License          *)
(*    along with this program; if not, write to the Free Software                *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

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