ppx_deriving.create: use [Ast_helper.with_default_loc] to derive create function with location info

CHANGELOG.md

@@ -1,3 +1,10 @@
+Unreleased
+-----
+
+* Add location info to `create`, `eq`, `iter`, `make`, `ord`, `show`
+  #297
+  (@arvidj)
+
 6.1.1
 -----
 

src_plugins/create/ppx_deriving_create.ml

@@ -120,9 +120,17 @@ let sig_of_type ({ ptype_loc = loc } as type_decl) =
   [Sig.value (Val.mk (mknoloc (Ppx_deriving.mangle_type_decl (`Prefix deriver) type_decl)) typ)]
 
 let impl_generator = Deriving.Generator.V2.make_noarg (fun ~ctxt:_ (_, type_decls) ->
+  let str_of_type type_decl =
+    Ast_helper.with_default_loc type_decl.ptype_loc @@
+      fun () -> str_of_type type_decl
+  in
   [Str.value Nonrecursive (List.concat (List.map str_of_type type_decls))])
 
 let intf_generator = Deriving.Generator.V2.make_noarg (fun ~ctxt:_ (_, type_decls) ->
+  let sig_of_type type_decl =
+    Ast_helper.with_default_loc type_decl.ptype_loc @@
+      fun () -> sig_of_type type_decl
+  in
   List.concat (List.map sig_of_type type_decls))
 
 let deriving: Deriving.t =

src_plugins/eq/ppx_deriving_eq.ml

@@ -195,9 +195,17 @@ let str_of_type ({ ptype_loc = loc } as type_decl) =
          (Ppx_deriving.sanitize ~quoter (eta_expand (polymorphize comparator)))]
 
 let impl_generator = Deriving.Generator.V2.make_noarg (fun ~ctxt:_ (_, type_decls) ->
+  let str_of_type type_decl =
+    Ast_helper.with_default_loc type_decl.ptype_loc @@
+      fun () -> str_of_type type_decl
+  in
   [Str.value Recursive (List.concat (List.map str_of_type type_decls))])
 
 let intf_generator = Deriving.Generator.V2.make_noarg (fun ~ctxt:_ (_, type_decls) ->
+  let sig_of_type type_decl =
+    Ast_helper.with_default_loc type_decl.ptype_loc @@
+      fun () -> sig_of_type type_decl
+  in
   List.concat (List.map sig_of_type type_decls))
 
 let deriving: Deriving.t =

src_plugins/iter/ppx_deriving_iter.ml

@@ -128,9 +128,17 @@ let sig_of_type type_decl =
               (polymorphize [%type: [%t typ] -> Ppx_deriving_runtime.unit]))]
 
 let impl_generator = Deriving.Generator.V2.make_noarg (fun ~ctxt:_ (_, type_decls) ->
+  let str_of_type type_decl =
+    Ast_helper.with_default_loc type_decl.ptype_loc @@
+      fun () -> str_of_type type_decl
+  in
   [Str.value Recursive (List.concat (List.map str_of_type type_decls))])
 
 let intf_generator = Deriving.Generator.V2.make_noarg (fun ~ctxt:_ (_, type_decls) ->
+  let sig_of_type type_decl =
+    Ast_helper.with_default_loc type_decl.ptype_loc @@
+      fun () -> sig_of_type type_decl
+  in
   List.concat (List.map sig_of_type type_decls))
 
 let deriving: Deriving.t =

src_plugins/make/ppx_deriving_make.ml

@@ -195,6 +195,10 @@ let partition_result l =
   List.rev errors, List.rev oks
 
 let impl_generator =
+  let str_of_type type_decl =
+    Ast_helper.with_default_loc type_decl.ptype_loc @@
+      fun () -> str_of_type type_decl
+  in
   Deriving.Generator.V2.make_noarg (fun ~ctxt (_, type_decls) ->
       match partition_result (List.map str_of_type type_decls) with
       | _, (_::_ as vbs) -> [Str.value Nonrecursive vbs]
@@ -204,6 +208,10 @@ let impl_generator =
           errors)
 
 let intf_generator =
+  let sig_of_type type_decl =
+    Ast_helper.with_default_loc type_decl.ptype_loc @@
+      fun () -> sig_of_type type_decl
+  in
   Deriving.Generator.V2.make_noarg (fun ~ctxt (_, type_decls) ->
       match partition_result (List.map sig_of_type type_decls) with
       | _, (_::_ as vds) -> vds

src_plugins/ord/ppx_deriving_ord.ml

@@ -232,9 +232,17 @@ let str_of_type ({ ptype_loc = loc } as type_decl) =
          (Ppx_deriving.sanitize ~quoter (eta_expand (polymorphize comparator)))]
 
 let impl_generator = Deriving.Generator.V2.make_noarg (fun ~ctxt:_ (_, type_decls) ->
+  let str_of_type type_decl =
+    Ast_helper.with_default_loc type_decl.ptype_loc @@
+      fun () -> str_of_type type_decl
+  in
   [Str.value Recursive (List.concat (List.map str_of_type type_decls))])
 
 let intf_generator = Deriving.Generator.V2.make_noarg (fun ~ctxt:_ (_, type_decls) ->
+  let sig_of_type type_decl =
+    Ast_helper.with_default_loc type_decl.ptype_loc @@
+      fun () -> sig_of_type type_decl
+  in
   List.concat (List.map sig_of_type type_decls))
 
 let deriving: Deriving.t =

src_plugins/show/ppx_deriving_show.ml

@@ -328,11 +328,19 @@ let impl_generator = Deriving.Generator.V2.make impl_args (fun ~ctxt (_, type_de
     | Some with_path -> with_path
     | None -> true (* true by default *)
   in
-  [Str.value Recursive (List.concat (List.map (str_of_type ~with_path ~path) type_decls))])
+  let str_of_type type_decl =
+    Ast_helper.with_default_loc type_decl.ptype_loc @@
+      fun () -> str_of_type ~with_path ~path type_decl
+  in
+  [Str.value Recursive (List.concat (List.map str_of_type type_decls))])
 
 let intf_args = Deriving.Args.(empty +> arg "with_path" (Ast_pattern.ebool __))
 
 let intf_generator = Deriving.Generator.V2.make intf_args (fun ~ctxt:_ (_, type_decls) _with_path ->
+  let sig_of_type type_decl =
+    Ast_helper.with_default_loc type_decl.ptype_loc @@
+      fun () -> sig_of_type type_decl
+  in
   List.concat (List.map sig_of_type type_decls))
 
 let deriving: Deriving.t =