(*********************************************************************************)
(*                Config_file                                                    *)
(*                                                                               *)
(*    Copyright (C) 2011 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                                                            *)
(*                                                                               *)
(*********************************************************************************)

(** This module implements a mechanism to handle configuration files. A
   configuration file is defined as a set of [variable = value] lines, where
   value can be

    - a simple string (types [int], [string], [bool]…);
    - a list of values between brackets (lists) or parentheses (tuples);
    - or a set of [variable = value] lines between braces.

   The configuration file is automatically loaded and saved, and configuration
   parameters are manipulated inside the program as easily as references.

   Object implementation by Jean-Baptiste Rouquier. *)

(** {1:lowlevelinterface Low level interface} *)

(** Skip this section on a first reading... *)

(** The type of Configuration Parameter, in short {e cp }, freshly parsed from
   a configuration file, not yet wrapped in their proper type. *)
module Raw : sig
  type cp =
    | String of string  (** base types, reproducing the tokens of Genlex *)
    | Int of int
    | Float of float
    | List of cp list  (** compound types *)
    | Tuple of cp list
    | Section of (string * cp) list

  val of_string : string -> cp
  (** A parser. *)

  val to_channel : out_channel -> cp -> unit
  (** Used to print the values into a log file for instance. *)
end

type 'a wrappers = { to_raw : 'a -> Raw.cp; of_raw : Raw.cp -> 'a }
(** A type used to specialize polymorphics classes and define new classes.
   {!section:predefined_wrappers} are provided. *)

exception Wrong_type of (out_channel -> unit)
(** An exception raised by {!Config_file.cp.set_raw} when the argument doesn't
   have a suitable {!Config_file.Raw.cp} type. The function explains the problem
   and flushes the output. *)

(* (\** {2 Miscellaneous functions} *\) *)

(* val bool_of_string : string -> bool *)

(** {1 High level interface} *)

(** {2 The two main classes} *)

(** A Configuration Parameter, in short {e cp}, i.e. a value we can store in and
   read from a configuration file. *)
class type ['a] cp =
  object

    (** {1 Accessing methods} *)

    method get : 'a

    method set : 'a -> unit

    method get_default : 'a

    method get_help : string

    method get_name : string list

    method reset : unit
    (** Resets to the default value. *)

    (** {1 Miscellaneous} *)

    method add_hook : ('a -> 'a -> unit) -> unit
    (** All the hooks are executed each time the method set is called, just
       after setting the new value.*)

    method set_short_name : string -> unit
    (** Used to generate command line arguments in
       {!Config_file.group.command_line_args}. *)

    method get_short_name : string option
    (** [None] if no optional short_name was provided during object creation and
       [set_short_name] was never called.*)

    (** {1 Methods for internal use} *)

    method get_formatted : Format.formatter -> unit

    method get_default_formatted : Format.formatter -> unit

    method get_help_formatted : Format.formatter -> unit

    method get_spec : Arg.spec

    method set_raw : Raw.cp -> unit
  end

type groupable_cp =
  < get_name : string list
  ; get_short_name : string option
  ; get_help : string
  ; get_formatted : Format.formatter -> unit
  ; get_default_formatted : Format.formatter -> unit
  ; get_help_formatted : Format.formatter -> unit
  ; get_spec : Arg.spec
  ; reset : unit
  ; set_raw : Raw.cp -> unit >
(** Unification over all possible ['a cp]: contains the main methods of ['a cp]
   except the methods using the type ['a]. A [group] manipulates only
   [groupable_cp] for homogeneity. *)

exception Double_name
(** Raised in case a name is already used. See {!Config_file.group.add}. *)

exception Missing_cp of groupable_cp
(** An exception possibly raised if we want to check that every cp is defined in
   a configuration file. See {!Config_file.group.read}. *)

(** A group of cps, that can be loaded and saved, or used to generate command
   line arguments.

   The basic usage is to have only one group and one configuration file, but
   this mechanism allows to have more, for instance to have another smaller
   group for the options to pass on the command line. *)
class group :
  object
    (*     method add : 'a cp -> 'a cp *)
    method add : 'a cp -> unit
    (** Adds a cp to the group. Note that the type ['a] must be lost to allow
       cps of different types to belong to the same group.

       @raise Double_name if [cp#get_name] is already used. *)

    method write : ?with_help:bool -> string -> unit
    (** [write filename] saves all the cps into the configuration file
       [filename].*)

    method read :
      ?obsoletes:string ->
      ?no_default:bool ->
      ?on_type_error:
        (groupable_cp ->
        Raw.cp ->
        (out_channel -> unit) ->
        string ->
        in_channel ->
        unit) ->
      string ->
      unit
    (** [read filename] reads [filename] and stores the values it specifies into
       the cps belonging to this group. The file is created (and not read) if it
       doesn't exists. In the default behaviour, no warning is issued. If not
       all cps are updated or if some values of [filename] aren't used.

      If [obsoletes] is specified, then prints in this file all the values that
      are in [filename] but not in this group. Those cps are likely to be
      erroneous or obsolete. Opens this file only if there is something to
      write in it.

      If [no_default] is [true], then raises [Missing_cp foo] if the cp [foo]
      isn't defined in [filename] but belongs to this group.

      [on_type_error groupable_cp value output filename in_channel] is called if
      the file doesn't give suitable value (string instead of int for instance,
      or a string not belonging to the expected enumeration) for the cp
      [groupable_cp]. [value] is the value read from the file, [output] is the
      argument of {!Config_file.Wrong_type}, [filename] is the same argument as
      the one given to read, and [in_channel] refers to [filename] to allow a
      function to close it if needed. Default behaviour is to print an error
      message and call [exit 1]. *)

    method read_string :
      ?obsoletes:string ->
      ?no_default:bool ->
      ?on_type_error:
        (groupable_cp -> Raw.cp -> (out_channel -> unit) -> string -> unit) ->
      string ->
      unit
    (** [read_string string] reads the content of [string] and stores the values
       it specifies into the cps belonging to this group.

        This method behaves just like read for the others aspects. *)

    method command_line_args :
      section_separator:string -> (string * Arg.spec * string) list
    (** Interface with module Arg.

       @param section_separator the string used to concatenate the name of a cp,
              to get the command line option name. ["-"] is a good default.

       @return a list that can be used with [Arg.parse] and [Arg.usage]. *)
  end

(** {2:predefined_cp_classes Predefined cp classes} *)

(** The last three non-optional arguments are always [name] (of type string
   list), [default_value] and [help] (of type string).

   [name] is the path to the cp: [["section";"subsection"; ...; "foo"]]. It can
   consists of a single element but must not be empty.

   [short_name] will be added a "-" and used in
   {!Config_file.group.command_line_args}.

   [group], if provided, adds the freshly defined option to it (something like
   [initializer group#add self]).

   [help] needs not contain newlines, it will be automatically truncated where
    needed. It is mandatory but can be [""]. *)

class int_cp :
  ?group:group -> string list -> ?short_name:string -> int -> string -> [int] cp

class float_cp :
  ?group:group
  -> string list
  -> ?short_name:string
  -> float
  -> string
  -> [float] cp

class bool_cp :
  ?group:group
  -> string list
  -> ?short_name:string
  -> bool
  -> string
  -> [bool] cp

class string_cp :
  ?group:group
  -> string list
  -> ?short_name:string
  -> string
  -> string
  -> [string] cp

class ['a] list_cp :
  'a wrappers
  -> ?group:group
  -> string list
  -> ?short_name:string
  -> 'a list
  -> string
  -> ['a list] cp

class ['a] option_cp :
  'a wrappers
  -> ?group:group
  -> string list
  -> ?short_name:string
  -> 'a option
  -> string
  -> ['a option] cp

class ['a] enumeration_cp :
  (string * 'a) list
  -> ?group:group
  -> string list
  -> ?short_name:string
  -> 'a
  -> string
  -> ['a] cp

class ['a, 'b] tuple2_cp :
  'a wrappers
  -> 'b wrappers
  -> ?group:group
  -> string list
  -> ?short_name:string
  -> 'a * 'b
  -> string
  -> ['a * 'b] cp

class ['a, 'b, 'c] tuple3_cp :
  'a wrappers
  -> 'b wrappers
  -> 'c wrappers
  -> ?group:group
  -> string list
  -> ?short_name:string
  -> 'a * 'b * 'c
  -> string
  -> ['a * 'b * 'c] cp

class ['a, 'b, 'c, 'd] tuple4_cp :
  'a wrappers
  -> 'b wrappers
  -> 'c wrappers
  -> 'd wrappers
  -> ?group:group
  -> string list
  -> ?short_name:string
  -> 'a * 'b * 'c * 'd
  -> string
  -> ['a * 'b * 'c * 'd] cp

class string2_cp :
  ?group:group
  -> string list
  -> ?short_name:string
  -> string * string
  -> string
  -> [string, string] tuple2_cp

(* class color_cp : ?group:group -> string list -> ?short_name:string -> string -> string -> string_cp *)
class font_cp :
  ?group:group
  -> string list
  -> ?short_name:string
  -> string
  -> string
  -> string_cp

class filename_cp :
  ?group:group
  -> string list
  -> ?short_name:string
  -> string
  -> string
  -> string_cp

(** {2:predefined_wrappers Predefined wrappers} *)

val int_wrappers : int wrappers

val float_wrappers : float wrappers

val bool_wrappers : bool wrappers

val string_wrappers : string wrappers

val list_wrappers : 'a wrappers -> 'a list wrappers

val option_wrappers : 'a wrappers -> 'a option wrappers

val enumeration_wrappers : (string * 'a) list -> 'a wrappers
(** If you have a [type suit = Spades | Hearts | Diamond | Clubs], then
{[
enumeration_wrappers
  ["spades",Spades; "hearts",Hearts; "diamond",Diamond; "clubs",Clubs]
]}
   will allow you to use cp of this type. For sum types with not only constant
   constructors, you will need to define your own cp class. *)

val tuple2_wrappers : 'a wrappers -> 'b wrappers -> ('a * 'b) wrappers

val tuple3_wrappers :
  'a wrappers -> 'b wrappers -> 'c wrappers -> ('a * 'b * 'c) wrappers

val tuple4_wrappers :
  'a wrappers ->
  'b wrappers ->
  'c wrappers ->
  'd wrappers ->
  ('a * 'b * 'c * 'd) wrappers

(** {2 Defining new cp classes} *)

class ['a] cp_custom_type :
  'a wrappers
  -> ?group:group
  -> string list
  -> ?short_name:string
  -> 'a
  -> string
  -> ['a] cp
(** To define a new cp class, you just have to provide an implementation for the
   wrappers between your type [foo] and the type {!Raw.cp}.


   Once you have your wrappers [w], write
{[
class foo_cp = [foo] cp_custom_type w
]}

   For further details, have a look at the commented .ml file, section
   {!section:predefined_cp_classes}. *)

(** {1 Backward compatibility}

   All the functions from the module Options are available, except:

   - [prune_file]: use [group#write ?obsoletes:"foo.ml"].
   - [smalllist_to_value], [smalllist_option]: use lists or tuples.
   - [get_class].
   - [class_hook]: hooks are local to a cp. If you want hooks global to a class,
     define a new class that inherits from {!Config_file.cp_custom_type}.
   - [set_simple_option], [get_simple_option], [simple_options], [simple_args]:
     use {!Config_file.group.write}.
   - [set_option_hook]: use {!Config_file.cp.add_hook}.
   - [set_string_wrappers]: define a new class with {!Config_file.cp_custom_type}.

   The old configurations files are readable by this module.

   @deprecated *)

(**/**)

type 'a option_class

type 'a option_record

type options_file

val create_options_file : string -> options_file

val set_options_file : options_file -> string -> unit

val load : options_file -> unit

val append : options_file -> string -> unit

val save : options_file -> unit

val save_with_help : options_file -> unit

(* val define_option : options_file -> *)
(*   string list ->  string -> 'a option_class -> 'a -> 'a option_record *)
val option_hook : 'a option_record -> (unit -> unit) -> unit

val string_option : string option_class

val color_option : string option_class

val font_option : string option_class

val int_option : int option_class

val bool_option : bool option_class

val float_option : float option_class

val string2_option : (string * string) option_class

val option_option : 'a option_class -> 'a option option_class

val list_option : 'a option_class -> 'a list option_class

val sum_option : (string * 'a) list -> 'a option_class

val tuple2_option : 'a option_class * 'b option_class -> ('a * 'b) option_class

val tuple3_option :
  'a option_class * 'b option_class * 'c option_class ->
  ('a * 'b * 'c) option_class

val tuple4_option :
  'a option_class * 'b option_class * 'c option_class * 'd option_class ->
  ('a * 'b * 'c * 'd) option_class

val ( !! ) : 'a option_record -> 'a

val ( =:= ) : 'a option_record -> 'a -> unit

val shortname : 'a option_record -> string

val get_help : 'a option_record -> string

type option_value =
  | Module of option_module
  | StringValue of string
  | IntValue of int
  | FloatValue of float
  | List of option_value list
  | SmallList of option_value list

and option_module = (string * option_value) list

val define_option_class :
  string -> (option_value -> 'a) -> ('a -> option_value) -> 'a option_class

val to_value : 'a option_class -> 'a -> option_value

val from_value : 'a option_class -> option_value -> 'a

val value_to_string : option_value -> string

val string_to_value : string -> option_value

val value_to_int : option_value -> int

val int_to_value : int -> option_value

val bool_of_string : string -> bool

val value_to_bool : option_value -> bool

val bool_to_value : bool -> option_value

val value_to_float : option_value -> float

val float_to_value : float -> option_value

val value_to_string2 : option_value -> string * string

val string2_to_value : string * string -> option_value

val value_to_list : (option_value -> 'a) -> option_value -> 'a list

val list_to_value : ('a -> option_value) -> 'a list -> option_value