(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
(*                                                                        *)
(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
(*     en Automatique.                                                    *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

(** Representation and manipulation of classes and class types.*)

module Name = Odoc_name

type class_element =
    Class_attribute of Odoc_value.t_attribute
  | Class_method of Odoc_value.t_method
  | Class_comment of Odoc_types.text

(** Used when we can reference t_class or t_class_type. *)
type cct =
    Cl of t_class
  | Cltype of t_class_type * Types.type_expr list (** class type and type parameters *)

and inherited_class = {
    ic_name : Name.t ; (** Complete name of the inherited class *)
    mutable ic_class : cct option ; (** The associated t_class or t_class_type *)
    ic_text : Odoc_types.text option ; (** The inheritance comment, if any *)
  }

and class_apply = {
    capp_name : Name.t ; (** The complete name of the applied class *)
    mutable capp_class : t_class option;  (** The associated t_class if we found it *)
    capp_params : Types.type_expr list; (** The type of expressions the class is applied to *)
    capp_params_code : string list ; (** The code of these expressions *)
  }

and class_constr = {
    cco_name : Name.t ; (** The complete name of the applied class *)
    mutable cco_class : cct option;  (** The associated class of the class type if we found it *)
    cco_type_parameters : Types.type_expr list; (** The type parameters of the class, if needed *)
  }


and class_kind =
    Class_structure of inherited_class list * class_element list
        (** an explicit class structure, used in implementation and interface *)
  | Class_apply of class_apply (** application/alias of a class, used in implementation only *)
  | Class_constr of class_constr (** a class used to give the type of the defined class,
                                    instead of a structure, used in interface only.
                                    For example, it will be used with the name "M1.M2....tutu"
                                    when the class toto is defined like this :
                                    class toto : int -> tutu *)
  | Class_constraint of class_kind * class_type_kind
        (** A class definition with a constraint. *)

(** Representation of a class. *)
and t_class = {
    cl_name : Name.t ; (** Name of the class *)
    mutable cl_info : Odoc_types.info option ; (** The optional associated user information *)
    cl_type : Types.class_type ;
    cl_type_parameters : Types.type_expr list ; (** Type parameters *)
    cl_virtual : bool ; (** true = virtual *)
    mutable cl_kind : class_kind ;
    mutable cl_parameters : Odoc_parameter.parameter list ;
    mutable cl_loc : Odoc_types.location ;
  }

and class_type_alias = {
    cta_name : Name.t ;
    mutable cta_class : cct option ; (** we can have a t_class or a t_class_type *)
    cta_type_parameters : Types.type_expr list ; (** the type parameters *)
  }

and class_type_kind =
    Class_signature of inherited_class list * class_element list
  | Class_type of class_type_alias (** a class type eventually applied to type args *)

(** Representation of a class type. *)
and t_class_type = {
    clt_name : Name.t ;
    mutable clt_info : Odoc_types.info option ; (** The optional associated user information *)
    clt_type : Types.class_type ;
    clt_type_parameters : Types.type_expr list ; (** type parameters *)
    clt_virtual : bool ; (** true = virtual *)
    mutable clt_kind : class_type_kind ;
    mutable clt_loc : Odoc_types.location ;
  }

let class_parameter_text_by_name cl label =
  match cl.cl_info with
    None -> None
  | Some i ->
      try
        let t = List.assoc label i.Odoc_types.i_params in
        Some t
      with
        Not_found ->
          None

let rec class_elements ?(trans=true) cl =
  let rec iter_kind k =
    match k with
      Class_structure (_, elements) -> elements
    | Class_constraint (c_kind, _ct_kind) ->
        iter_kind c_kind
      (* FIXME : use c_kind or ct_kind ?
         For now, as ct_kind is not analyzed,
         we search inside c_kind
         class_type_elements ~trans: trans
         { clt_name = "" ; clt_info = None ;
          clt_type_parameters = [] ;
         clt_virtual = false ;
         clt_kind = ct_kind }
      *)
    | Class_apply capp ->
        (
         match capp.capp_class with
           Some c when trans -> class_elements ~trans: trans c
         | _ -> []
        )
    | Class_constr cco ->
        (
         match cco.cco_class with
           Some (Cl c) when trans -> class_elements ~trans: trans c
         | Some (Cltype (ct,_)) when trans -> class_type_elements ~trans: trans ct
         | _ -> []
        )
  in
  iter_kind cl.cl_kind

and class_type_elements ?(trans=true) clt =
  match clt.clt_kind with
    Class_signature (_, elements) -> elements
  | Class_type { cta_class = Some (Cltype (ct, _)) } when trans ->
      class_type_elements ~trans ct
  | Class_type { cta_class = Some (Cl c) } when trans ->
      class_elements ~trans c
  | Class_type _ ->
      []

let class_attributes ?(trans=true) cl =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Class_attribute a ->
          acc @ [ a ]
      | _ ->
          acc
    )
    []
    (class_elements ~trans cl)

let class_methods ?(trans=true) cl =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Class_method m ->
          acc @ [ m ]
      | _ ->
          acc
    )
    []
    (class_elements ~trans cl)

let class_comments ?(trans=true) cl =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Class_comment t ->
          acc @ [ t ]
      | _ ->
          acc
    )
    []
    (class_elements ~trans cl)

let class_update_parameters_text cl =
  let f p =
    Odoc_parameter.update_parameter_text (class_parameter_text_by_name cl) p
  in
  List.iter f cl.cl_parameters

let class_type_attributes ?(trans=true) clt =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Class_attribute a ->
          acc @ [ a ]
      | _ ->
          acc
    )
    []
    (class_type_elements ~trans clt)

let class_type_methods ?(trans=true) clt =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Class_method m ->
          acc @ [ m ]
      | _ ->
          acc
    )
    []
    (class_type_elements ~trans clt)

let class_type_comments ?(trans=true) clt =
  List.fold_left
    (fun acc -> fun ele ->
      match ele with
        Class_comment m ->
          acc @ [ m ]
      | _ ->
          acc
    )
    []
    (class_type_elements ~trans clt)

let class_type_parameter_text_by_name clt label =
  match clt.clt_info with
    None -> None
  | Some i ->
      try
        let t = List.assoc label i.Odoc_types.i_params in
        Some t
      with
        Not_found ->
          None