Skip to content

Commit 207dbfa

Browse files
rgrinbergrgrinberg
authored
Merge pull request #21 from Armael/master
Keep track of locations in the AST
2 parents a299314 + a722d70 commit 207dbfa

File tree

6 files changed

+376
-83
lines changed

6 files changed

+376
-83
lines changed

‎lib/mustache.ml

+168-44
Original file line numberDiff line numberDiff line change
@@ -25,10 +25,6 @@ include Mustache_types
2525
module List = ListLabels
2626
module String = StringLabels
2727

28-
module Infix = struct
29-
let (^) y x = Concat [x; y]
30-
end
31-
3228
module Json = struct
3329
type value =
3430
[ `Null
@@ -45,9 +41,6 @@ module Json = struct
4541
let value: t -> value = fun t -> (t :> value)
4642
end
4743

48-
let parse_lx = Mustache_parser.mustache Mustache_lexer.mustache
49-
let of_string s = parse_lx (Lexing.from_string s)
50-
5144
let escape_html s =
5245
let b = Buffer.create (String.length s) in
5346
String.iter ( function
@@ -60,8 +53,48 @@ let escape_html s =
6053
) s ;
6154
Buffer.contents b
6255

63-
let rec pp fmt = function
64-
56+
(* Utility functions that allow converting between the ast with locations and
57+
without locations. *)
58+
59+
let dummy_loc =
60+
{ Locs.loc_start = Lexing.dummy_pos;
61+
Locs.loc_end = Lexing.dummy_pos }
62+
63+
let rec erase_locs { Locs.desc; _ } =
64+
erase_locs_desc desc
65+
and erase_locs_desc = function
66+
| Locs.String s -> No_locs.String s
67+
| Locs.Escaped s -> No_locs.Escaped s
68+
| Locs.Section s -> No_locs.Section (erase_locs_section s)
69+
| Locs.Unescaped s -> No_locs.Unescaped s
70+
| Locs.Partial s -> No_locs.Partial s
71+
| Locs.Inverted_section s -> No_locs.Inverted_section (erase_locs_section s)
72+
| Locs.Concat l -> No_locs.Concat (List.map erase_locs l)
73+
| Locs.Comment s -> No_locs.Comment s
74+
and erase_locs_section { Locs.name; Locs.contents } =
75+
{ No_locs.name; No_locs.contents = erase_locs contents }
76+
77+
let rec add_dummy_locs t =
78+
{ Locs.loc = dummy_loc;
79+
Locs.desc = add_dummy_locs_desc t }
80+
and add_dummy_locs_desc = function
81+
| No_locs.String s -> Locs.String s
82+
| No_locs.Escaped s -> Locs.Escaped s
83+
| No_locs.Section s -> Locs.Section (add_dummy_locs_section s)
84+
| No_locs.Unescaped s -> Locs.Unescaped s
85+
| No_locs.Partial s -> Locs.Partial s
86+
| No_locs.Inverted_section s ->
87+
Locs.Inverted_section (add_dummy_locs_section s)
88+
| No_locs.Concat l -> Locs.Concat (List.map add_dummy_locs l)
89+
| No_locs.Comment s -> Locs.Comment s
90+
and add_dummy_locs_section { No_locs.name; No_locs.contents } =
91+
{ Locs.name; Locs.contents = add_dummy_locs contents }
92+
93+
(* Printing: defined on the ast without locations. *)
94+
95+
let rec pp fmt =
96+
let open No_locs in
97+
function
6598
| String s ->
6699
Format.pp_print_string fmt s
67100

@@ -88,45 +121,14 @@ let rec pp fmt = function
88121
| Concat s ->
89122
List.iter (pp fmt) s
90123

91-
let to_formatter = pp
92-
93124
let to_string x =
94125
let b = Buffer.create 0 in
95126
let fmt = Format.formatter_of_buffer b in
96127
pp fmt x ;
97128
Format.pp_print_flush fmt () ;
98129
Buffer.contents b
99130

100-
let rec fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat t =
101-
let go = fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat in
102-
match t with
103-
| String s -> string s
104-
| Escaped s -> escaped s
105-
| Unescaped s -> unescaped s
106-
| Comment s -> comment s
107-
| Section { name; contents } ->
108-
section ~inverted:false name (go contents)
109-
| Inverted_section { name; contents } ->
110-
section ~inverted:true name (go contents)
111-
| Concat ms ->
112-
concat (List.map ms ~f:go)
113-
| Partial p -> partial p
114-
115-
let raw s = String s
116-
let escaped s = Escaped s
117-
let unescaped s = Unescaped s
118-
let section n c = Section { name = n ; contents = c }
119-
let inverted_section n c = Inverted_section { name = n ; contents = c }
120-
let partial s = Partial s
121-
let concat t = Concat t
122-
let comment s = Comment s
123-
124-
let rec expand_partials =
125-
let section ~inverted =
126-
if inverted then inverted_section else section
127-
in
128-
fun partial ->
129-
fold ~string:raw ~section ~escaped ~unescaped ~partial ~comment ~concat
131+
(* Rendering: defined on the ast without locations. *)
130132

131133
module Lookup = struct
132134
let scalar ?(strict=true) = function
@@ -172,8 +174,8 @@ module Lookup = struct
172174

173175
end
174176

175-
let render_fmt ?(strict=true) (fmt : Format.formatter) (m : t) (js : Json.t) =
176-
177+
let render_fmt ?(strict=true) (fmt : Format.formatter) (m : No_locs.t) (js : Json.t) =
178+
let open No_locs in
177179
let rec render' m (js : Json.value) = match m with
178180

179181
| String s ->
@@ -211,9 +213,131 @@ let render_fmt ?(strict=true) (fmt : Format.formatter) (m : t) (js : Json.t) =
211213

212214
in render' m (Json.value js)
213215

214-
let render ?(strict=true) (m : t) (js : Json.t) =
216+
let render ?(strict=true) (m : No_locs.t) (js : Json.t) =
215217
let b = Buffer.create 0 in
216218
let fmt = Format.formatter_of_buffer b in
217219
render_fmt ~strict fmt m js ;
218220
Format.pp_print_flush fmt () ;
219221
Buffer.contents b
222+
223+
(* Parsing: produces an ast with locations. *)
224+
225+
let parse_lx : Lexing.lexbuf -> Locs.t =
226+
Mustache_parser.mustache Mustache_lexer.mustache
227+
228+
let of_string s = parse_lx (Lexing.from_string s)
229+
230+
(* Packing up everything in two modules of similar signature:
231+
[With_locations] and [Without_locations].
232+
*)
233+
234+
module With_locations = struct
235+
include Locs
236+
237+
let dummy_loc = dummy_loc
238+
let parse_lx = parse_lx
239+
let of_string = of_string
240+
241+
let pp fmt x = pp fmt (erase_locs x)
242+
let to_formatter = pp
243+
244+
let to_string x = to_string (erase_locs x)
245+
246+
let render_fmt ?strict fmt m js =
247+
render_fmt ?strict fmt (erase_locs m) js
248+
249+
let render ?strict m js =
250+
render ?strict (erase_locs m) js
251+
252+
let rec fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat t =
253+
let go = fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat in
254+
let { desc; loc } = t in
255+
match desc with
256+
| String s -> string ~loc s
257+
| Escaped s -> escaped ~loc s
258+
| Unescaped s -> unescaped ~loc s
259+
| Comment s -> comment ~loc s
260+
| Section { name; contents } ->
261+
section ~loc ~inverted:false name (go contents)
262+
| Inverted_section { name; contents } ->
263+
section ~loc ~inverted:true name (go contents)
264+
| Concat ms ->
265+
concat ~loc (List.map ms ~f:go)
266+
| Partial p -> partial ~loc p
267+
268+
module Infix = struct
269+
let (^) t1 t2 = { desc = Concat [t1; t2]; loc = dummy_loc }
270+
end
271+
272+
let raw ~loc s = { desc = String s; loc }
273+
let escaped ~loc s = { desc = Escaped s; loc }
274+
let unescaped ~loc s = { desc = Unescaped s; loc }
275+
let section ~loc n c =
276+
{ desc = Section { name = n; contents = c };
277+
loc }
278+
let inverted_section ~loc n c =
279+
{ desc = Inverted_section { name = n; contents = c };
280+
loc }
281+
let partial ~loc s = { desc = Partial s; loc }
282+
let concat ~loc t = { desc = Concat t; loc }
283+
let comment ~loc s = { desc = Comment s; loc }
284+
285+
let rec expand_partials =
286+
let section ~loc ~inverted =
287+
if inverted then inverted_section ~loc else section ~loc
288+
in
289+
fun partial ->
290+
fold ~string:raw ~section ~escaped ~unescaped ~partial ~comment ~concat
291+
end
292+
293+
module Without_locations = struct
294+
include No_locs
295+
296+
let parse_lx lexbuf = erase_locs (parse_lx lexbuf)
297+
let of_string s = erase_locs (of_string s)
298+
299+
let pp = pp
300+
let to_formatter = pp
301+
302+
let to_string = to_string
303+
304+
let rec fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat t =
305+
let go = fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat in
306+
match t with
307+
| String s -> string s
308+
| Escaped s -> escaped s
309+
| Unescaped s -> unescaped s
310+
| Comment s -> comment s
311+
| Section { name; contents } ->
312+
section ~inverted:false name (go contents)
313+
| Inverted_section { name; contents } ->
314+
section ~inverted:true name (go contents)
315+
| Concat ms ->
316+
concat (List.map ms ~f:go)
317+
| Partial p -> partial p
318+
319+
module Infix = struct
320+
let (^) y x = Concat [x; y]
321+
end
322+
323+
let raw s = String s
324+
let escaped s = Escaped s
325+
let unescaped s = Unescaped s
326+
let section n c = Section { name = n ; contents = c }
327+
let inverted_section n c = Inverted_section { name = n ; contents = c }
328+
let partial s = Partial s
329+
let concat t = Concat t
330+
let comment s = Comment s
331+
332+
let rec expand_partials =
333+
let section ~inverted =
334+
if inverted then inverted_section else section
335+
in
336+
fun partial ->
337+
fold ~string:raw ~section ~escaped ~unescaped ~partial ~comment ~concat
338+
end
339+
340+
(* Include [Without_locations] at the toplevel, to preserve backwards
341+
compatibility of the API. *)
342+
343+
include Without_locations

‎lib/mustache.mli

+114-2
Original file line numberDiff line numberDiff line change
@@ -30,8 +30,8 @@ type t =
3030
| Concat of t list
3131
| Comment of string
3232
and section =
33-
{ name: string
34-
; contents: t }
33+
{ name: string;
34+
contents: t }
3535

3636
(** Read *)
3737
val parse_lx : Lexing.lexbuf -> t
@@ -111,3 +111,115 @@ val comment : string -> t
111111

112112
(** Group a [t list] as a single [t]. *)
113113
val concat : t list -> t
114+
115+
(** Variant of the [t] mustache datatype which includes source-file locations,
116+
and associated functions. *)
117+
module With_locations : sig
118+
type loc =
119+
{ loc_start: Lexing.position;
120+
loc_end: Lexing.position }
121+
122+
type desc =
123+
| String of string
124+
| Escaped of string
125+
| Section of section
126+
| Unescaped of string
127+
| Partial of string
128+
| Inverted_section of section
129+
| Concat of t list
130+
| Comment of string
131+
and section =
132+
{ name: string;
133+
contents: t }
134+
and t =
135+
{ loc : loc;
136+
desc : desc }
137+
138+
(** A value of type [loc], guaranteed to be different from any valid
139+
location. *)
140+
val dummy_loc : loc
141+
142+
(** Read *)
143+
val parse_lx : Lexing.lexbuf -> t
144+
val of_string : string -> t
145+
146+
(** [pp fmt template] print a template as raw mustache to
147+
the formatter [fmt]. *)
148+
val pp : Format.formatter -> t -> unit
149+
150+
val to_formatter : Format.formatter -> t -> unit
151+
(** Alias for compatibility *)
152+
153+
(** [to_string template] uses [to_formatter] in order to return
154+
a string representing the template as raw mustache. *)
155+
val to_string : t -> string
156+
157+
(** [render_fmt fmt template json] render [template], filling it
158+
with data from [json], printing it to formatter [fmt]. *)
159+
val render_fmt : ?strict:bool -> Format.formatter -> t -> Json.t -> unit
160+
161+
(** [render template json] use [render_fmt] to render [template]
162+
with data from [json] and returns the resulting string. *)
163+
val render : ?strict:bool -> t -> Json.t -> string
164+
165+
(** [fold template] is the composition of [f] over parts of [template], called
166+
in order of occurrence, where each [f] is one of the labelled arguments
167+
applied to the corresponding part. The default for [f] is the identity
168+
function.
169+
170+
@param string Applied to each literal part of the template.
171+
@param escaped Applied to ["name"] for occurrences of [{{name}}].
172+
@param unescaped Applied to ["name"] for occurrences of [{{{name}}}].
173+
@param partial Applied to ["box"] for occurrences of [{{> box}}].
174+
@param comment Applied to ["comment"] for occurrences of [{{! comment}}]. *)
175+
val fold : string: (loc:loc -> string -> 'a) ->
176+
section: (loc:loc -> inverted:bool -> string -> 'a -> 'a) ->
177+
escaped: (loc:loc -> string -> 'a) ->
178+
unescaped: (loc:loc -> string -> 'a) ->
179+
partial: (loc:loc -> string -> 'a) ->
180+
comment: (loc:loc -> string -> 'a) ->
181+
concat:(loc:loc -> 'a list -> 'a) ->
182+
t -> 'a
183+
184+
val expand_partials : (loc:loc -> string -> t) -> t -> t
185+
(** [expand_partials f template] is [template] with [f p] substituted for each
186+
partial [p]. *)
187+
188+
(** Shortcut for concatening two templates pieces. *)
189+
module Infix : sig
190+
(** The location of the created [Concat] node has location [dummy_loc].
191+
Use [concat] to provide a location. *)
192+
val (^) : t -> t -> t
193+
end
194+
195+
(** [<p>This is raw text.</p>] *)
196+
val raw : loc:loc -> string -> t
197+
198+
(** [{{name}}] *)
199+
val escaped : loc:loc -> string -> t
200+
201+
(** [{{{name}}}] *)
202+
val unescaped : loc:loc -> string -> t
203+
204+
(** [{{^person}} {{/person}}] *)
205+
val inverted_section : loc:loc -> string -> t -> t
206+
207+
(** [{{#person}} {{/person}}] *)
208+
val section : loc:loc -> string -> t -> t
209+
210+
(** [{{> box}}] *)
211+
val partial : loc:loc -> string -> t
212+
213+
(** [{{! this is a comment}}] *)
214+
val comment : loc:loc -> string -> t
215+
216+
(** Group a [t list] as a single [t]. *)
217+
val concat : loc:loc -> t list -> t
218+
end
219+
220+
(** Erase locations from a mustache value of type [With_locations.t]. *)
221+
val erase_locs : With_locations.t -> t
222+
223+
(** Add the [dummy_loc] location to each node of a mustache value of type
224+
[t]. *)
225+
val add_dummy_locs : t -> With_locations.t

0 commit comments

Comments
 (0)