(*
 * Copyright (C) 2003:
 *    Stefano Zacchiroli <zack@cs.unibo.it>
 *    for the HELM Team http://helm.cs.unibo.it/
 *
 *  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://helm.cs.unibo.it/
 *)

open Printf;;

exception Stylesheet_not_found of string ;;
exception Stylesheet_already_in of string ;;

type xslt_msg =
  | LibXsltErrorMsg of string
  | LibXsltDebugMsg of string
;;
type log = xslt_msg list ;;

class styles =
  object (self)
    (* INVARIANT: 'stylesheets' and 'uris' are in sync *)

    initializer
      Gdome_xslt.setErrorCallback
        (Some (fun msg -> self#appendMsg (LibXsltErrorMsg msg)));
      Gdome_xslt.setDebugCallback
        (Some (fun msg -> self#appendMsg (LibXsltDebugMsg msg)))

      
    val mutable stylesheets = []  (** association list: key -> Gdome.document *)
    val mutable uris = []         (** association list: key -> uri *)
    val mutable libXsltMsgs = []  (** libxslt's error and debugging messages *)

    val domImpl = Gdome.domImplementation ()

      (** process an XSLT stylesheet *)
    method private process uri =
      let dom = domImpl#createDocumentFromURI ~uri () in
      ignore (Gdome_xslt.processStylesheet dom);  (* fills libXsltMsgs in case
                                                  of errors *)
      dom

      (* libxslt's error and debugging messages handling *)

    method private appendMsg msg = libXsltMsgs <- msg :: libXsltMsgs
    method private clearMsgs = libXsltMsgs <- []

    (* stylesheets management *)

    method add key uri =
      if (List.mem_assoc key uris) then
        raise (Stylesheet_already_in key)
      else begin
        self#clearMsgs;
        uris <- (key, uri) :: uris;
        stylesheets <- (key, self#process uri) :: stylesheets;
        libXsltMsgs
      end

    method remove key : log =
      if not (List.mem_assoc key uris) then
        raise (Stylesheet_not_found key)
      else begin
        uris <- List.remove_assoc key uris;
        stylesheets <- List.remove_assoc key stylesheets;
        []  (* no XSLT action -> no logs *)
      end

    method removeAll : log =
      uris <- [];
      stylesheets <- [];
      []  (* no XSLT action -> no logs *)

    method reload key =
      (try
        self#clearMsgs;
        let uri = List.assoc key uris in
        stylesheets <-
          (key, self#process uri) :: (List.remove_assoc key stylesheets);
        libXsltMsgs
      with Not_found ->
        raise (Stylesheet_not_found key))

    method reloadAll =
      self#clearMsgs;
      stylesheets <- List.map (fun (key, uri) -> (key, self#process uri)) uris;
      libXsltMsgs

    (* stylesheets usage *)

    method keys = List.map fst uris

    method list =
      List.map
        (fun (key, uri) ->
          sprintf "key = %s, uri = %s" key (List.assoc key uris))
        uris

    method get keys =
      let rev_keys = List.rev keys in
      let last_key = List.hd rev_keys in
      let p_stylesheets =
        List.fold_left
          (fun collected_styles key ->
            let (key, stylesheet) =
              try
                List.find (fun (k, _) -> k = key) stylesheets
              with Not_found -> raise (Stylesheet_not_found key)
            in
            (key, Gdome_xslt.processStylesheet stylesheet)::collected_styles)
          []
          rev_keys
      in
      let last_stylesheet =
        snd (List.find (fun (k, _) -> k = last_key) stylesheets)
      in
      (p_stylesheets, last_stylesheet)

  end