(*********************************************************************************)

(*                Cameleon                                                       *)
(*                                                                               *)
(*    Copyright (C) 2005,2006 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 Library General Public License as            *)
(*    published by the Free Software Foundation; either version 2 of the         *)
(*    License, or  any later version.                                            *)
(*                                                                               *)
(*    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 Library General Public License for more details.                       *)
(*                                                                               *)
(*    You should have received a copy of the GNU Library 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                                          *)
(*                                                                               *)
(*********************************************************************************)


(* $Id: tdl2html.ml,v 1.2 2004/03/27 18:25:06 zoggy Exp $ *)

(** HTML generator for TDL structures. *)


open Tdl

(*c==v=[String.string_of_in_channel]=1.0====*)
let string_of_in_channel ic =
  let len = 1024 in
  let s = String.create len in
  let buf = Buffer.create len in
  let rec iter () =
    try
      let n = input ic s 0 len in
      if n = 0 then
        ()
      else
        (
         Buffer.add_substring buf s 0 n;
         iter ()
        )
    with
      End_of_file -> ()
  in
  iter ();
  Buffer.contents buf
(*/c==v=[String.string_of_in_channel]=1.0====*)

let default_page_type =
  "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>"^
  "<!DOCTYPE html \n"^
  "PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" ^
  "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n"

let p = Printf.fprintf

let page oc style title f_body arg =
  p oc "%s"
    (default_page_type^
     "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">\n"^
     "<link rel=\"stylesheet\" type=\"text/css\" href=\""^style^"\">\n"^
     "<title>"^title^"</title></head>\n"^
     "<body>"
    );
  f_body oc arg;
  p oc "</body>\n</html>"

let ic = ref stdin
let oc = ref stdout
let gen_page = ref false
let css_style = ref "style.css"

let gen_css = ref None

let options = [
  "-i"Arg.String (fun s -> ic := open_in s), "<file>\tread from <file> instead of standard input";
  "-o"Arg.String (fun s -> oc := open_out s), "<file>\toutput to <file> instead of standard output";
  "--page"Arg.Set gen_page, " generate a whole page instead of just a piece of html";
  "--css"Arg.Set_string css_style, "<url>\tcss style sheet to use, when generating a whole page (default: "^ !css_style ^")";
  "--gen-css"Arg.String (fun s -> gen_css := Some s),
  "<file>\tgenerate a default CSS style sheet in given file";
]

let print_item oc i =
  p oc "<div class=\"TDL_item\"><span class=\"TDL_item_title\">";
  p oc "%s%s [<span class=\"TDL_item_state\">%s</span>]"
    i.item_title
    ""
    (Tdl.string_of_state i.item_state);
  p oc "</span>";
  (
   match i.item_desc with
     None -> ()
   | Some s -> p oc "<div class=\"TDL_item_desc\">%s</div>" s
  );
  p oc "</div>\n"

let rec print_group oc g =
  p oc "<div class=\"TDL_group_title\">%s</div>" g.group_title;
  p oc "<div class=\"TDL_group_body\">";
  List.iter (print_item oc) g.group_items;
  List.iter (print_group oc) g.group_groups;
  p oc "</div>"

let print oc g =
  if !gen_page then
    page oc !css_style g.group_title print_group g
  else
    print_group oc g

let default_style_sheet =
"\ndiv.TDL_group_title { font-weight: bold ; padding-left: 0.5em; }\ndiv.TDL_group_body {\n  margin-left: 1em ; border-style: solid; border-width: 0 0 0 1px; border-color: blue;\n  padding-bottom: 0.5em;\n  }\ndiv.TDL_item_desc { font-size: smaller ; margin-left: 0.5em; }\nspan.TDL_item_state { font-style: italic ; }\ndiv.TDL_item { padding-left: 0.5em; }\n"
;;

let main () =
  Arg.parse options
    (fun _ -> ())
    (Printf.sprintf "Usage: %s [options]\nwhere options are:" Sys.argv.(0));
  let s = string_of_in_channel !ic in
  let g = Tdl.group_of_string s in
  print !oc g;
  close_in !ic;
  close_out !oc;
  match !gen_css with
    None -> ()
  | Some f ->
      let oc = open_out f in
      output_string oc default_style_sheet;
      close_out oc
;;

let _ =
  try main ()
  with Sys_error s | Failure s ->
    prerr_endline s;
    exit 1