basic extraction of linkables

zth · Gabriel Nordeborn · commit 9036955ca076 · 2023-05-27T19:35:31.000+02:00
diff --git a/analysis/src/DocExtraction.ml b/analysis/src/DocExtraction.ml
@@ -1,33 +1,125 @@
-let formatCode content =
-  let {Res_driver.parsetree = signature; comments} =
-    Res_driver.parseInterfaceFromSource ~forPrinter:true
-      ~displayFilename:"<missing-file>" ~source:content
-  in
-  Res_printer.printInterface ~width:!Res_cli.ResClflags.width ~comments
-    signature
-  |> String.trim
+type linkableType = {
+  name: string;
+  path: Path.t;
+  env: SharedTypes.QueryEnv.t;
+  loc: Location.t;
+}
 
 type docItemDetail =
   | Record of {fieldDocs: (string * string list) list}
   | Variant of {constructorDocs: (string * string list) list}
 type docItem =
-  | Value of {docstring: string list; signature: string; name: string}
+  | Value of {
+      docstring: string list;
+      signature: string;
+      name: string;
+      linkables: linkableType list;
+          (** Relevant types to link to, found in relation to this value. *)
+    }
   | Type of {
       docstring: string list;
       signature: string;
       name: string;
       detail: docItemDetail option;
+          (** Additional documentation for constructors and record fields, if available. *)
+      linkables: linkableType list;
+          (** Relevant types to link to, found in relation to this type. *)
     }
   | Module of docsForModule
 and docsForModule = {docstring: string list; name: string; items: docItem list}
 
+let formatCode content =
+  let {Res_driver.parsetree = signature; comments} =
+    Res_driver.parseInterfaceFromSource ~forPrinter:true
+      ~displayFilename:"<missing-file>" ~source:content
+  in
+  Res_printer.printInterface ~width:!Res_cli.ResClflags.width ~comments
+    signature
+  |> String.trim
+
+module Linkables = struct
+  (* TODO: Extend this by going into function arguments, tuples etc... *)
+  let labelDeclarationsTypes lds =
+    lds |> List.map (fun (ld : Types.label_declaration) -> ld.ld_type)
+
+  let rec linkablesFromDecl (decl : Types.type_declaration) ~env ~full =
+    match decl.type_kind with
+    | Type_record (lds, _) -> (env, lds |> labelDeclarationsTypes)
+    | Type_variant cds ->
+      ( env,
+        cds
+        |> List.map (fun (cd : Types.constructor_declaration) ->
+               let fromArgs =
+                 match cd.cd_args with
+                 | Cstr_tuple ts -> ts
+                 | Cstr_record lds -> lds |> labelDeclarationsTypes
+               in
+               match cd.cd_res with
+               | None -> fromArgs
+               | Some t -> t :: fromArgs)
+        |> List.flatten )
+    | _ -> (
+      match decl.type_manifest with
+      | None -> (env, [])
+      | Some typ -> linkablesFromTyp typ ~env ~full)
+
+  and linkablesFromTyp ~env ~(full : SharedTypes.full) typ =
+    match typ |> Shared.digConstructor with
+    | Some path -> (
+      match References.digConstructor ~env ~package:full.package path with
+      | None -> (env, [typ])
+      | Some (env1, {item = {decl}}) -> linkablesFromDecl decl ~env:env1 ~full)
+    | None -> (env, [typ])
+
+  type linkableSource =
+    | Typ of SharedTypes.Type.t
+    | TypeExpr of Types.type_expr
+
+  let findLinkables ~env ~(full : SharedTypes.full) (typ : linkableSource) =
+    (* Expand definitions of types mentioned in typ.
+       If typ itself is a record or variant, search its body *)
+    let envToSearch, typesToSearch =
+      match typ with
+      | Typ t -> linkablesFromDecl ~env t.decl ~full
+      | TypeExpr t -> linkablesFromTyp t ~env ~full
+    in
+    let fromConstructorPath ~env path =
+      match References.digConstructor ~env ~package:full.package path with
+      | None -> None
+      | Some (env, {name = {txt}; extentLoc}) ->
+        if Utils.isUncurriedInternal path then None
+        else Some {name = txt; env; loc = extentLoc; path}
+    in
+    let constructors = Shared.findTypeConstructors typesToSearch in
+    constructors |> List.filter_map (fromConstructorPath ~env:envToSearch)
+end
+
 let stringifyDocstrings docstrings =
   let open Protocol in
   docstrings
   |> List.map (fun docstring ->
          docstring |> String.trim |> Json.escape |> wrapInQuotes)
   |> array
 
+let stringifyLinkables ?(indentation = 0)
+    ~(originalEnv : SharedTypes.QueryEnv.t) (linkables : linkableType list) =
+  let open Protocol in
+  linkables
+  |> List.map (fun l ->
+         stringifyObject ~indentation:(indentation + 1)
+           [
+             ( "path",
+               Some
+                 (l.path |> SharedTypes.pathIdentToString |> Json.escape
+                |> wrapInQuotes) );
+             ("moduleName", Some (l.env.file.moduleName |> wrapInQuotes));
+             ( "external",
+               Some
+                 (Printf.sprintf "%b" (originalEnv.file.uri <> l.env.file.uri))
+             );
+           ])
+  |> array
+
 let stringifyDetail ?(indentation = 0) (detail : docItemDetail) =
   let open Protocol in
   match detail with
@@ -63,25 +155,33 @@ let stringifyDetail ?(indentation = 0) (detail : docItemDetail) =
             |> array) );
       ]
 
-let rec stringifyDocItem ?(indentation = 0) (item : docItem) =
+let rec stringifyDocItem ?(indentation = 0) ~originalEnv (item : docItem) =
   let open Protocol in
   match item with
-  | Value {docstring; signature; name} ->
+  | Value {docstring; signature; name; linkables} ->
     stringifyObject ~startOnNewline:true ~indentation
       [
         ("kind", Some (wrapInQuotes "value"));
         ("name", Some (name |> Json.escape |> wrapInQuotes));
         ( "signature",
           Some (signature |> String.trim |> Json.escape |> wrapInQuotes) );
         ("docstrings", Some (stringifyDocstrings docstring));
+        ( "linkables",
+          Some
+            (stringifyLinkables ~originalEnv ~indentation:(indentation + 1)
+               linkables) );
       ]
-  | Type {docstring; signature; name; detail} ->
+  | Type {docstring; signature; name; detail; linkables} ->
     stringifyObject ~startOnNewline:true ~indentation
       [
         ("kind", Some (wrapInQuotes "type"));
         ("name", Some (name |> Json.escape |> wrapInQuotes));
         ("signature", Some (signature |> Json.escape |> wrapInQuotes));
         ("docstrings", Some (stringifyDocstrings docstring));
+        ( "linkables",
+          Some
+            (stringifyLinkables ~originalEnv ~indentation:(indentation + 1)
+               linkables) );
         ( "detail",
           match detail with
           | None -> None
@@ -92,10 +192,13 @@ let rec stringifyDocItem ?(indentation = 0) (item : docItem) =
     stringifyObject ~startOnNewline:true ~indentation
       [
         ("kind", Some (wrapInQuotes "module"));
-        ("item", Some (stringifyDocsForModule ~indentation:(indentation + 1) m));
+        ( "item",
+          Some
+            (stringifyDocsForModule ~originalEnv ~indentation:(indentation + 1)
+               m) );
       ]
 
-and stringifyDocsForModule ?(indentation = 0) (d : docsForModule) =
+and stringifyDocsForModule ?(indentation = 0) ~originalEnv (d : docsForModule) =
   let open Protocol in
   stringifyObject ~startOnNewline:true ~indentation
     [
@@ -104,7 +207,8 @@ and stringifyDocsForModule ?(indentation = 0) (d : docsForModule) =
       ( "items",
         Some
           (d.items
-          |> List.map (stringifyDocItem ~indentation:(indentation + 1))
+          |> List.map
+               (stringifyDocItem ~originalEnv ~indentation:(indentation + 1))
           |> array) );
     ]
 
@@ -133,11 +237,15 @@ let extractDocs ~path ~debug =
                             "let " ^ item.name ^ ": " ^ Shared.typeToString typ
                             |> formatCode;
                           name = item.name;
+                          linkables =
+                            TypeExpr typ |> Linkables.findLinkables ~env ~full;
                         })
                  | Type (typ, _) ->
                    Some
                      (Type
                         {
+                          linkables =
+                            Typ typ |> Linkables.findLinkables ~env ~full;
                           docstring = item.docstring |> List.map String.trim;
                           signature =
                             typ.decl
@@ -176,4 +284,4 @@ let extractDocs ~path ~debug =
       }
     in
     let docs = extractDocs structure in
-    print_endline (stringifyDocsForModule docs)
+    print_endline (stringifyDocsForModule ~originalEnv:env docs)
diff --git a/analysis/tests/src/DocExtractionRes.res b/analysis/tests/src/DocExtractionRes.res
@@ -28,7 +28,7 @@ module SomeInnerModule = {
     | /** If this is started or not */ Started(t) | /** Stopped? */ Stopped | /** Now idle.*/ Idle
 
   /** These are all the valid inputs.*/
-  type validInputs = [#something | #"needs-escaping" | #withPayload(int)]
+  type validInputs = [#something | #"needs-escaping" | #withPayload(int) | #status(status)]
 
   type callback = (t, ~status: status) => unit
 }
@@ -39,6 +39,16 @@ module AnotherModule = {
   /**
   Testing what this looks like.*/
   type callback = SomeInnerModule.status => unit
+
+  let isGoodStatus = (status: SomeInnerModule.status) => status == Stopped
+
+  /** Trying how it looks with an inline record in a variant. */
+  type someVariantWithInlineRecords = | /** This has inline records...*/ SomeStuff({offline: bool})
+
+  open ReactDOM
+
+  /**Callback to get the DOM root...*/
+  type domRoot = unit => Client.Root.t
 }
 
 // ^dex
diff --git a/analysis/tests/src/expected/DocExtractionRes.res.txt b/analysis/tests/src/expected/DocExtractionRes.res.txt
@@ -10,6 +10,7 @@ extracting docs for src/DocExtractionRes.res
     "name": "t",
     "signature": "type t = {name: string, online: bool}",
     "docstrings": ["This type represents stuff."],
+    "linkables": [],
     "detail": 
     {
       "kind": "record",
@@ -26,13 +27,23 @@ extracting docs for src/DocExtractionRes.res
     "kind": "value",
     "name": "make",
     "signature": "let make: string => t",
-    "docstrings": ["Create stuff.\\n\\n```rescript example\\nlet stuff = make(\\\"My name\\\")\\n```"]
+    "docstrings": ["Create stuff.\\n\\n```rescript example\\nlet stuff = make(\\\"My name\\\")\\n```"],
+    "linkables": [{
+        "path": "t",
+        "moduleName": "DocExtractionRes",
+        "external": false
+      }]
   }, 
   {
     "kind": "value",
     "name": "asOffline",
     "signature": "let asOffline: t => t",
-    "docstrings": ["Stuff goes offline."]
+    "docstrings": ["Stuff goes offline."],
+    "linkables": [{
+        "path": "t",
+        "moduleName": "DocExtractionRes",
+        "external": false
+      }]
   }, 
   {
     "kind": "module",
@@ -46,6 +57,11 @@ extracting docs for src/DocExtractionRes.res
         "name": "status",
         "signature": "type status = Started(t) | Stopped | Idle",
         "docstrings": [],
+        "linkables": [{
+            "path": "t",
+            "moduleName": "DocExtractionRes",
+            "external": false
+          }],
         "detail": 
         {
           "kind": "variant",
@@ -67,14 +83,24 @@ extracting docs for src/DocExtractionRes.res
       {
         "kind": "type",
         "name": "validInputs",
-        "signature": "type validInputs = [\\n  | #\\\"needs-escaping\\\"\\n  | #something\\n  | #withPayload(int)\\n]",
-        "docstrings": ["These are all the valid inputs."]
+        "signature": "type validInputs = [\\n  | #\\\"needs-escaping\\\"\\n  | #something\\n  | #status(status)\\n  | #withPayload(int)\\n]",
+        "docstrings": ["These are all the valid inputs."],
+        "linkables": []
       }, 
       {
         "kind": "type",
         "name": "callback",
         "signature": "type callback = (t, ~status: status) => unit",
-        "docstrings": []
+        "docstrings": [],
+        "linkables": [{
+            "path": "t",
+            "moduleName": "DocExtractionRes",
+            "external": false
+          }, {
+            "path": "status",
+            "moduleName": "DocExtractionRes",
+            "external": false
+          }]
       }]
     }
   }, 
@@ -89,7 +115,50 @@ extracting docs for src/DocExtractionRes.res
         "kind": "type",
         "name": "callback",
         "signature": "type callback = SomeInnerModule.status => unit",
-        "docstrings": ["Testing what this looks like."]
+        "docstrings": ["Testing what this looks like."],
+        "linkables": [{
+            "path": "SomeInnerModule.status",
+            "moduleName": "DocExtractionRes",
+            "external": false
+          }]
+      }, 
+      {
+        "kind": "value",
+        "name": "isGoodStatus",
+        "signature": "let isGoodStatus: SomeInnerModule.status => bool",
+        "docstrings": [],
+        "linkables": [{
+            "path": "SomeInnerModule.status",
+            "moduleName": "DocExtractionRes",
+            "external": false
+          }]
+      }, 
+      {
+        "kind": "type",
+        "name": "someVariantWithInlineRecords",
+        "signature": "type someVariantWithInlineRecords = SomeStuff({offline: bool})",
+        "docstrings": ["Trying how it looks with an inline record in a variant."],
+        "linkables": [],
+        "detail": 
+        {
+          "kind": "variant",
+          "fieldDocs": [
+          {
+            "constructorName": "SomeStuff",
+            "docstrings": ["This has inline records..."]
+          }]
+        }
+      }, 
+      {
+        "kind": "type",
+        "name": "domRoot",
+        "signature": "type domRoot = unit => ReactDOM.Client.Root.t",
+        "docstrings": ["Callback to get the DOM root..."],
+        "linkables": [{
+            "path": "ReactDOM.Client.Root.t",
+            "moduleName": "ReactDOM",
+            "external": true
+          }]
       }]
     }
   }]
