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

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


(** Generation of OCaml code to print a report, from a report description. *)


open Rep_desc

let p = Format.pp_print_string 
let escape s = Str.global_replace (Str.regexp_string "\"""\\\"" s

(** Generate the code of the report structure from report description.*)

let rec generate_structure fmt report_ele =
  match report_ele with
    Leaf l ->
      p fmt ("Leaf (fun () -> "^l.leaf^")")
  | Sub s ->
      p fmt ("Sub { sub_rep = (fun () -> Report.coerce ("^s.sub_code^")); }")
  | Mark m ->
      p fmt 
        ("Tag { tag = \"a\" ; atts = [(\"name\", "^
         "fun () -> \""^(escape m.mark_name)^"\")] ; tag_subs = [] }")
  | Tag t ->
      let f (att, code) =
        "(\""^(escape att)^"\", "^
        "fun () -> "^code^")"
      in
      p fmt 
        ("Tag { tag = \""^(escape t.tag)^"\" ; "^
         "atts = ["^(String.concat " ; " (List.map f t.atts))^"] ; "^
         "tag_subs = \n[\n");
      List.iter 
        (fun ele ->
          generate_structure fmt ele ;
          p fmt ";\n"
        )
        t.tag_subs;
      p fmt "\n] }\n"
  | List list ->
      p fmt 
        ("( let "^list.var^"_ = { "^
         "f = (fun () -> "^list.f^") ; "^
         "list_subs = (fun "^list.var^" -> \n[\n");
      List.iter 
        (fun ele ->
          generate_structure fmt ele ;
          p fmt ";\n"
        )
        list.list_subs;
      p fmt ("\n]) }\nin List (Report.coerce "^list.var^"_))")
  | Cond c ->
      p fmt 
        ("Cond { cond = (fun () -> "^c.cond^") ; "^
         "subs_then = \n[\n");
      List.iter 
        (fun ele ->
          generate_structure fmt ele ;
          p fmt ";\n"
        )
        c.subs_then;
      p fmt "\n] ;\nsubs_else = \n[\n" ;
      List.iter 
        (fun ele ->
          generate_structure fmt ele ;
          p fmt ";\n"
        )
        c.subs_else;
      p fmt "\n] }\n"
  | Else _ | Then _ ->
      ()

(** Generate the OCaml file with the code to generate the report whose description is given. *)

let gen_code ocaml_file rep_desc =
  try
    let chanout = open_out ocaml_file in
    let fmt = Format.formatter_of_out_channel chanout in
    p fmt ("(** "^Rep_messages.generated_by^" *)\n\n");
    p fmt (rep_desc.rep_header^"\n");
    p fmt "open Report\n\n" ;
    p fmt ("let rec report "^(String.concat " " rep_desc.rep_params)^" = ({\n") ;
    p fmt "  rep_eles = [\n" ;
    List.iter 
      (fun e ->
        generate_structure fmt e ;
        p fmt ";\n"
      )
      rep_desc.rep_eles ;
    p fmt " ]\n} : int report)\n\n" ;
    p fmt
      ("let print_file ?(html=false) file "^(String.concat " " rep_desc.rep_params)^" =\n"^
       "  let r = report "^(String.concat " " rep_desc.rep_params)^" in\n"^
       "  Report.compute_file ~html: html file r\n");
    p fmt
      ("let print ?(html=false) fmt "^(String.concat " " rep_desc.rep_params)^" =\n"^
       "  let r = report "^(String.concat " " rep_desc.rep_params)^" in\n"^
       "  Report.compute ~html: html fmt r\n");
    flush chanout ;
    close_out chanout
  with
    Sys_error s ->
      prerr_endline s ;
      exit 1