tools: add source field

Author: aspeddro

analysis/src/ProcessCmt.ml

@@ -60,6 +60,7 @@ let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
         name = declared.name.txt;
         docstring = declared.docstring;
         deprecated = declared.deprecated;
+        loc = declared.extentLoc;
       };
     ]
   | Sig_type
@@ -134,6 +135,7 @@ let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
         name = declared.name.txt;
         docstring = declared.docstring;
         deprecated = declared.deprecated;
+        loc = declared.extentLoc;
       };
     ]
   | Sig_module (ident, {md_type; md_attributes; md_loc}, _) ->
@@ -152,6 +154,7 @@ let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
         name = declared.name.txt;
         docstring = declared.docstring;
         deprecated = declared.deprecated;
+        loc = declared.extentLoc;
       };
     ]
   | _ -> []
@@ -316,6 +319,7 @@ let forTypeDeclaration ~env ~(exported : Exported.t)
     name = declared.name.txt;
     docstring = declared.docstring;
     deprecated = declared.deprecated;
+    loc = declared.extentLoc;
   }
 
 let rec forSignatureItem ~env ~(exported : Exported.t)
@@ -335,6 +339,7 @@ let rec forSignatureItem ~env ~(exported : Exported.t)
         name = declared.name.txt;
         docstring = declared.docstring;
         deprecated = declared.deprecated;
+        loc = declared.extentLoc;
       };
     ]
   | Tsig_type (recFlag, decls) ->
@@ -366,6 +371,7 @@ let rec forSignatureItem ~env ~(exported : Exported.t)
         name = declared.name.txt;
         docstring = declared.docstring;
         deprecated = declared.deprecated;
+        loc = declared.extentLoc;
       };
     ]
   | Tsig_recmodule modDecls ->
@@ -443,6 +449,7 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
             name = declared.name.txt;
             docstring = declared.docstring;
             deprecated = declared.deprecated;
+            loc = declared.extentLoc;
           }
           :: !items
       | Tpat_tuple pats | Tpat_array pats | Tpat_construct (_, _, pats) ->
@@ -478,6 +485,7 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
         name = declared.name.txt;
         docstring = declared.docstring;
         deprecated = declared.deprecated;
+        loc = declared.extentLoc;
       };
     ]
   | Tstr_recmodule modDecls ->
@@ -509,6 +517,7 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
         name = declared.name.txt;
         docstring = declared.docstring;
         deprecated = declared.deprecated;
+        loc = declared.extentLoc;
       };
     ]
   | Tstr_include {incl_mod; incl_type} ->
@@ -538,6 +547,7 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
         name = declared.name.txt;
         docstring = declared.docstring;
         deprecated = declared.deprecated;
+        loc = declared.extentLoc;
       };
     ]
   | Tstr_type (recFlag, decls) ->

analysis/src/SharedTypes.ml

@@ -125,6 +125,7 @@ module Module = struct
   and item = {
     kind: kind;
     name: string;
+    loc: Location.t;
     docstring: string list;
     deprecated: string option;
   }

tools/src/tools.ml

@@ -18,16 +18,20 @@ type constructorDoc = {
   items: constructorPayload option;
 }
 
+type source = {filepath: string; line: int; col: int}
+
 type docItemDetail =
   | Record of {fieldDocs: fieldDoc list}
   | Variant of {constructorDocs: constructorDoc list}
+
 type docItem =
   | Value of {
       id: string;
       docstring: string list;
       signature: string;
       name: string;
       deprecated: string option;
+      source: source;
     }
   | Type of {
       id: string;
@@ -36,20 +40,23 @@ type docItem =
       name: string;
       deprecated: string option;
       detail: docItemDetail option;
+      source: source;
           (** Additional documentation for constructors and record fields, if available. *)
     }
   | Module of docsForModule
   | ModuleAlias of {
       id: string;
       docstring: string list;
       name: string;
+      source: source;
       items: docItem list;
     }
 and docsForModule = {
   id: string;
   docstring: string list;
   deprecated: string option;
   name: string;
+  source: source;
   items: docItem list;
 }
 
@@ -132,10 +139,19 @@ let stringifyDetail ?(indentation = 0) (detail : docItemDetail) =
             |> array) );
       ]
 
+let stringifySource ~indentation source =
+  let open Protocol in
+  stringifyObject ~startOnNewline:false ~indentation
+    [
+      ("filepath", Some (source.filepath |> wrapInQuotes));
+      ("line", Some (source.line |> string_of_int));
+      ("col", Some (source.col |> string_of_int));
+    ]
+
 let rec stringifyDocItem ?(indentation = 0) ~originalEnv (item : docItem) =
   let open Protocol in
   match item with
-  | Value {id; docstring; signature; name; deprecated} ->
+  | Value {id; docstring; signature; name; deprecated; source} ->
     stringifyObject ~startOnNewline:true ~indentation
       [
         ("id", Some (wrapInQuotes id));
@@ -147,8 +163,9 @@ let rec stringifyDocItem ?(indentation = 0) ~originalEnv (item : docItem) =
           | None -> None );
         ("signature", Some (signature |> String.trim |> wrapInQuotes));
         ("docstrings", Some (stringifyDocstrings docstring));
+        ("source", Some (stringifySource ~indentation:(indentation + 1) source));
       ]
-  | Type {id; docstring; signature; name; deprecated; detail} ->
+  | Type {id; docstring; signature; name; deprecated; detail; source} ->
     stringifyObject ~startOnNewline:true ~indentation
       [
         ("id", Some (wrapInQuotes id));
@@ -160,6 +177,7 @@ let rec stringifyDocItem ?(indentation = 0) ~originalEnv (item : docItem) =
           | None -> None );
         ("signature", Some (signature |> wrapInQuotes));
         ("docstrings", Some (stringifyDocstrings docstring));
+        ("source", Some (stringifySource ~indentation:(indentation + 1) source));
         ( "detail",
           match detail with
           | None -> None
@@ -177,6 +195,8 @@ let rec stringifyDocItem ?(indentation = 0) ~originalEnv (item : docItem) =
           | Some d -> Some (wrapInQuotes d)
           | None -> None );
         ("docstrings", Some (stringifyDocstrings m.docstring));
+        ( "source",
+          Some (stringifySource ~indentation:(indentation + 1) m.source) );
         ( "items",
           Some
             (m.items
@@ -191,6 +211,8 @@ let rec stringifyDocItem ?(indentation = 0) ~originalEnv (item : docItem) =
         ("kind", Some (wrapInQuotes "moduleAlias"));
         ("name", Some (wrapInQuotes m.name));
         ("docstrings", Some (stringifyDocstrings m.docstring));
+        ( "source",
+          Some (stringifySource ~indentation:(indentation + 1) m.source) );
         ( "items",
           Some
             (m.items
@@ -209,6 +231,7 @@ and stringifyDocsForModule ?(indentation = 0) ~originalEnv (d : docsForModule) =
         | Some d -> Some (wrapInQuotes d)
         | None -> None );
       ("docstrings", Some (stringifyDocstrings d.docstring));
+      ("source", Some (stringifySource ~indentation:(indentation + 1) d.source));
       ( "items",
         Some
           (d.items
@@ -257,6 +280,33 @@ let typeDetail typ ~env ~full =
 let makeId modulePath ~identifier =
   identifier :: modulePath |> List.rev |> SharedTypes.ident
 
+let findRelativePath ~rootPath ~path =
+  let open Filename in
+  let realPath =
+    match rootPath = "." with
+    | true -> Sys.getcwd ()
+    | false ->
+      if is_relative rootPath then concat (Sys.getcwd ()) rootPath else rootPath
+  in
+  let rec loop dirPath acc =
+    match dirname dirPath = realPath with
+    | true -> basename dirPath :: acc |> String.concat dir_sep
+    | false -> (
+      match dirPath with
+      | "/" -> failwith "Failed to find relative path of package"
+      | "." -> path
+      | _ -> loop (dirname dirPath) (basename dirPath :: acc))
+  in
+
+  loop path []
+
+let getSource ~rootPath ({loc_start} : Location.t) =
+  let line, col = Pos.ofLexing loc_start in
+
+  let filepath = findRelativePath ~rootPath ~path:loc_start.pos_fname in
+
+  {filepath; line = line + 1; col = col + 1}
+
 let extractDocs ~path ~debug =
   if debug then Printf.printf "extracting docs for %s\n" path;
   let result =
@@ -289,6 +339,7 @@ let extractDocs ~path ~debug =
       | Some full ->
         let file = full.file in
         let structure = file.structure in
+        let rootPath = full.package.rootPath in
         let open SharedTypes in
         let env = QueryEnv.fromFile file in
         let rec extractDocsForModule ?(modulePath = [env.file.moduleName])
@@ -298,11 +349,22 @@ let extractDocs ~path ~debug =
             docstring = structure.docstring |> List.map String.trim;
             name = structure.name;
             deprecated = structure.deprecated;
+            source =
+              {
+                filepath =
+                  (match rootPath = "." with
+                  | true -> file.uri |> Uri.toPath
+                  | false ->
+                    findRelativePath ~rootPath ~path:(file.uri |> Uri.toPath));
+                line = 0;
+                col = 0;
+              };
             items =
               structure.items
               |> List.filter_map (fun (item : Module.item) ->
                      match item.kind with
                      | Value typ ->
+                       let source = getSource ~rootPath item.loc in
                        Some
                          (Value
                             {
@@ -313,6 +375,9 @@ let extractDocs ~path ~debug =
                                 ^ Shared.typeToString typ;
                               name = item.name;
                               deprecated = item.deprecated;
+                              source;
+                              (* source = *)
+                              (*   getSource ~stamp:typ.id ~full ~name:item.name; *)
                             })
                      | Type (typ, _) ->
                        Some
@@ -325,6 +390,7 @@ let extractDocs ~path ~debug =
                               name = item.name;
                               deprecated = item.deprecated;
                               detail = typeDetail typ ~full ~env;
+                              source = getSource ~rootPath item.loc;
                             })
                      | Module (Ident p) ->
                        (* module Whatever = OtherModule *)
@@ -350,6 +416,7 @@ let extractDocs ~path ~debug =
                             {
                               id;
                               name = item.name;
+                              source = getSource ~rootPath item.loc;
                               items;
                               docstring =
                                 item.docstring @ internalDocstrings
@@ -366,6 +433,7 @@ let extractDocs ~path ~debug =
                               name = m.name;
                               docstring = item.docstring @ m.docstring;
                               deprecated = item.deprecated;
+                              source = getSource ~rootPath item.loc;
                               items = docs.items;
                             })
                      | Module

tools/tests/src/expected/DocExtraction2.res.json

@@ -2,40 +2,70 @@
 {
   "name": "DocExtraction2",
   "docstrings": ["Module level doc here."],
+  "source": {
+    "filepath": "src/DocExtraction2.resi",
+    "line": 0,
+    "col": 0
+  },
   "items": [
   {
     "id": "DocExtraction2.t",
     "kind": "type",
     "name": "t",
     "signature": "type t",
-    "docstrings": ["Type t is pretty cool."]
+    "docstrings": ["Type t is pretty cool."],
+    "source": {
+      "filepath": "src/DocExtraction2.resi",
+      "line": 4,
+      "col": 1
+    }
   }, 
   {
     "id": "DocExtraction2.make",
     "kind": "value",
     "name": "make",
     "signature": "let make: (. unit) => t",
-    "docstrings": ["Makerz of stuffz."]
+    "docstrings": ["Makerz of stuffz."],
+    "source": {
+      "filepath": "src/DocExtraction2.resi",
+      "line": 7,
+      "col": 1
+    }
   }, 
   {
     "id": "DocExtraction2.InnerModule",
     "name": "InnerModule",
     "kind": "module",
     "docstrings": [],
+    "source": {
+      "filepath": "src/DocExtraction2.resi",
+      "line": 9,
+      "col": 8
+    },
     "items": [
     {
       "id": "DocExtraction2.InnerModule.t",
       "kind": "type",
       "name": "t",
       "signature": "type t",
-      "docstrings": ["This type is also t."]
+      "docstrings": ["This type is also t."],
+      "source": {
+        "filepath": "src/DocExtraction2.resi",
+        "line": 13,
+        "col": 3
+      }
     }, 
     {
       "id": "DocExtraction2.InnerModule.make",
       "kind": "value",
       "name": "make",
       "signature": "let make: (. unit) => t",
-      "docstrings": ["Maker of tea."]
+      "docstrings": ["Maker of tea."],
+      "source": {
+        "filepath": "src/DocExtraction2.resi",
+        "line": 15,
+        "col": 3
+      }
     }]
   }]
 }