From 205d224da426c54f603066170a717b0db6458276 Mon Sep 17 00:00:00 2001
From: Frederic Bour <frederic.bour@lakaban.net>
Date: Tue, 19 Feb 2013 18:48:04 +0100
Subject: [PATCH] protocol: Factorize printing of locations

---
 browse.ml    | 5 ++---
 command.ml   | 7 ++-----
 protocol.ml  | 4 ++++
 protocol.mli | 1 +
 4 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/browse.ml b/browse.ml
index 0e38f1efae..cde164f75e 100644
--- a/browse.ml
+++ b/browse.ml
@@ -263,9 +263,8 @@ let rec dump_envs envs =
       | Envs.Modtype _ -> "modtype"
       | Envs.Other -> "??"
     in
-    `Assoc [
-      "start", Protocol.pos_to_json l.Location.loc_start;
-      "end", Protocol.pos_to_json l.Location.loc_end;
+    Protocol.with_location l
+    [
       "kind", `String kind;
       "children", dump_envs children
     ]
diff --git a/command.ml b/command.ml
index 0fb39e7734..3d1172a046 100644
--- a/command.ml
+++ b/command.ml
@@ -219,11 +219,8 @@ let command_type = {
       | Browse.Envs.T (loc,_,Browse.Envs.Expr e,_) :: rest ->
           let ppf, to_string = Misc.ppf_to_string () in
           Printtyp.type_expr ppf e;
-          let item = `Assoc [
-            "start", Protocol.pos_to_json loc.Location.loc_start;
-            "end", Protocol.pos_to_json loc.Location.loc_end;
-            "type", `String (to_string ());
-          ] in
+          let item = Protocol.with_location loc ["type", `String (to_string ())]
+          in
           item :: aux rest
       | _ :: rest -> aux rest
       | [] -> []
diff --git a/protocol.ml b/protocol.ml
index 09e84f7b78..487d6df52c 100644
--- a/protocol.ml
+++ b/protocol.ml
@@ -48,3 +48,7 @@ let pos_of_json = function
     end
   | _ -> failwith "Incorrect position"
 
+let with_location loc assoc =
+  `Assoc (("start", pos_to_json loc.Location.loc_start) ::
+          ("end",   pos_to_json loc.Location.loc_end) ::
+          assoc)
diff --git a/protocol.mli b/protocol.mli
index 04795a2b4c..4f32622d05 100644
--- a/protocol.mli
+++ b/protocol.mli
@@ -15,3 +15,4 @@ val error_catcher : (exn -> Json.json option) ref
 val make_pos : int * int -> Lexing.position
 val pos_to_json : Lexing.position -> Json.json
 val pos_of_json : Json.json -> Lexing.position
+val with_location : Location.t -> (string * Json.json) list -> Json.json