Source file ds.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                                          *)
(*                                                                               *)
(*********************************************************************************)

(** *)

type name = [ `I of Iri.t | `B of Term.blank_id ]
let compare_name n1 n2 =
  match n1, n2 with
  | `I i1, `I i2 -> Iri.compare i1 i2
  | `I _, _ -> 1
  | _, `I _ -> -1
  | `B id1, `B id2 -> String.compare
      (Term.string_of_blank_id id1) (Term.string_of_blank_id id2)

let string_of_name name =
  let term = match name with
    | `I iri -> Term.Iri iri
    | `B id -> Term.Blank_ id
  in
  Term.string_of_term term

let pp_name ppf name = Format.fprintf ppf "%s" (string_of_name name)

let term_of_name = function
| `I iri -> Term.Iri iri
| `B id -> Term.Blank_ id

module OrderedName = struct type t = name let compare = compare_name end
module NameMap = Map.Make(OrderedName)
module NameSet = Set.Make(OrderedName)

type dataset =
  { default : Graph.graph ;
    named : unit -> NameSet.t ;
    get_named : ?add:bool -> name -> Graph.graph option ;
    add: (?name:name -> Graph.graph -> Graph.graph) option ;
  }

let simple_dataset ?(named=[]) default =
  let named_set = List.fold_left (fun set (name,_) -> NameSet.add name set) NameSet.empty named in
  let named = List.fold_left (fun map (name,g) -> NameMap.add name g map) NameMap.empty named in
  let get_named ?add name = NameMap.find_opt name named in
  let add = None in
  { add ; default ; named = (fun () -> named_set) ; get_named }
;;

let dataset ?add ?get_named ?(named=fun () -> NameSet.empty) default =
  match get_named with
    None -> simple_dataset default
  | Some get_named -> { add ; default ; named ; get_named }
;;

let mem_dataset default_graph =
  let graphs = ref NameMap.empty in
  let f_add ?name g =
    let name = match name with None -> `I (g.Graph.name ()) | Some n -> n in
    match NameMap.find_opt name !graphs with
    | None -> graphs := NameMap.add name g !graphs; g
    | Some g0 -> Graph.merge g g0; g0
  in
  let get_named ?(add=false) name =
    match NameMap.find_opt name !graphs with
    | Some g -> Some g
    | None when not add -> None
    | None ->
        let g =
          let base = match name with
            | `B _ -> Iri.of_string ""
            | `I i -> i
          in
          Graph.open_graph base
        in
        Some (f_add ~name g)
  in
  let named () = NameSet.of_list (List.map fst (NameMap.bindings !graphs)) in
  dataset ~add:f_add ~get_named ~named default_graph

let graphs ds =
  NameSet.fold
    (fun name acc ->
       match ds.get_named name with
       | None -> acc
       | Some g -> (Some name, g) :: acc
    )
    (ds.named()) [(None, ds.default)]

let merge_to_default ds =
  List.iter
    (fun (name, g) ->
       match name with
       | None -> ()
       | Some _ -> Graph.merge ds.default g)
    (graphs ds)

let iter f ds = List.iter (fun (name,g) -> f name g) (graphs ds)

let fold f acc ds =
  List.fold_left (fun acc (name, g) -> f acc name g) acc (graphs ds)

type diff =
| Cardinals of int * int
| Missing_graph of name
| Graph_diff of name option * Graph.diff

let string_of_diff = function
| Cardinals (c1, c2) -> Printf.sprintf "Cardinals differ: %d <> %d" c1 c2
| Missing_graph name -> Printf.sprintf "Missing graph %s" (string_of_name name)
| Graph_diff (name, d) -> Printf.sprintf "Diff in graph %s: %s"
    (match name with None -> "[default]" | Some n -> string_of_name n)
      (Graph.string_of_diff d)

let pp_diff ppf diff = Format.fprintf ppf "%s" (string_of_diff diff)

let isomorphic_diff =
  let f ~ignore_blanks ds2 acc name g1 =
    match acc with
    | Some d -> acc
    | None ->
        match name with
        | _ when g1.Graph.size () = 0 -> acc
        | Some (`B _) when ignore_blanks -> acc
        | _ ->
            let g2 =
              match name with
              | None -> Some ds2.default
              | Some name -> ds2.get_named name
            in
            match g2, name with
            | None, None -> assert false
            | None, Some name -> Some (Missing_graph name)
            | Some g2, _ ->
                match Graph.isomorphic_diff ~ignore_blanks g1 g2 with
                | None -> acc
                | Some d -> Some (Graph_diff (name, d))
  in
  fun ?(ignore_blanks=false) ds1 ds2 ->
    let card ds =
      fold (fun acc name g -> if g.size() > 0 then acc + 1 else acc) 0 ds
    in
    let card1 = card ds1 in
    let card2 = card ds2 in
    if card1 <> card2 then
      Some (Cardinals (card1, card2))
    else
      fold (f ~ignore_blanks ds2) None ds1