first tests

analysis/src/DocExtraction.ml

@@ -1,9 +1,16 @@
-type fieldDoc = {fieldName: string; docstrings: string list; signature: string}
+type fieldDoc = {
+  fieldName: string;
+  docstrings: string list;
+  signature: string;
+  optional: bool;
+  deprecated: string option;
+}
 
 type constructorDoc = {
   constructorName: string;
   docstrings: string list;
   signature: string;
+  deprecated: string option;
 }
 
 type docsForModuleAlias = {
@@ -22,12 +29,16 @@ type docItem =
       docstring: string list;
       signature: string;
       name: string;
+      loc: Warnings.loc;
+      deprecated: string option;
     }
   | Type of {
       id: string;
       docstring: string list;
       signature: string;
       name: string;
+      loc: Warnings.loc;
+      deprecated: string option;
       detail: docItemDetail option;
           (** Additional documentation for constructors and record fields, if available. *)
     }
@@ -36,6 +47,7 @@ type docItem =
 and docsForModule = {
   id: string;
   docstring: string list;
+  deprecated: string option;
   name: string;
   items: docItem list;
 }
@@ -69,6 +81,15 @@ let stringifyDetail ?(indentation = 0) (detail : docItemDetail) =
                    stringifyObject ~indentation:(indentation + 1)
                      [
                        ("fieldName", Some (wrapInQuotes fieldDoc.fieldName));
+                       ( "deprecated",
+                         Some
+                           (string_of_bool (Option.is_some fieldDoc.deprecated))
+                       );
+                       ( "deprecatedMessage",
+                         match fieldDoc.deprecated with
+                         | Some msg -> Some (wrapInQuotes msg)
+                         | None -> None );
+                       ("optional", Some (string_of_bool fieldDoc.optional));
                        ( "docstrings",
                          Some (stringifyDocstrings fieldDoc.docstrings) );
                        ("signature", Some (wrapInQuotes fieldDoc.signature));
@@ -88,6 +109,14 @@ let stringifyDetail ?(indentation = 0) (detail : docItemDetail) =
                      [
                        ( "constructorName",
                          Some (wrapInQuotes constructorDoc.constructorName) );
+                       ( "deprecated",
+                         Some
+                           (string_of_bool
+                              (Option.is_some constructorDoc.deprecated)) );
+                       ( "deprecatedMessage",
+                         match constructorDoc.deprecated with
+                         | Some msg -> Some (wrapInQuotes msg)
+                         | None -> None );
                        ( "docstrings",
                          Some (stringifyDocstrings constructorDoc.docstrings) );
                        ( "signature",
@@ -96,25 +125,48 @@ let stringifyDetail ?(indentation = 0) (detail : docItemDetail) =
             |> array) );
       ]
 
+let stringifyLoc loc ~indentation =
+  let open Protocol in
+  let line, col = Loc.start loc in
+  let path = loc.loc_start.pos_fname in
+  stringifyObject ~startOnNewline:false ~indentation:(indentation + 1)
+    [
+      ("path", Some (wrapInQuotes path));
+      ("line", Some (string_of_int (line + 1)));
+      ("col", Some (string_of_int (col + 1)));
+    ]
+
 let rec stringifyDocItem ?(indentation = 0) ~originalEnv (item : docItem) =
   let open Protocol in
   match item with
-  | Value {id; docstring; signature; name} ->
+  | Value {id; docstring; signature; name; loc; deprecated} ->
     stringifyObject ~startOnNewline:true ~indentation
       [
         ("id", Some (wrapInQuotes id));
         ("kind", Some (wrapInQuotes "value"));
         ("name", Some (name |> Json.escape |> wrapInQuotes));
+        ("deprecated", Some (string_of_bool (Option.is_some deprecated)));
+        ( "deprecatedMessage",
+          match deprecated with
+          | Some msg -> Some (wrapInQuotes msg)
+          | None -> None );
+        ("location", Some (stringifyLoc loc ~indentation));
         ( "signature",
           Some (signature |> String.trim |> Json.escape |> wrapInQuotes) );
         ("docstrings", Some (stringifyDocstrings docstring));
       ]
-  | Type {id; docstring; signature; name; detail} ->
+  | Type {id; docstring; signature; name; loc; deprecated; detail} ->
     stringifyObject ~startOnNewline:true ~indentation
       [
         ("id", Some (wrapInQuotes id));
         ("kind", Some (wrapInQuotes "type"));
         ("name", Some (name |> Json.escape |> wrapInQuotes));
+        ("deprecated", Some (string_of_bool (Option.is_some deprecated)));
+        ( "deprecatedMessage",
+          match deprecated with
+          | Some msg -> Some (wrapInQuotes msg)
+          | None -> None );
+        ("location", Some (stringifyLoc loc ~indentation));
         ("signature", Some (signature |> Json.escape |> wrapInQuotes));
         ("docstrings", Some (stringifyDocstrings docstring));
         ( "detail",
@@ -147,6 +199,11 @@ and stringifyDocsForModule ?(indentation = 0) ~originalEnv (d : docsForModule) =
   stringifyObject ~startOnNewline:true ~indentation
     [
       ("name", Some (wrapInQuotes d.name));
+      ("deprecated", Some (string_of_bool (Option.is_some d.deprecated)));
+      ( "deprecatedMessage",
+        match d.deprecated with
+        | Some msg -> Some (wrapInQuotes msg)
+        | None -> None );
       ("docstrings", Some (stringifyDocstrings d.docstring));
       ( "items",
         Some
@@ -169,7 +226,9 @@ let typeDetail typ ~env ~full =
                     {
                       fieldName = field.fname.txt;
                       docstrings = field.docstring;
+                      optional = field.optional;
                       signature = Shared.typeToString field.typ;
+                      deprecated = field.deprecated;
                     });
          })
   | Some (Tvariant {constructors}) ->
@@ -183,6 +242,7 @@ let typeDetail typ ~env ~full =
                       constructorName = c.cname.txt;
                       docstrings = c.docstring;
                       signature = CompletionBackEnd.showConstructor c;
+                      deprecated = c.deprecated;
                     });
          })
   | _ -> None
@@ -225,6 +285,7 @@ let extractDocs ~path ~debug =
         id = modulePath |> ident;
         docstring = structure.docstring |> List.map String.trim;
         name = structure.name;
+        deprecated = structure.deprecated;
         items =
           structure.items
           |> List.filter_map (fun (item : Module.item) ->
@@ -239,6 +300,8 @@ let extractDocs ~path ~debug =
                             "let " ^ item.name ^ ": " ^ Shared.typeToString typ
                             |> formatCode;
                           name = item.name;
+                          loc = item.loc;
+                          deprecated = item.deprecated;
                         })
                  | Type (typ, _) ->
                    Some
@@ -251,6 +314,8 @@ let extractDocs ~path ~debug =
                             |> Shared.declToString item.name
                             |> formatCode;
                           name = item.name;
+                          loc = item.loc;
+                          deprecated = item.deprecated;
                           detail = typeDetail typ ~full ~env;
                         })
                  | Module (Ident p) ->

analysis/src/ProcessCmt.ml

@@ -59,6 +59,8 @@ let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
         Module.kind = Module.Value declared.item;
         name = declared.name.txt;
         docstring = declared.docstring;
+        loc;
+        deprecated = declared.deprecated;
       };
     ]
   | Sig_type
@@ -132,6 +134,8 @@ let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
         Module.kind = Type (declared.item, recStatus);
         name = declared.name.txt;
         docstring = declared.docstring;
+        loc = type_loc;
+        deprecated = declared.deprecated;
       };
     ]
   | Sig_module (ident, {md_type; md_attributes; md_loc}, _) ->
@@ -149,6 +153,8 @@ let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
         Module.kind = Module declared.item;
         name = declared.name.txt;
         docstring = declared.docstring;
+        loc = md_loc;
+        deprecated = declared.deprecated;
       };
     ]
   | _ -> []
@@ -160,7 +166,7 @@ and forTypeSignature ~name ~env signature =
       (fun item items -> forTypeSignatureItem ~env ~exported item @ items)
       signature []
   in
-  {Module.name; docstring = []; exported; items}
+  {Module.name; docstring = []; exported; items; deprecated = None}
 
 and forTypeModule ~name ~env moduleType =
   match moduleType with
@@ -312,6 +318,8 @@ let forTypeDeclaration ~env ~(exported : Exported.t)
     Module.kind = Module.Type (declared.item, recStatus);
     name = declared.name.txt;
     docstring = declared.docstring;
+    loc = typ_loc;
+    deprecated = declared.deprecated;
   }
 
 let rec forSignatureItem ~env ~(exported : Exported.t)
@@ -330,6 +338,8 @@ let rec forSignatureItem ~env ~(exported : Exported.t)
         Module.kind = Module.Value declared.item;
         name = declared.name.txt;
         docstring = declared.docstring;
+        loc = name.loc;
+        deprecated = declared.deprecated;
       };
     ]
   | Tsig_type (recFlag, decls) ->
@@ -360,6 +370,8 @@ let rec forSignatureItem ~env ~(exported : Exported.t)
         Module.kind = Module declared.item;
         name = declared.name.txt;
         docstring = declared.docstring;
+        loc = name.loc;
+        deprecated = declared.deprecated;
       };
     ]
   | Tsig_recmodule modDecls ->
@@ -395,7 +407,8 @@ let forSignature ~name ~env sigItems =
     | _ -> []
   in
   let docstring = attrsToDocstring attributes in
-  {Module.name; docstring; exported; items}
+  let deprecated = ProcessAttributes.findDeprecatedAttribute attributes in
+  {Module.name; docstring; exported; items; deprecated}
 
 let forTreeModuleType ~name ~env {Typedtree.mty_desc} =
   match mty_desc with
@@ -435,6 +448,8 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
             Module.kind = Module.Value declared.item;
             name = declared.name.txt;
             docstring = declared.docstring;
+            loc = pat.pat_loc;
+            deprecated = declared.deprecated;
           }
           :: !items
       | Tpat_tuple pats | Tpat_array pats | Tpat_construct (_, _, pats) ->
@@ -469,6 +484,8 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
         Module.kind = Module declared.item;
         name = declared.name.txt;
         docstring = declared.docstring;
+        loc = name.loc;
+        deprecated = declared.deprecated;
       };
     ]
   | Tstr_recmodule modDecls ->
@@ -499,6 +516,8 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
         Module.kind = Module modTypeItem;
         name = declared.name.txt;
         docstring = declared.docstring;
+        loc = name.loc;
+        deprecated = declared.deprecated;
       };
     ]
   | Tstr_include {incl_mod; incl_type} ->
@@ -527,6 +546,8 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
         Module.kind = Value declared.item;
         name = declared.name.txt;
         docstring = declared.docstring;
+        loc = vd.val_loc;
+        deprecated = declared.deprecated;
       };
     ]
   | Tstr_type (recFlag, decls) ->
@@ -587,7 +608,8 @@ and forStructure ~name ~env strItems =
     | _ -> []
   in
   let docstring = attrsToDocstring attributes in
-  {Module.name; docstring; exported; items}
+  let deprecated = ProcessAttributes.findDeprecatedAttribute attributes in
+  {Module.name; docstring; exported; items; deprecated}
 
 let fileForCmtInfos ~moduleName ~uri
     ({cmt_modname; cmt_annots} : Cmt_format.cmt_infos) =

analysis/src/SharedTypes.ml

@@ -122,13 +122,20 @@ module Module = struct
     | Type of Type.t * Types.rec_status
     | Module of t
 
-  and item = {kind: kind; name: string; docstring: string list}
+  and item = {
+    kind: kind;
+    name: string;
+    docstring: string list;
+    loc: Warnings.loc;
+    deprecated: string option;
+  }
 
   and structure = {
     name: string;
     docstring: string list;
     exported: Exported.t;
     items: item list;
+    deprecated: string option
   }
 
   and t = Ident of Path.t | Structure of structure | Constraint of t * t
@@ -253,6 +260,7 @@ module File = struct
           docstring = [];
           exported = Exported.init ();
           items = [];
+          deprecated = None
         };
     }
 end