feature: generate docs with odig

allow users to generate documentation for packages in switches using
odig

CHANGELOG.md

@@ -1,5 +1,10 @@
 # Change Log
 
+## 1.10.0 (Unreleased)
+
+- Add the possibility to generate and show the documentation of an installed
+  package right into VSCode. (#771)
+
 ## 1.9.5
 
 - Fix automatic closing of files without an extension (#887)

package.json

@@ -36,6 +36,7 @@
     "onCommand:ocaml.open-ast-explorer-to-the-side",
     "onCommand:ocaml.show-preprocessed-document",
     "onCommand:ocaml.open-pp-editor-and-ast-explorer",
+    "onCommand:ocaml.stop-documentation-server",
     "onCustomEditor:ast-editor",
     "onCustomEditor:cm-files-editor",
     "workspaceContains:**/dune-workspace",
@@ -179,6 +180,15 @@
           "dark": "assets/document-search-dark.svg"
         }
       },
+      {
+        "command": "ocaml.generate-sandbox-documentation",
+        "category": "OCaml",
+        "title": "Generate Documentation",
+        "icon": {
+          "light": "assets/book-open-light.svg",
+          "dark": "assets/book-open-dark.svg"
+        }
+      },
       {
         "command": "ocaml.open-sandbox-documentation",
         "category": "OCaml",
@@ -188,6 +198,11 @@
           "dark": "assets/document-search-dark.svg"
         }
       },
+      {
+        "command": "ocaml.stop-documentation-server",
+        "category": "OCaml",
+        "title": "Stop Documentation Server"
+      },
       {
         "command": "ocaml.next-hole",
         "category": "OCaml",
@@ -352,6 +367,10 @@
           "command": "ocaml.uninstall-sandbox-package",
           "when": "false"
         },
+        {
+          "command": "ocaml.stop-documentation-server",
+          "when": "ocaml.documentation-server-on"
+        },
         {
           "command": "ocaml.upgrade-sandbox",
           "when": "false"
@@ -367,6 +386,10 @@
         {
           "command": "ocaml.open-sandbox-documentation",
           "when": "false"
+        },
+        {
+          "command": "ocaml.generate-sandbox-documentation",
+          "when": "false"
         }
       ],
       "editor/title": [
@@ -419,6 +442,11 @@
           "command": "ocaml.open-sandbox-documentation",
           "when": "view == ocaml-sandbox && viewItem == package-with-doc",
           "group": "inline"
+        },
+        {
+          "command": "ocaml.generate-sandbox-documentation",
+          "when": "view == ocaml-sandbox",
+          "group": "inline"
         }
       ]
     },
@@ -995,6 +1023,8 @@
     "fmt": "prettier . --write"
   },
   "dependencies": {
+    "polka": "^1.0.0-next.22",
+    "sirv": "^2.0.2",
     "vscode-languageclient": "7.0.0"
   },
   "devDependencies": {

src-bindings/node/node.ml

@@ -24,7 +24,9 @@ include
   [%js:
   val setInterval : (unit -> unit) -> int -> Timeout.t [@@js.global]
 
-  val setTimeout : (unit -> unit) -> int -> Timeout.t [@@js.global]]
+  val setTimeout : (unit -> unit) -> int -> Timeout.t [@@js.global]
+
+  val clearTimeout : Timeout.t -> unit [@@js.global]]
 
 module Process = struct
   include
@@ -175,6 +177,31 @@ module Fs = struct
   let readFile = readFile ~encoding:"utf8"
 end
 
+module Net = struct
+  module Socket = struct
+    include Class.Make ()
+
+    include
+      [%js:
+      val make : unit -> t [@@js.new "net.Socket"]
+
+      val isPaused : t -> bool [@@js.call]
+
+      val destroy : t -> unit [@@js.call]
+
+      val connect : t -> port:int -> host:string -> t [@@js.call]
+
+      val setTimeout : t -> int -> t [@@js.call]
+
+      val on : t -> string -> Ojs.t -> unit [@@js.call]]
+
+    let on t = function
+      | `Connect f -> on t "connect" @@ [%js.of: unit -> unit] f
+      | `Timeout f -> on t "timeout" @@ [%js.of: unit -> unit] f
+      | `Error f -> on t "error" @@ [%js.of: err:JsError.t -> unit] f
+  end
+end
+
 module ChildProcess = struct
   include Class.Make ()
 

src-bindings/node/node.mli

@@ -20,6 +20,8 @@ val setInterval : (unit -> unit) -> int -> Timeout.t
 
 val setTimeout : (unit -> unit) -> int -> Timeout.t
 
+val clearTimeout : Timeout.t -> unit
+
 module Process : sig
   val cwd : unit -> string
 
@@ -133,6 +135,30 @@ module Fs : sig
   val exists : string -> bool Promise.t
 end
 
+module Net : sig
+  module Socket : sig
+    type t
+
+    val make : unit -> t
+
+    val isPaused : t -> bool
+
+    val destroy : t -> unit
+
+    val connect : t -> port:int -> host:string -> t
+
+    val setTimeout : t -> int -> t
+
+    val on :
+         t
+      -> [ `Connect of unit -> unit
+         | `Timeout of unit -> unit
+         | `Error of err:JsError.t -> unit
+         ]
+      -> unit
+  end
+end
+
 module ChildProcess : sig
   module Options : sig
     type t

src-bindings/node/node_stub.js

@@ -12,3 +12,5 @@ joo_global_object.child_process = require("child_process");
 joo_global_object.path = require("path");
 
 joo_global_object.os = require("os");
+
+joo_global_object.net = require("net");

src-bindings/polka/dune

@@ -0,0 +1,8 @@
+(library
+ (name polka)
+ (preprocess
+  (pps gen_js_api.ppx))
+ (js_of_ocaml
+  (javascript_files polka_stub.js))
+ (libraries interop promise_jsoo jsonoo js_of_ocaml gen_js_api node)
+ (modes byte))

src-bindings/polka/polka.ml

@@ -0,0 +1,83 @@
+open Interop
+
+module Server = struct
+  include Interface.Make ()
+
+  module Address = struct
+    include Interface.Make ()
+
+    include [%js: val port : t -> int [@@js.get]]
+
+    include [%js: val address : t -> string [@@js.get]]
+  end
+
+  include
+    [%js:
+    val close :
+      t -> ?callback:(Node.JsError.t or_undefined -> unit) -> unit -> t
+      [@@js.call "close"]
+
+    val address : t -> Address.t or_undefined [@@js.call]
+
+    val on : t -> string -> Ojs.t -> unit [@@js.call]]
+
+  let on t = function
+    | `Close f -> on t "close" @@ [%js.of: unit -> unit] f
+    | `Error f -> on t "error" @@ [%js.of: err:Node.JsError.t -> unit] f
+end
+
+type polka = Ojs.t [@@js]
+
+module Middleware = struct
+  module Request = struct
+    include Interface.Make ()
+  end
+
+  module Response = struct
+    include Interface.Make ()
+  end
+
+  type t =
+    request:Request.t -> response:Response.t -> next:(unit -> polka) -> polka
+  [@@js]
+end
+
+include
+  [%js:
+  val create : unit -> polka [@@js.global "polka"]
+
+  val listen_ :
+       polka
+    -> int
+    -> ?hostname:string
+    -> ?callback:(unit -> unit)
+    -> unit
+    -> polka
+    [@@js.call "listen"]
+
+  val get_ : polka -> string -> (unit -> unit) -> polka [@@js.call "get"]
+
+  val use_ : polka -> (Middleware.t list[@js.variadic]) -> polka
+    [@@js.call "use"]
+
+  val server : polka -> Server.t [@@js.get]]
+
+let get path callback t = get_ t path callback
+
+let listen port ?hostname ?callback t = listen_ t port ?hostname ?callback
+
+let use middlewares t = use_ t middlewares
+
+module Sirv = struct
+  module Options = struct
+    include Interface.Make ()
+
+    include [%js: val create : dev:bool -> t [@@js.builder]]
+  end
+
+  include
+    [%js:
+    val serve :
+      string -> ?options:Options.t -> unit -> (Middleware.t[@js.dummy])
+      [@@js.global "sirv"]]
+end

src-bindings/polka/polka.mli

@@ -0,0 +1,60 @@
+open Interop
+
+module Server : sig
+  module Address : sig
+    include Js.T
+
+    val port : t -> int
+
+    val address : t -> string
+  end
+
+  type t
+
+  val close : t -> ?callback:(Node.JsError.t or_undefined -> unit) -> unit -> t
+
+  val address : t -> Address.t or_undefined
+  (* TODO: the return type can also be a string in case the server uses a pipe
+     or Unix Domain Socket, but we don't handle that case *)
+
+  val on :
+       t
+    -> [ `Close of unit -> unit | `Error of err:Node.JsError.t -> unit ]
+    -> unit
+end
+
+type polka
+
+module Middleware : sig
+  module Request : sig
+    include Js.T
+  end
+
+  module Response : sig
+    include Js.T
+  end
+
+  type t =
+    request:Request.t -> response:Response.t -> next:(unit -> polka) -> polka
+end
+
+val create : unit -> polka
+
+val listen :
+  int -> ?hostname:string -> ?callback:(unit -> unit) -> polka -> unit -> polka
+
+val get : string -> (unit -> unit) -> polka -> polka
+
+val use : Middleware.t list -> polka -> polka
+
+val server : polka -> Server.t
+
+module Sirv : sig
+  module Options : sig
+    type t
+
+    val create : dev:bool -> t
+  end
+
+  val serve : string -> ?options:Options.t -> unit -> Middleware.t
+end

src-bindings/polka/polka_stub.js

@@ -0,0 +1,2 @@
+joo_global_object.polka = require("polka");
+joo_global_object.sirv = require("sirv");

src-bindings/vscode/vscode.ml

@@ -1425,6 +1425,17 @@ module ExtensionTerminalOptions = struct
     val create : name:string -> pty:Pseudoterminal.t -> t [@@js.builder]]
 end
 
+module Extension = struct
+  include Interface.Make ()
+end
+
+module Extensions = struct
+  include
+    [%js:
+    val getExtension : string -> Extension.t or_undefined
+      [@@js.global "vscode.extensions.getExtension"]]
+end
+
 module TerminalExitStatus = struct
   include Interface.Make ()
 
@@ -2226,6 +2237,12 @@ module Workspace = struct
     }
   [@@js]
 
+  type workspaceFolderToAdd =
+    { name : string
+    ; uri : Uri.t
+    }
+  [@@js]
+
   include
     [%js:
     val workspaceFolders : unit -> WorkspaceFolder.t maybe_list
@@ -2306,7 +2323,14 @@ module Workspace = struct
           ]
          [@js.union])
       -> TextDocument.t Promise.t
-      [@@js.global "vscode.workspace.openTextDocument"]]
+      [@@js.global "vscode.workspace.openTextDocument"]
+
+    val updateWorkspaceFolders :
+         start:int
+      -> deleteCount:int or_undefined
+      -> workspaceFoldersToAdd:(workspaceFolderToAdd list[@js.variadic])
+      -> bool
+      [@@js.global "vscode.workspace.updateWorkspaceFolders"]]
 end
 
 module TreeItemCollapsibleState = struct