@@ -253,27 +253,6 @@ module AddTypeAnnotation = struct
253
253
end
254
254
255
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
256
let createTemplate () =
278
257
let docContent = [" \n " ; " \n " ] in
279
258
let expression =
@@ -295,61 +274,169 @@ module AddDocTemplate = struct
295
274
in
296
275
(Location. mkloc " res.doc" attrLoc, Parsetree. PStr [structureItem])
297
276
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
277
+ module Interface = struct
278
+ let mkIterator ~pos ~result =
279
+ let signature_item (iterator : Ast_iterator.iterator )
280
+ (item : Parsetree.signature_item ) =
281
+ match item.psig_desc with
282
+ | Psig_value value_description as r
283
+ when Loc. hasPos ~pos value_description.pval_loc
284
+ && ProcessAttributes. findDocAttribute
285
+ value_description.pval_attributes
286
+ = None ->
287
+ result := Some (r, item.psig_loc)
288
+ | Psig_type (_, hd :: _) as r
289
+ when Loc. hasPos ~pos hd.ptype_loc
290
+ && ProcessAttributes. findDocAttribute hd.ptype_attributes = None
291
+ ->
292
+ result := Some (r, item.psig_loc)
293
+ | Psig_module {pmd_name = {loc} } as r ->
294
+ if Loc. start loc = pos then result := Some (r, item.psig_loc)
295
+ else Ast_iterator. default_iterator.signature_item iterator item
296
+ | _ -> Ast_iterator. default_iterator.signature_item iterator item
297
+ in
298
+ {Ast_iterator. default_iterator with signature_item}
305
299
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
300
+ let processSigValue (valueDesc : Parsetree.value_description ) loc =
301
+ let attr = createTemplate () in
302
+ let newValueBinding =
303
+ {valueDesc with pval_attributes = attr :: valueDesc .pval_attributes}
304
+ in
305
+ let signature_item_desc = Parsetree. Psig_value newValueBinding in
306
+ Ast_helper.Sig. mk ~loc signature_item_desc
312
307
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)
308
+ let processTypeDecl ( typ : Parsetree.type_declaration ) =
309
+ let attr = createTemplate () in
310
+ let newTypeDeclaration =
311
+ {typ with ptype_attributes = attr :: typ .ptype_attributes }
312
+ in
313
+ newTypeDeclaration
319
314
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
315
+ let processModDecl (modDecl : Parsetree.module_declaration ) loc =
316
+ let attr = createTemplate () in
317
+ let newModDecl =
318
+ {modDecl with pmd_attributes = attr :: modDecl .pmd_attributes}
337
319
in
320
+ Ast_helper.Sig. mk ~loc (Parsetree. Psig_module newModDecl)
338
321
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
322
+ let xform ~path ~pos ~codeActions ~signature ~printSignatureItem =
323
+ let result = ref None in
324
+ let iterator = mkIterator ~pos ~result in
325
+ iterator.signature iterator signature;
326
+ match ! result with
327
+ | Some (signatureItem , loc ) -> (
328
+ let newSignatureItem =
329
+ match signatureItem with
330
+ | Psig_value value_desc ->
331
+ Some (processSigValue value_desc value_desc.pval_loc) (* Some loc *)
332
+ | Psig_type (flag , hd :: tl ) ->
333
+ let newFirstTypeDecl = processTypeDecl hd in
334
+ Some
335
+ (Ast_helper.Sig. mk ~loc
336
+ (Parsetree. Psig_type (flag, newFirstTypeDecl :: tl)))
337
+ | Psig_module modDecl -> Some (processModDecl modDecl loc)
338
+ | _ -> None
346
339
in
347
- codeActions := codeAction :: ! codeActions
348
- | None -> () )
349
- | None -> ()
340
+
341
+ match newSignatureItem with
342
+ | Some signatureItem ->
343
+ let range = rangeOfLoc signatureItem.psig_loc in
344
+ let newText = printSignatureItem ~range signatureItem in
345
+ let codeAction =
346
+ CodeActions. make ~title: " Add Documentation template"
347
+ ~kind: RefactorRewrite ~uri: path ~new Text ~range
348
+ in
349
+ codeActions := codeAction :: ! codeActions
350
+ | None -> () )
351
+ | None -> ()
352
+ end
353
+
354
+ module Implementation = struct
355
+ let mkIterator ~pos ~result =
356
+ let structure_item (iterator : Ast_iterator.iterator )
357
+ (si : Parsetree.structure_item ) =
358
+ match si.pstr_desc with
359
+ | Pstr_value (_, {pvb_pat = {ppat_loc}; pvb_attributes} :: _) as r
360
+ when Loc. hasPos ~pos ppat_loc
361
+ && ProcessAttributes. findDocAttribute pvb_attributes = None ->
362
+ result := Some (r, si.pstr_loc)
363
+ | Pstr_primitive value_description as r
364
+ when Loc. hasPos ~pos value_description.pval_loc
365
+ && ProcessAttributes. findDocAttribute
366
+ value_description.pval_attributes
367
+ = None ->
368
+ result := Some (r, si.pstr_loc)
369
+ | Pstr_module {pmb_name = {loc} } as r ->
370
+ if Loc. start loc = pos then result := Some (r, si.pstr_loc)
371
+ else Ast_iterator. default_iterator.structure_item iterator si
372
+ | Pstr_type (_, hd :: _) as r
373
+ when Loc. hasPos ~pos hd.ptype_loc
374
+ && ProcessAttributes. findDocAttribute hd.ptype_attributes = None
375
+ ->
376
+ result := Some (r, si.pstr_loc)
377
+ | _ -> Ast_iterator. default_iterator.structure_item iterator si
378
+ in
379
+ {Ast_iterator. default_iterator with structure_item}
380
+
381
+ let processValueBinding (valueBinding : Parsetree.value_binding ) =
382
+ let attr = createTemplate () in
383
+ let newValueBinding =
384
+ {valueBinding with pvb_attributes = attr :: valueBinding .pvb_attributes}
385
+ in
386
+ newValueBinding
387
+
388
+ let processPrimitive (valueDesc : Parsetree.value_description ) loc =
389
+ let attr = createTemplate () in
390
+ let newValueDesc =
391
+ {valueDesc with pval_attributes = attr :: valueDesc .pval_attributes}
392
+ in
393
+ Ast_helper.Str. primitive ~loc newValueDesc
394
+
395
+ let processModuleBinding (modBind : Parsetree.module_binding ) loc =
396
+ let attr = createTemplate () in
397
+ let newModBinding =
398
+ {modBind with pmb_attributes = attr :: modBind .pmb_attributes}
399
+ in
400
+ Ast_helper.Str. module_ ~loc newModBinding
401
+
402
+ let xform ~pos ~codeActions ~path ~printStructureItem ~structure =
403
+ let result = ref None in
404
+ let iterator = mkIterator ~pos ~result in
405
+ iterator.structure iterator structure;
406
+ match ! result with
407
+ | None -> ()
408
+ | Some (structureItem , loc ) -> (
409
+ let newStructureItem =
410
+ match structureItem with
411
+ | Pstr_value (flag , hd :: tl ) ->
412
+ let newValueBinding = processValueBinding hd in
413
+ Some
414
+ (Ast_helper.Str. mk ~loc
415
+ (Parsetree. Pstr_value (flag, newValueBinding :: tl)))
416
+ | Pstr_primitive valueDesc -> Some (processPrimitive valueDesc loc)
417
+ | Pstr_module modBind -> Some (processModuleBinding modBind loc)
418
+ | Pstr_type (flag , hd :: tl ) ->
419
+ let newFirstTypeDecl = Interface. processTypeDecl hd in
420
+ Some
421
+ (Ast_helper.Str. mk ~loc
422
+ (Parsetree. Pstr_type (flag, newFirstTypeDecl :: tl)))
423
+ | _ -> None
424
+ in
425
+
426
+ match newStructureItem with
427
+ | Some structureItem ->
428
+ let range = rangeOfLoc structureItem.pstr_loc in
429
+ let newText = printStructureItem ~range structureItem in
430
+ let codeAction =
431
+ CodeActions. make ~title: " Add Documentation template"
432
+ ~kind: RefactorRewrite ~uri: path ~new Text ~range
433
+ in
434
+ codeActions := codeAction :: ! codeActions
435
+ | None -> () )
436
+ end
350
437
end
351
438
352
- let parse ~filename =
439
+ let parseImplementation ~filename =
353
440
let {Res_driver. parsetree = structure; comments} =
354
441
Res_driver. parsingEngine.parseImplementation ~for Printer:false ~filename
355
442
in
@@ -399,19 +486,29 @@ let parseInterface ~filename =
399
486
(structure, printSignatureItem)
400
487
401
488
let extractCodeActions ~path ~pos ~currentFile ~debug =
402
- match Cmt. loadFullCmtFromPath ~path with
403
- | Some full when Files. classifySourceFile currentFile = Res ->
489
+ let codeActions = ref [] in
490
+ match Files. classifySourceFile currentFile with
491
+ | Res ->
404
492
let structure, printExpr, printStructureItem =
405
- parse ~filename: currentFile
493
+ parseImplementation ~filename: currentFile
406
494
in
407
- let codeActions = ref [] in
408
- AddTypeAnnotation. xform ~path ~pos ~full ~structure ~code Actions ~debug ;
409
495
IfThenElse. xform ~pos ~code Actions ~print Expr ~path structure;
410
496
AddBracesToFn. xform ~pos ~code Actions ~path ~print StructureItem structure;
497
+ AddDocTemplate.Implementation. xform ~pos ~code Actions ~path
498
+ ~print StructureItem ~structure ;
499
+
500
+ (* This Code Action needs type info *)
501
+ let () =
502
+ match Cmt. loadFullCmtFromPath ~path with
503
+ | Some full ->
504
+ AddTypeAnnotation. xform ~path ~pos ~full ~structure ~code Actions ~debug
505
+ | None -> ()
506
+ in
507
+
411
508
! codeActions
412
- | _ when Files. classifySourceFile currentFile = Resi ->
509
+ | Resi ->
413
510
let signature, printSignatureItem = parseInterface ~filename: currentFile in
414
- let codeActions = ref [] in
415
- AddDocTemplate. xform ~pos ~code Actions ~path ~signature ~print SignatureItem;
511
+ AddDocTemplate.Interface. xform ~pos ~ code Actions ~path ~signature
512
+ ~print SignatureItem;
416
513
! codeActions
417
- | _ -> []
514
+ | Other -> []
0 commit comments