Skip to content
This repository
Newer
Older
100644 200 lines (144 sloc) 3.109 kb
991ccf11 »
2012-04-29 Initial import of Ohm
1 (* Ohm is © 2011 Victor Nicollet *)
2
3 open Util
4
5 module Node = Fmt.Make(struct
6
7 type json t =
8 [ `String "string" of string_node
9 | `Bool "bool" of bool_node
10 | `Dict "dict" of dict_node
11 | `Option "option" of option_node
12 | `Array "array" of array_node
13 | `Object "object" of object_node
14 | `Variant "variant" of variant_node
15 | `Label "label" of label_node
16 | `Tuple "tuple" of tuple_node ]
17
18
19 and dict_node = <
20 content : t
21 >
22
23 and label_node = <
24 label : string ;
25 content : t
26 >
27
28 and bool_node = <
29 ignored : int
30 >
31
32 and option_node = <
33 content : t
34 >
35
36 and tuple_node = <
37 fields : (string * t) list
38 >
39
40 and variant_node = <
41 variants: (string * variant) assoc
42 >
43
44 and variant = <
45 label : string ;
46 content : t option
47 >
48
49 and object_node = <
50 fields : (string * field) assoc
51 >
52
53 and field = <
54 label : string ;
55 content : t
56 >
57
58 and array_node = <
59 sortable : bool ;
60 validators : [ `min of int
61 | `max of int
62 ] list ;
63 content : t
64 >
65
66 and string_node = <
67 autocomplete: string option ;
68 editor: [ `line
69 | `area
70 ] ;
71 validators: [ `min of int
72 | `max of int
73 ] list
74 >
75 end)
76
77 type t = Node.t
78
79 type alternative = string * <
80 label : string ;
81 content : t option
82 >
83
84 type field = string * <
85 label : string ;
86 content : t
87 >
88
89 let string ?(editor=`line) ?(validators=[]) ?autocomplete () =
90
91 let obj = object
92 method autocomplete = autocomplete
93 method editor = editor
94 method validators = validators
95 end in
96
97 `String obj
98
99 let array ?(sortable=true) ?(validators=[]) content =
100
101 let obj = object
102 method sortable = sortable
103 method validators = validators
104 method content = content
105 end in
106
107 `Array obj
108
109 let dict content =
110
111 let obj = object
112 method content = content
113 end in
114
115 `Dict obj
116
117 let label label content =
118
119 let obj = object
120 method label = label
121 method content = content
122 end in
123
124 `Label obj
125
126 let optional content =
127
128 let obj = object
129 method content = content
130 end in
131
132 `Option obj
133
134 let bool =
135
136 let obj = object
137 method ignored = 0
138 end in
139
140 `Bool obj
141
142 let field name ?label content =
143
144 let obj = object
145 method label = BatOption.default name label
146 method content = content
147 end in
148
149 (name, obj)
150
151 let obj fields =
152
153 let obj = object
154 method fields = fields
155 end in
156
157 `Object obj
158
159 let alternative ?content ?label name =
160
161 let obj = object
162 method label = BatOption.default name label
163 method content = content
164 end in
165
166 (name, obj)
167
168 let variant alternatives =
169
170 let obj = object
171 method variants = alternatives
172 end in
173
174 `Variant obj
175
176 let tuple fields =
177
178 let obj = object
179 method fields = fields
180 end in
181
182 `Tuple obj
183
184 module type FMT = sig
185 val edit : t
186 include Fmt.FMT
187 end
188
189 module Make = functor(Type : sig
190 val edit : t
191 type t
192 val t_of_json : Json_type.t -> t
193 val json_of_t : t -> Json_type.t
194 end) -> struct
195
196 let edit = Type.edit
197 include Fmt.Make(Type)
198
199 end
Something went wrong with that request. Please try again.