(* Copyright (C) 2000, HELM Team.
 * 
 * This file is part of HELM, an Hypertextual, Electronic
 * Library of Mathematics, developed at the Computer Science
 * Department, University of Bologna, Italy.
 * 
 * HELM is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 * 
 * HELM 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 HELM; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
 * MA  02111-1307, USA.
 * 
 * For details, see the HELM World-Wide-Web page,
 * http://cs.unibo.it/helm/.
 *)

(*
* "cic:/a/b/c.con" => [| "cic:/a" ; "cic:/a/b" ; "cic:/a/b/c.con" ; "c"; "" |]
* "cic:/a/b/c.ind#xpointer(1/1)" =>
*   [| "cic:/a" ; "cic:/a/b" ; "cic:/a/b/c.con" ; "c"; "#xpointer(1/1)" |]
* "cic:/a/b/c.ind#xpointer(1/1/1)" =>
*   [| "cic:/a" ; "cic:/a/b" ; "cic:/a/b/c.con" ; "c"; "#xpointer(1/1/1)" |]
*)
type uri = string array;;

let eq uri1 uri2 =
  uri1 == uri2 
;;

let string_of_uri uri =
  match  uri.(Array.length uri - 1) with
  | "" -> 
      uri.(Array.length uri - 3)
  | _ -> 
      String.concat "#" 
        [ uri.(Array.length uri - 3); uri.(Array.length uri - 1) ]

let name_of_uri uri = uri.(Array.length uri - 2);;
let buri_of_uri uri = uri.(Array.length uri - 4);;
let depth_of_uri uri = Array.length uri - 3;;

module OrderedStrings =
 struct
  type t = string
  let compare (s1 : t) (s2 : t) = compare s1 s2
 end
;;

module SetOfStrings = Map.Make(OrderedStrings);;

(*CSC: commento obsoleto ed errato *)
(* Invariant: the map is the identity function,      *)
(*  i.e. (SetOfStrings.find str !set_of_uri) == str  *)
let set_of_uri = ref SetOfStrings.empty;;
let set_of_prefixes = ref SetOfStrings.empty;;

  
(* hash conses an uri *)
let add_to_uriset ?suri uri =
  let lookup_suri suri =
    try
      SetOfStrings.find suri !set_of_uri
    with Not_found -> assert false
  in
  let suri = 
    match suri with 
    | None -> string_of_uri uri
    | Some suri -> suri 
  in
  if not(SetOfStrings.mem suri !set_of_uri) then
    set_of_uri := SetOfStrings.add suri uri !set_of_uri;
  lookup_suri suri  
    

(* similar to uri_of_string, but used for prefixes of uris *)
let normalize prefix =
 try
  SetOfStrings.find prefix !set_of_prefixes
 with
  Not_found ->
   set_of_prefixes := SetOfStrings.add prefix prefix !set_of_prefixes ;
   prefix
;;

exception IllFormedUri of string;;

let mk_prefixes str xpointer =
 let rec aux curi =
  function
     [he] ->
      let prefix_uri = curi ^ "/" ^ he
      and name = List.hd (Str.split (Str.regexp "\\.") he) in
       [ normalize prefix_uri ; name ]
   | he::tl ->
      let prefix_uri = curi ^ "/" ^ he in
       (normalize prefix_uri)::(aux prefix_uri tl)
   | _ -> raise (IllFormedUri str)
 in
  let tokens = (Str.split (Str.regexp "/") str) in
   (* ty = "cic:" *)
   let (ty, sp) =
    (try (List.hd tokens, List.tl tokens)
     with Failure "hd" | Failure "tl" ->
      raise (IllFormedUri str))
    in
    (aux ty sp) @ [xpointer]
;;


let sharp_rex = 
  Str.regexp "#"
;;

let uri_of_string str =
  let base, xpointer =
    match Str.split sharp_rex str with
    | [base] -> base,""
    | [base; xpointer] -> base,xpointer 
    | _ -> raise (IllFormedUri str)
  in
   try
    SetOfStrings.find str !set_of_uri
   with
    Not_found ->
      let uri = Array.of_list (mk_prefixes base xpointer) in
      add_to_uriset ~suri:str uri
;;

let strip_xpointer uri =
  let stripped_uri = Array.copy uri in
  stripped_uri.(Array.length uri - 1) <- "";  (* reset xpointer field *)
  let suri = string_of_uri stripped_uri in
  add_to_uriset ~suri stripped_uri

  
let cicuri_of_uri uri =
 let completeuri = string_of_uri uri in
  let newcompleteuri = 
   (Str.replace_first (Str.regexp "\\.types$") ""
    (Str.replace_first (Str.regexp "\\.ann$") "" completeuri))
  in
   if completeuri = newcompleteuri then
    uri
   else
    let newuri = Array.copy uri in
     newuri.(Array.length uri - 3) <- newcompleteuri ;
     add_to_uriset newuri
;;

let annuri_of_uri uri =
 let completeuri = string_of_uri uri in
  if Str.string_match (Str.regexp ".*\\.ann$") completeuri 0 then
   uri
  else
   let newuri = Array.copy uri in
    newuri.(Array.length uri - 3) <- completeuri ^ ".ann" ;
    add_to_uriset newuri
;;

let uri_is_annuri uri =
 Str.string_match (Str.regexp ".*\\.ann$") (string_of_uri uri) 0
;;

let bodyuri_of_uri uri =
 let struri = string_of_uri uri in
  if Str.string_match (Str.regexp ".*\\.con$") (string_of_uri uri) 0 then
   let newuri = Array.copy uri in
    newuri.(Array.length uri - 3) <- struri ^ ".body" ;
    Some (add_to_uriset newuri)
  else
   None
;;

let innertypesuri_of_uri uri =
 let cicuri = cicuri_of_uri uri in
  let newuri = Array.copy cicuri in
   newuri.(Array.length cicuri - 3) <- (string_of_uri cicuri) ^ ".types" ;
   add_to_uriset newuri
;;

type uriref = uri * (int list)

let string_of_uriref (uri, fi) =
   let str = string_of_uri uri in
   let xp t = "#xpointer(1/" ^ string_of_int (t + 1) in
   match fi with
      | []          -> str 
      | [t]         -> str ^ xp t ^ ")" 
      | t :: c :: _ -> str ^ xp t ^ "/" ^ string_of_int c ^ ")" 

let compare u1 u2 =
  let su1 = string_of_uri u1 in
  let su2 = string_of_uri u2 in
  Pervasives.compare su1 su2

module OrderedUri =
struct
  type t = uri
  let compare = compare (* the one above, not Pervasives.compare *)
end

module UriSet = Set.Make (OrderedUri)