@@ -252,6 +252,103 @@ module AddTypeAnnotation = struct
252
252
| _ -> () ))
253
253
end
254
254
255
+ module AddDocTemplate = struct
256
+ let mkIterator ~pos ~result =
257
+ let signature_item (iterator : Ast_iterator.iterator )
258
+ (item : Parsetree.signature_item ) =
259
+ match item.psig_desc with
260
+ | Psig_value value_description as r
261
+ when Loc. hasPos ~pos value_description.pval_loc
262
+ && ProcessAttributes. findDocAttribute
263
+ value_description.pval_attributes
264
+ = None ->
265
+ result := Some (r, item.psig_loc)
266
+ | Psig_type (_, hd :: _) as r
267
+ when Loc. hasPos ~pos hd.ptype_loc
268
+ && ProcessAttributes. findDocAttribute hd.ptype_attributes = None ->
269
+ result := Some (r, item.psig_loc)
270
+ | Psig_module {pmd_name = {loc} } as r ->
271
+ if Loc. start loc = pos then result := Some (r, item.psig_loc)
272
+ else Ast_iterator. default_iterator.signature_item iterator item
273
+ | _ -> Ast_iterator. default_iterator.signature_item iterator item
274
+ in
275
+ {Ast_iterator. default_iterator with signature_item}
276
+
277
+ let createTemplate () =
278
+ let docContent = [" \n " ; " \n " ] in
279
+ let expression =
280
+ Ast_helper.Exp. constant
281
+ (Parsetree. Pconst_string (String. concat " " docContent, None ))
282
+ in
283
+ let structureItemDesc = Parsetree. Pstr_eval (expression, [] ) in
284
+ let structureItem = Ast_helper.Str. mk structureItemDesc in
285
+ let attrLoc =
286
+ {
287
+ Location. none with
288
+ loc_start = Lexing. dummy_pos;
289
+ loc_end =
290
+ {
291
+ Lexing. dummy_pos with
292
+ pos_lnum = Lexing. dummy_pos.pos_lnum (* force line break *) ;
293
+ };
294
+ }
295
+ in
296
+ (Location. mkloc " res.doc" attrLoc, Parsetree. PStr [structureItem])
297
+
298
+ let processSigValue (vl_desc : Parsetree.value_description ) loc =
299
+ let attr = createTemplate () in
300
+ let newValueBinding =
301
+ {vl_desc with pval_attributes = attr :: vl_desc .pval_attributes}
302
+ in
303
+ let signature_item_desc = Parsetree. Psig_value newValueBinding in
304
+ Ast_helper.Sig. mk ~loc signature_item_desc
305
+
306
+ let processTypeDecl (typ : Parsetree.type_declaration ) =
307
+ let attr = createTemplate () in
308
+ let newTypeDeclaration =
309
+ {typ with ptype_attributes = attr :: typ .ptype_attributes}
310
+ in
311
+ newTypeDeclaration
312
+
313
+ let processModDecl (modDecl : Parsetree.module_declaration ) loc =
314
+ let attr = createTemplate () in
315
+ let newModDecl =
316
+ {modDecl with pmd_attributes = attr :: modDecl .pmd_attributes}
317
+ in
318
+ Ast_helper.Sig. mk ~loc (Parsetree. Psig_module newModDecl)
319
+
320
+ let xform ~path ~pos ~codeActions ~signature ~printSignatureItem =
321
+ let result = ref None in
322
+ let iterator = mkIterator ~pos ~result in
323
+ iterator.signature iterator signature;
324
+ match ! result with
325
+ | Some (signatureItem , loc ) -> (
326
+ let newSignatureItem =
327
+ match signatureItem with
328
+ | Psig_value value_desc ->
329
+ Some (processSigValue value_desc value_desc.pval_loc) (* Some loc *)
330
+ | Psig_type (flag , hd :: tl ) ->
331
+ let newFirstTypeDecl = processTypeDecl hd in
332
+ Some
333
+ (Ast_helper.Sig. mk ~loc
334
+ (Parsetree. Psig_type (flag, newFirstTypeDecl :: tl)))
335
+ | Psig_module modDecl -> Some (processModDecl modDecl loc)
336
+ | _ -> None
337
+ in
338
+
339
+ match newSignatureItem with
340
+ | Some sig_item ->
341
+ let range = rangeOfLoc sig_item.psig_loc in
342
+ let newText = printSignatureItem ~range sig_item in
343
+ let codeAction =
344
+ CodeActions. make ~title: " Add Documentation template"
345
+ ~kind: RefactorRewrite ~uri: path ~new Text ~range
346
+ in
347
+ codeActions := codeAction :: ! codeActions
348
+ | None -> () )
349
+ | None -> ()
350
+ end
351
+
255
352
let parse ~filename =
256
353
let {Res_driver. parsetree = structure; comments} =
257
354
Res_driver. parsingEngine.parseImplementation ~for Printer:false ~filename
@@ -280,6 +377,27 @@ let parse ~filename =
280
377
in
281
378
(structure, printExpr, printStructureItem)
282
379
380
+ let parseInterface ~filename =
381
+ let {Res_driver. parsetree = structure; comments} =
382
+ Res_driver. parsingEngine.parseInterface ~for Printer:false ~filename
383
+ in
384
+ let filterComments ~loc comments =
385
+ (* Relevant comments in the range of the expression *)
386
+ let filter comment =
387
+ Loc. hasPos ~pos: (Loc. start (Res_comment. loc comment)) loc
388
+ in
389
+ comments |> List. filter filter
390
+ in
391
+ let printSignatureItem ~(range : Protocol.range )
392
+ (item : Parsetree.signature_item ) =
393
+ let signature_item = [item] in
394
+ signature_item
395
+ |> Res_printer. printInterface ~width: ! Res_cli.ResClflags. width
396
+ ~comments: (comments |> filterComments ~loc: item.psig_loc)
397
+ |> Utils. indent range.start.character
398
+ in
399
+ (structure, printSignatureItem)
400
+
283
401
let extractCodeActions ~path ~pos ~currentFile ~debug =
284
402
match Cmt. loadFullCmtFromPath ~path with
285
403
| Some full when Files. classifySourceFile currentFile = Res ->
@@ -291,4 +409,9 @@ let extractCodeActions ~path ~pos ~currentFile ~debug =
291
409
IfThenElse. xform ~pos ~code Actions ~print Expr ~path structure;
292
410
AddBracesToFn. xform ~pos ~code Actions ~path ~print StructureItem structure;
293
411
! codeActions
412
+ | _ when Files. classifySourceFile currentFile = Resi ->
413
+ let signature, printSignatureItem = parseInterface ~filename: currentFile in
414
+ let codeActions = ref [] in
415
+ AddDocTemplate. xform ~pos ~code Actions ~path ~signature ~print SignatureItem;
416
+ ! codeActions
294
417
| _ -> []
0 commit comments