1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
(*********************************************************************************)
(* 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 *)
(* *)
(* Contact: Maxence.Guesdon@inria.fr *)
(* *)
(* *)
(*********************************************************************************)
open Config_file
let group = new group
(* We create a cp foo of type int. Its default value is 42: *)
let foo = new int_cp ~group ["foo"] 42 "Help about foo."
(* We create two other cp in section "section1": *)
let bar = new list_cp int_wrappers ~group ["section1";"bar"] [1;2;3;4] "Help about bar."
let baz = new tuple2_cp string_wrappers bool_wrappers ~group ["section1";"baz"] ("switch",true) "";;
(* We save them in file "temp.ml" and check the result: *)
group#write "temp.ml";;
Printf.printf "edit temp.ml and press enter...\n%!"; ignore (input_line stdin);
(* We load the file and play with the value of foo: *)
group#read "temp.ml";
Printf.printf "foo is %d\n%!" foo#get;
foo#set 28;
Printf.printf "foo is %d\n%!" foo#get;
(* How to define command line arguments and print them (see module Arg): *)
Arg.usage (group#command_line_args "-") "usage message"
(* We define a new type of cp: *)
let int64_wrappers = {
to_raw = (fun v -> Raw.String (Int64.to_string v));
of_raw = function
| Raw.Int v -> Int64.of_int v
| Raw.Float v -> Int64.of_float v
| Raw.String v -> Int64.of_string v
| r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
"Raw.Int expected, got %a\n%!" Raw.to_channel r))}
class int64_cp = [int64] cp_custom_type int64_wrappers
(* See the implementation for other examples *)
(* ********************************************************************** *)
(* Advanced usage *)
(* How to use group.read without failing on error:
In case [groupable_cp] doesn't get a suitable type, we just print a warning in foo.log
and discard the value from temp.ml (thus keeping the current value of [groupable_cp])*)
let log_file = open_out "foo.log";;
group#read
~on_type_error:
(fun groupable_cp raw_cp output filename in_channel ->
Printf.fprintf log_file
"Type error while loading configuration parameter %s from file %s.\n%!"
(String.concat "." groupable_cp#get_name) filename;
output log_file; (* get more information into log_file *)
)
"temp.ml"
(* Here is a more complex custom type. *)
type myrecord = {a:float; b:int list}
let myrecord_wrappers =
let b_to_raw = (list_wrappers int_wrappers).to_raw in
let b_of_raw = (list_wrappers int_wrappers).of_raw in
let field_of_option name = function
Some a -> a
| None -> Printf.eprintf "Field %s undefined\n%!" name; exit 1 in
let a = ref None and b = ref None in
{to_raw = (fun {a=a; b=b} ->
Raw.Section ["a", float_wrappers.to_raw a; "b", b_to_raw b]);
of_raw = function
| Raw.Section l ->
List.iter
(fun (name,value) -> match name with
| "a" -> a := Some value
| "b" -> b := Some value
| s -> Printf.eprintf "Unknown field %s\n%!" s)
l;
{a = float_wrappers.of_raw (field_of_option "a" !a);
b = b_of_raw (field_of_option "b" !b)}
| r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
"Raw.Section expected, got %a\n%!" Raw.to_channel r))}
class myrecord_cp = [myrecord] cp_custom_type myrecord_wrappers
|
