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

(*                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: odoc_tdl.ml,v 1.3 2004/03/27 19:19:55 zoggy Exp $ *)

(** @ocamldoc_generator A generator to retrieve information in "todo" tags and create a todo list with the OCaml-TDL library. This generator comes with the OCaml-TDL library.

@ocamldoc_compilation see the INSTALL file in the OCaml-TDL distribution. @ocamldoc_tag todo add a TODO item associated to the element the ocamldoc comment is associated to. @ocamldoc_url http://download.gna.org/ocamltdl/ @author Maxence Guesdon *)



open Tdl
open Odoc_info
open Odoc_info.Value
open Odoc_info.Module
open Odoc_info.Type
open Odoc_info.Exception
open Odoc_info.Class

let p = Printf.bprintf

let count_items g =
  let rec iter g =
    let l = List.map iter g.group_groups in
    let sum = List.fold_left (+) 0 l in    
    let nitems = List.length g.group_items in
    sum + nitems
  in
  iter g

let rec remove_empty_groups g =
  let rec iter g =
    let l = List.map iter g.group_groups in
    let (sum, l2) =
      List.fold_left
        (fun (acc_sum, acc_l) (n,g) ->
          if n = 0 then
            (acc_sum, acc_l)
          else
            (acc_sum + n, acc_l @ [g])
        )
        (List.length g.group_items, [])
        l
    in
    g.group_groups <- l2;
    (sum, g)
  in
  iter g

(** @todo create more than one group *)

class gen () =
  object (self)
    inherit Odoc_info.Scan.scanner

    val mutable current_group = Tdl.group ()

    method gen_if_tag name target info_opt =
      match info_opt with
        None -> ()
      |        Some i ->
          let l = 
            List.fold_left
              (fun acc (t, text) ->
                match t with
                  "todo" -> text :: acc
                | _ -> acc
              )
              []
              i.i_custom
          in
          match l with
            [] -> ()
          | _ ->
              let i = Tdl.item ~title: name
                  ~state: Tdl.Priority_normal
                  ~desc: (String.concat "\n" (List.map Odoc_info.string_of_text l))
                  ()
              in
              current_group.group_items <- current_group.group_items @ [i]
                                                                         
    method scan_value v =
      self#gen_if_tag
        v.val_name
        (Odoc_html.Naming.complete_value_target v)
        v.val_info

    method scan_type t =
      self#gen_if_tag
        t.ty_name
        (Odoc_html.Naming.complete_type_target t)
        t.ty_info

    method scan_exception e =
      self#gen_if_tag
        e.ex_name
        (Odoc_html.Naming.complete_exception_target e)
        e.ex_info

    method scan_attribute a =
      self#gen_if_tag
        a.att_value.val_name
        (Odoc_html.Naming.complete_attribute_target a)
        a.att_value.val_info

    method scan_method m =
      self#gen_if_tag
        m.met_value.val_name
        (Odoc_html.Naming.complete_method_target m)
        m.met_value.val_info;

    method scan_included_module _ = ()

    method scan_class_pre c =
      self#gen_if_tag
        c.cl_name
        (fst (Odoc_html.Naming.html_files c.cl_name))
        c.cl_info;
      true

    method scan_class_type_pre ct =
      self#gen_if_tag
        ct.clt_name
        (fst (Odoc_html.Naming.html_files ct.clt_name))
        ct.clt_info;
      true

    method scan_module_pre m =
      self#gen_if_tag
        m.m_name
        (fst (Odoc_html.Naming.html_files m.m_name))
        m.m_info;
      true

    method scan_module_type_pre mt =
      self#gen_if_tag
        mt.mt_name
        (fst (Odoc_html.Naming.html_files mt.mt_name))
        mt.mt_info;
      true

    method scan_module_elements m =
      List.iter 
        (fun ele -> 
          match ele with
            Odoc_module.Element_module m -> 
              let g_bak = current_group in
              let g = Tdl.group ~title: (Name.simple m.m_name) () in
              current_group <- g;
              g_bak.group_groups <- g_bak.group_groups @ [g];
              self#scan_module m;
              current_group <- g_bak
          | Odoc_module.Element_module_type mt -> 
              let g_bak = current_group in
              let g = Tdl.group ~title: (Name.simple mt.mt_name) () in
              current_group <- g;
              g_bak.group_groups <- g_bak.group_groups @ [g];
              self#scan_module_type mt;
              current_group <- g_bak
          | Odoc_module.Element_included_module im -> self#scan_included_module im
          | Odoc_module.Element_class c -> 
              let g_bak = current_group in
              let g = Tdl.group ~title: (Name.simple c.cl_name) () in
              current_group <- g;
              g_bak.group_groups <- g_bak.group_groups @ [g];
              self#scan_class c;
              current_group <- g_bak
          | Odoc_module.Element_class_type ct ->
              let g_bak = current_group in
              let g = Tdl.group ~title: (Name.simple ct.clt_name) () in
              current_group <- g;
              g_bak.group_groups <- g_bak.group_groups @ [g];
              self#scan_class_type ct;
              current_group <- g_bak
          | Odoc_module.Element_value v -> self#scan_value v
          | Odoc_module.Element_exception e -> self#scan_exception e
          | Odoc_module.Element_type t -> self#scan_type t
          | Odoc_module.Element_module_comment t -> self#scan_module_comment t
        )
        (Odoc_module.module_elements m)

    method scan_module_list l =
      let f m =
        let g_bak = current_group in
        let g = Tdl.group ~title: (Name.simple m.m_name) () in
        current_group <- g;
        g_bak.group_groups <- g_bak.group_groups @ [g];
        self#scan_module m;
        current_group <- g_bak
      in
      List.iter f l

    method generate modules =
      let title = 
        match !Odoc_info.Args.title with
          None -> ""
        | Some s -> s
      in
      let g = Tdl.group ~title () in
      current_group <- g;
      self#scan_module_list modules;
      let (n, g) = remove_empty_groups g in
      Odoc_info.verbose (Printf.sprintf "%d item(s) found." n);

      Tdl.print_file !Odoc_info.Args.out_file g
  end

class foo = object end

let generator = ((new gen ()) :> Odoc_args.doc_generator)

let _ = Odoc_args.set_doc_generator (Some generator)