Skip to content

Commit

Permalink
Merge pull request #21 from Armael/master
Browse files Browse the repository at this point in the history 
Keep track of locations in the AST
  • Loading branch information
@rgrinberg
rgrinberg authored Feb 26, 2017
2 parents a299314 + a722d70 commit 207dbfa
Show file tree
Hide file tree
Showing 6 changed files with 376 additions and 83 deletions.
212 changes: 168 additions & 44 deletions lib/mustache.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,10 +25,6 @@ include Mustache_types
module List = ListLabels
module String = StringLabels

module Infix = struct
let (^) y x = Concat [x; y]
end

module Json = struct
type value =
[ `Null
Expand All @@ -45,9 +41,6 @@ module Json = struct
let value: t -> value = fun t -> (t :> value)
end

let parse_lx = Mustache_parser.mustache Mustache_lexer.mustache
let of_string s = parse_lx (Lexing.from_string s)

let escape_html s =
let b = Buffer.create (String.length s) in
String.iter ( function
Expand All @@ -60,8 +53,48 @@ let escape_html s =
) s ;
Buffer.contents b

let rec pp fmt = function

(* Utility functions that allow converting between the ast with locations and
without locations. *)

let dummy_loc =
{ Locs.loc_start = Lexing.dummy_pos;
Locs.loc_end = Lexing.dummy_pos }

let rec erase_locs { Locs.desc; _ } =
erase_locs_desc desc
and erase_locs_desc = function
| Locs.String s -> No_locs.String s
| Locs.Escaped s -> No_locs.Escaped s
| Locs.Section s -> No_locs.Section (erase_locs_section s)
| Locs.Unescaped s -> No_locs.Unescaped s
| Locs.Partial s -> No_locs.Partial s
| Locs.Inverted_section s -> No_locs.Inverted_section (erase_locs_section s)
| Locs.Concat l -> No_locs.Concat (List.map erase_locs l)
| Locs.Comment s -> No_locs.Comment s
and erase_locs_section { Locs.name; Locs.contents } =
{ No_locs.name; No_locs.contents = erase_locs contents }

let rec add_dummy_locs t =
{ Locs.loc = dummy_loc;
Locs.desc = add_dummy_locs_desc t }
and add_dummy_locs_desc = function
| No_locs.String s -> Locs.String s
| No_locs.Escaped s -> Locs.Escaped s
| No_locs.Section s -> Locs.Section (add_dummy_locs_section s)
| No_locs.Unescaped s -> Locs.Unescaped s
| No_locs.Partial s -> Locs.Partial s
| No_locs.Inverted_section s ->
Locs.Inverted_section (add_dummy_locs_section s)
| No_locs.Concat l -> Locs.Concat (List.map add_dummy_locs l)
| No_locs.Comment s -> Locs.Comment s
and add_dummy_locs_section { No_locs.name; No_locs.contents } =
{ Locs.name; Locs.contents = add_dummy_locs contents }

(* Printing: defined on the ast without locations. *)

let rec pp fmt =
let open No_locs in
function
| String s ->
Format.pp_print_string fmt s

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

let to_formatter = pp

let to_string x =
let b = Buffer.create 0 in
let fmt = Format.formatter_of_buffer b in
pp fmt x ;
Format.pp_print_flush fmt () ;
Buffer.contents b

let rec fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat t =
let go = fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat in
match t with
| String s -> string s
| Escaped s -> escaped s
| Unescaped s -> unescaped s
| Comment s -> comment s
| Section { name; contents } ->
section ~inverted:false name (go contents)
| Inverted_section { name; contents } ->
section ~inverted:true name (go contents)
| Concat ms ->
concat (List.map ms ~f:go)
| Partial p -> partial p

let raw s = String s
let escaped s = Escaped s
let unescaped s = Unescaped s
let section n c = Section { name = n ; contents = c }
let inverted_section n c = Inverted_section { name = n ; contents = c }
let partial s = Partial s
let concat t = Concat t
let comment s = Comment s

let rec expand_partials =
let section ~inverted =
if inverted then inverted_section else section
in
fun partial ->
fold ~string:raw ~section ~escaped ~unescaped ~partial ~comment ~concat
(* Rendering: defined on the ast without locations. *)

module Lookup = struct
let scalar ?(strict=true) = function
Expand Down Expand Up @@ -172,8 +174,8 @@ module Lookup = struct

end

let render_fmt ?(strict=true) (fmt : Format.formatter) (m : t) (js : Json.t) =

let render_fmt ?(strict=true) (fmt : Format.formatter) (m : No_locs.t) (js : Json.t) =
let open No_locs in
let rec render' m (js : Json.value) = match m with

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

in render' m (Json.value js)

let render ?(strict=true) (m : t) (js : Json.t) =
let render ?(strict=true) (m : No_locs.t) (js : Json.t) =
let b = Buffer.create 0 in
let fmt = Format.formatter_of_buffer b in
render_fmt ~strict fmt m js ;
Format.pp_print_flush fmt () ;
Buffer.contents b

(* Parsing: produces an ast with locations. *)

let parse_lx : Lexing.lexbuf -> Locs.t =
Mustache_parser.mustache Mustache_lexer.mustache

let of_string s = parse_lx (Lexing.from_string s)

(* Packing up everything in two modules of similar signature:
[With_locations] and [Without_locations].
*)

module With_locations = struct
include Locs

let dummy_loc = dummy_loc
let parse_lx = parse_lx
let of_string = of_string

let pp fmt x = pp fmt (erase_locs x)
let to_formatter = pp

let to_string x = to_string (erase_locs x)

let render_fmt ?strict fmt m js =
render_fmt ?strict fmt (erase_locs m) js

let render ?strict m js =
render ?strict (erase_locs m) js

let rec fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat t =
let go = fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat in
let { desc; loc } = t in
match desc with
| String s -> string ~loc s
| Escaped s -> escaped ~loc s
| Unescaped s -> unescaped ~loc s
| Comment s -> comment ~loc s
| Section { name; contents } ->
section ~loc ~inverted:false name (go contents)
| Inverted_section { name; contents } ->
section ~loc ~inverted:true name (go contents)
| Concat ms ->
concat ~loc (List.map ms ~f:go)
| Partial p -> partial ~loc p

module Infix = struct
let (^) t1 t2 = { desc = Concat [t1; t2]; loc = dummy_loc }
end

let raw ~loc s = { desc = String s; loc }
let escaped ~loc s = { desc = Escaped s; loc }
let unescaped ~loc s = { desc = Unescaped s; loc }
let section ~loc n c =
{ desc = Section { name = n; contents = c };
loc }
let inverted_section ~loc n c =
{ desc = Inverted_section { name = n; contents = c };
loc }
let partial ~loc s = { desc = Partial s; loc }
let concat ~loc t = { desc = Concat t; loc }
let comment ~loc s = { desc = Comment s; loc }

let rec expand_partials =
let section ~loc ~inverted =
if inverted then inverted_section ~loc else section ~loc
in
fun partial ->
fold ~string:raw ~section ~escaped ~unescaped ~partial ~comment ~concat
end

module Without_locations = struct
include No_locs

let parse_lx lexbuf = erase_locs (parse_lx lexbuf)
let of_string s = erase_locs (of_string s)

let pp = pp
let to_formatter = pp

let to_string = to_string

let rec fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat t =
let go = fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat in
match t with
| String s -> string s
| Escaped s -> escaped s
| Unescaped s -> unescaped s
| Comment s -> comment s
| Section { name; contents } ->
section ~inverted:false name (go contents)
| Inverted_section { name; contents } ->
section ~inverted:true name (go contents)
| Concat ms ->
concat (List.map ms ~f:go)
| Partial p -> partial p

module Infix = struct
let (^) y x = Concat [x; y]
end

let raw s = String s
let escaped s = Escaped s
let unescaped s = Unescaped s
let section n c = Section { name = n ; contents = c }
let inverted_section n c = Inverted_section { name = n ; contents = c }
let partial s = Partial s
let concat t = Concat t
let comment s = Comment s

let rec expand_partials =
let section ~inverted =
if inverted then inverted_section else section
in
fun partial ->
fold ~string:raw ~section ~escaped ~unescaped ~partial ~comment ~concat
end

(* Include [Without_locations] at the toplevel, to preserve backwards
compatibility of the API. *)

include Without_locations
116 changes: 114 additions & 2 deletions lib/mustache.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,8 +30,8 @@ type t =
| Concat of t list
| Comment of string
and section =
{ name: string
; contents: t }
{ name: string;
contents: t }

(** Read *)
val parse_lx : Lexing.lexbuf -> t
Expand Down Expand Up @@ -111,3 +111,115 @@ val comment : string -> t

(** Group a [t list] as a single [t]. *)
val concat : t list -> t

(** Variant of the [t] mustache datatype which includes source-file locations,
and associated functions. *)
module With_locations : sig
type loc =
{ loc_start: Lexing.position;
loc_end: Lexing.position }

type desc =
| String of string
| Escaped of string
| Section of section
| Unescaped of string
| Partial of string
| Inverted_section of section
| Concat of t list
| Comment of string
and section =
{ name: string;
contents: t }
and t =
{ loc : loc;
desc : desc }

(** A value of type [loc], guaranteed to be different from any valid
location. *)
val dummy_loc : loc

(** Read *)
val parse_lx : Lexing.lexbuf -> t
val of_string : string -> t

(** [pp fmt template] print a template as raw mustache to
the formatter [fmt]. *)
val pp : Format.formatter -> t -> unit

val to_formatter : Format.formatter -> t -> unit
(** Alias for compatibility *)

(** [to_string template] uses [to_formatter] in order to return
a string representing the template as raw mustache. *)
val to_string : t -> string

(** [render_fmt fmt template json] render [template], filling it
with data from [json], printing it to formatter [fmt]. *)
val render_fmt : ?strict:bool -> Format.formatter -> t -> Json.t -> unit

(** [render template json] use [render_fmt] to render [template]
with data from [json] and returns the resulting string. *)
val render : ?strict:bool -> t -> Json.t -> string

(** [fold template] is the composition of [f] over parts of [template], called
in order of occurrence, where each [f] is one of the labelled arguments
applied to the corresponding part. The default for [f] is the identity
function.
@param string Applied to each literal part of the template.
@param escaped Applied to ["name"] for occurrences of [{{name}}].
@param unescaped Applied to ["name"] for occurrences of [{{{name}}}].
@param partial Applied to ["box"] for occurrences of [{{> box}}].
@param comment Applied to ["comment"] for occurrences of [{{! comment}}]. *)
val fold : string: (loc:loc -> string -> 'a) ->
section: (loc:loc -> inverted:bool -> string -> 'a -> 'a) ->
escaped: (loc:loc -> string -> 'a) ->
unescaped: (loc:loc -> string -> 'a) ->
partial: (loc:loc -> string -> 'a) ->
comment: (loc:loc -> string -> 'a) ->
concat:(loc:loc -> 'a list -> 'a) ->
t -> 'a

val expand_partials : (loc:loc -> string -> t) -> t -> t
(** [expand_partials f template] is [template] with [f p] substituted for each
partial [p]. *)

(** Shortcut for concatening two templates pieces. *)
module Infix : sig
(** The location of the created [Concat] node has location [dummy_loc].
Use [concat] to provide a location. *)
val (^) : t -> t -> t
end

(** [<p>This is raw text.</p>] *)
val raw : loc:loc -> string -> t

(** [{{name}}] *)
val escaped : loc:loc -> string -> t

(** [{{{name}}}] *)
val unescaped : loc:loc -> string -> t

(** [{{^person}} {{/person}}] *)
val inverted_section : loc:loc -> string -> t -> t

(** [{{#person}} {{/person}}] *)
val section : loc:loc -> string -> t -> t

(** [{{> box}}] *)
val partial : loc:loc -> string -> t

(** [{{! this is a comment}}] *)
val comment : loc:loc -> string -> t

(** Group a [t list] as a single [t]. *)
val concat : loc:loc -> t list -> t
end

(** Erase locations from a mustache value of type [With_locations.t]. *)
val erase_locs : With_locations.t -> t

(** Add the [dummy_loc] location to each node of a mustache value of type
[t]. *)
val add_dummy_locs : t -> With_locations.t
Loading

0 comments on commit 207dbfa

Please sign in to comment.