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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
(*********************************************************************************)
(* 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 *)
(* *)
(*********************************************************************************)
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 ~section_separator:"-") "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; 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
|
