Merge pull request #50 from gasche/render-with-locations

Render with locations

Author: gasche

lib/mustache.ml

@@ -299,72 +299,24 @@ module Lookup = struct
 
 end
 
-(* Packing up everything in two modules of similar signature:
-   [Without_locations] and [With_locations]. In the toplevel signature, only
-   [With_locations] appears, and [Without_locations] contents are directly
-   included at the toplevel.
-*)
-
-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.indent p.name p.contents
-
-  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 ?(indent = 0) n c = Partial { indent ; name = n ; contents = c }
-  let concat t = Concat t
-  let comment s = Comment s
-
-  let rec expand_partials (partials : name -> t option) : t -> t =
-    let section ~inverted =
-      if inverted then inverted_section else section
-    in
-    let partial indent name contents =
-      let contents' = lazy (
-        match Lazy.force contents with
-        | None -> option_map (partials name) (expand_partials partials)
-        | Some t_opt -> Some t_opt
-      )
-      in
-      partial ~indent name contents'
-    in
-    fold ~string:raw ~section ~escaped ~unescaped ~partial ~comment ~concat
-
-  (* Rendering: defined on the ast without locations. *)
-
-  let render_buf
+module Render = struct
+  (* Rendering is defined on the ast without locations. *)
+
+  open Locs
+
+  (* Render a template whose partials have already been expanded.
+
+     Note: the reason we expand partials once before rendering,
+     instead of expanding on the fly during rendering, is to avoid
+     expanding many times the partials that are inside a list. However,
+     this as the consequence that some partials that may not be used
+     in a given rendering may be expanded, and that partial expansion
+     cannot have access to the specific context of each partial usage
+     -- some other Mustache APIs pass this context information to the
+     partial-resolution function. *)
+  let render_expanded
         ?(strict = true)
-        ?(partials = fun _ -> None)
-        (buf : Buffer.t) (m : No_locs.t) (js : Json.t)
+        (buf : Buffer.t) (m : Locs.t) (js : Json.t)
     =
     let print_indent indent =
       for _ = 0 to indent - 1 do
@@ -394,7 +346,7 @@ module Without_locations = struct
       ) (List.tl lines)
     in
 
-    let rec render' indent m (ctxs : Contexts.t) = match m with
+    let rec render indent m (ctxs : Contexts.t) = match m.desc with
 
       | String s ->
         print_indented_string indent s
@@ -409,10 +361,10 @@ module Without_locations = struct
 
       | Inverted_section s ->
         if Lookup.inverted ctxs s.name
-        then render' indent s.contents ctxs
+        then render indent s.contents ctxs
 
       | Section s ->
-        let enter ctx = render' indent s.contents (Contexts.add ctxs ctx) in
+        let enter ctx = render indent s.contents (Contexts.add ctxs ctx) in
         begin match Lookup.section ~strict ctxs ~key:s.name with
         | `Bool false -> ()
         | `A elems    -> List.iter enter elems
@@ -421,17 +373,83 @@ module Without_locations = struct
 
       | Partial { indent = partial_indent; name; contents } ->
         begin match (Lazy.force contents, strict) with
-        | Some p, _ -> render' (indent + partial_indent) p ctxs
+        | Some p, _ -> render (indent + partial_indent) p ctxs
         | None, false -> ()
         | None, true -> raise (Missing_partial name)
         end
 
       | Comment _c -> ()
 
       | Concat templates ->
-        List.iter (fun x -> render' indent x ctxs) templates
+        List.iter (fun x -> render indent x ctxs) templates
+
+    in render 0 m (Contexts.start (Json.value js))
+end
+
+(* Packing up everything in two modules of similar signature:
+   [Without_locations] and [With_locations]. In the toplevel signature, only
+   [With_locations] appears, and [Without_locations] contents are directly
+   included at the toplevel.
+*)
 
-    in render' 0 (expand_partials partials m) (Contexts.start (Json.value js))
+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.indent p.name p.contents
+
+  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 ?(indent = 0) n c = Partial { indent ; name = n ; contents = c }
+  let concat t = Concat t
+  let comment s = Comment s
+
+  let rec expand_partials (partials : name -> t option) : t -> t =
+    let section ~inverted =
+      if inverted then inverted_section else section
+    in
+    let partial indent name contents =
+      let contents' = lazy (
+        match Lazy.force contents with
+        | None -> option_map (partials name) (expand_partials partials)
+        | Some t_opt -> Some t_opt
+      )
+      in
+      partial ~indent name contents'
+    in
+    fold ~string:raw ~section ~escaped ~unescaped ~partial ~comment ~concat
+
+
+  let render_buf ?strict ?(partials = fun _ -> None) buf (m : t) (js : Json.t) =
+    let m = add_dummy_locs (expand_partials partials m) in
+    Render.render_expanded buf ?strict m js
 
   let render ?strict ?partials (m : t) (js : Json.t) =
     let buf = Buffer.create 0 in
@@ -456,27 +474,6 @@ module With_locations = struct
 
   let to_string x = to_string (erase_locs x)
 
-  let partials_erase_locs partials =
-    option_map partials (fun f name -> option_map (f name) erase_locs)
-
-  let render_fmt ?strict ?partials fmt m js =
-    Without_locations.render_fmt
-      ?strict
-      ?partials:(partials_erase_locs partials)
-      fmt (erase_locs m) js
-
-  let render_buf ?strict ?partials fmt m js =
-    Without_locations.render_buf
-      ?strict
-      ?partials:(partials_erase_locs partials)
-      fmt (erase_locs m) js
-
-  let render ?strict ?partials m js =
-    Without_locations.render
-      ?strict
-      ?partials:(partials_erase_locs partials)
-      (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
@@ -526,6 +523,20 @@ module With_locations = struct
       partial ~loc ~indent name contents'
     in
     fold ~string:raw ~section ~escaped ~unescaped ~partial ~comment ~concat
+
+  let render_buf ?strict ?(partials = fun _ -> None) buf (m : t) (js : Json.t) =
+    let m = expand_partials partials m in
+    Render.render_expanded buf ?strict m js
+
+  let render ?strict ?partials (m : t) (js : Json.t) =
+    let buf = Buffer.create 0 in
+    render_buf ?strict ?partials buf m js ;
+    Buffer.contents buf
+
+  let render_fmt ?strict ?partials fmt m js =
+    let str = render ?strict ?partials m js in
+    Format.pp_print_string fmt str;
+    Format.pp_print_flush fmt ()
 end