Merge pull request #239 from Lomand/rescript-interfaces

Type information in Rescript syntax in Docs

.circleci/config.yml

@@ -104,6 +104,7 @@ jobs:
       - run: npm install -g esy
       - run: cd ocamldoc-json-generator && make init-node
       - run: cd ocamldoc-json-generator && ~/.npm-global/bin/esy
+      - run: cd ocamldoc-json-generator && make rescript-interfaces
       - run: cd ocamldoc-json-generator && make doc
       # Check that model.json has been regenerated when there are changes in the interface files
       - run: git diff --exit-code website/model.json

.gitignore

@@ -21,4 +21,5 @@ _esy
 .sourcedirs.json
 /ocamldoc-json-generator/dune.bsb
 /ocamldoc-json-generator/dune-project
-/ocamldoc-json-generator/dune
+/ocamldoc-json-generator/dune
+_opam/

ocamldoc-json-generator/JsonGenerator.ml

@@ -1007,6 +1007,143 @@ class json =
       *)
       obj [ ("rendered", string rendered) (*      ("raw", raw) *) ]
 
+    method json_of_rescript_type_expr (moduleName : string) (funcName : string)
+        : Json.t =
+      let open Json in
+      let read_file filename =
+        let lines = ref [] in
+        let chan = open_in filename in
+        try
+          while true do
+            lines := input_line chan :: !lines
+          done ;
+          !lines
+        with
+        | End_of_file ->
+            close_in chan ;
+            List.rev !lines
+      in
+
+      let has_type_definition line funcName =
+        let contains_pars x = String.contains x '(' in
+        if contains_pars funcName
+        then
+          (* detect let/external (~-) (.?[]) (mod) (|>) *)
+          let start_i = 1 in
+          let close_i = String.index funcName ')' in
+          let extracted_val =
+            String.sub funcName start_i (close_i - start_i) |> String.trim
+          in
+          let r_ignore = Str.regexp "[\"ltextrna]" in
+          let cleaned_line =
+            Str.global_replace r_ignore "" line |> String.trim
+          in
+          let q_external = Str.quote ("\\" ^ extracted_val) in
+          let q_let = Str.quote ("let " ^ extracted_val) in
+
+          let r_external = Str.regexp q_external in
+          let r_let = Str.regexp q_let in
+
+          let is_external = Str.string_match r_external cleaned_line 0 in
+          let is_let = Str.string_match r_let line 0 in
+
+          is_external || is_let
+        else
+          (* detect let/external/module/module type function_name *)
+          let q_let = Str.quote ("let " ^ funcName ^ ":") in
+          let q_external = Str.quote ("external " ^ funcName ^ ":") in
+          let q_module = Str.quote ("module " ^ funcName) in
+          let q_module_type = Str.quote ("module type " ^ funcName) in
+
+          let r_let = Str.regexp q_let in
+          let r_external = Str.regexp q_external in
+          let r_module = Str.regexp q_module in
+          let r_module_type = Str.regexp q_module_type in
+
+          let is_let = Str.string_match r_let line 0 in
+          let is_external = Str.string_match r_external line 0 in
+          let is_module = Str.string_match r_module line 0 in
+          let is_module_type = Str.string_match r_module_type line 0 in
+
+          is_let || is_external || is_module || is_module_type
+      in
+      let trim_name line =
+        (*let (||): (bool, bool) => bool = "%seqor" => (bool, bool) => bool = "%seqor" *)
+        match String.split_on_char ':' line with
+        | _ :: result ->
+            result |> String.concat ":" |> String.trim
+        | _ ->
+            line |> String.trim
+      in
+      let remove_external line =
+        (* (bool, bool) => bool = "%seqor" => (bool, bool) => bool *)
+        let q_has_external = Str.quote " = \"" in
+        let r_let = Str.regexp q_has_external in
+        let result = Str.split r_let line in
+        match result with [ result; _ ] -> result | _ -> line
+      in
+      let is_submodule moduleName =
+        match moduleName |> String.split_on_char '.' with
+        | [ _ ] ->
+            None
+        | [ glob; block ] ->
+            Some (glob, block)
+        | _ ->
+            None
+      in
+      let fetch_rescript_submodule ~file ~block =
+        let filename = "./_rescript/" ^ file ^ ".resi" in
+        let result = ref [ "" ] in
+        let subName = block in
+        let handle_line line =
+          match has_type_definition line subName with
+          | true ->
+              result := List.append [ line ] !result
+          | _ ->
+            ( match !result with
+            | [ "" ] | "}" :: _ ->
+                ()
+            | _ ->
+                result := List.append [ line |> String.trim ] !result )
+        in
+        let () =
+          let lines = read_file filename in
+          List.iter handle_line lines
+        in
+        !result |> List.tl |> List.rev
+      in
+      let fetch_rescript_type ~moduleName ~funcName =
+        let filename = "./_rescript/" ^ moduleName ^ ".resi" in
+        let result = ref [ "" ] in
+        let handle_line line =
+          match (has_type_definition line funcName, !result) with
+          | true, [ "" ] ->
+              result := List.append [ line ] !result
+          | _, "" :: rest ->
+              ()
+          | _ ->
+              result := List.append [ line; "\n" ] !result
+        in
+
+        let () =
+          let lines =
+            match moduleName |> is_submodule with
+            | Some (file, block) ->
+                fetch_rescript_submodule ~file ~block
+            | None ->
+                read_file filename
+          in
+
+          List.iter handle_line lines
+        in
+        !result |> List.rev |> String.concat "" |> trim_name |> remove_external
+      in
+      let rendered =
+        fetch_rescript_type ~moduleName ~funcName
+        |> Odoc_info.remove_ending_newline
+      in
+      obj [ ("rendered", string rendered) ]
+
     (** Json to display a [Types.type_expr list]. *)
     method json_of_cstr_args
         ?(par : bool option)
@@ -1179,12 +1316,21 @@ class json =
     method json_of_value v : Json.t =
       let open Json in
       Odoc_info.reset_type_names () ;
+      let value_content =
+        match destination_json with
+        | "model-rescript.json" ->
+            self#json_of_rescript_type_expr
+              (Name.father v.val_name)
+              (Name.simple v.val_name)
+        | _ ->
+            self#json_of_type_expr v.val_type
+      in
       tagged
         "Value"
         (obj
            [ ("name", string (Name.simple v.val_name))
            ; ("qualified_name", string v.val_name)
-           ; ("type", self#json_of_type_expr v.val_type)
+           ; ("type", value_content)
            ; ("info", self#json_of_info v.val_info)
            ; ( "parameters"
              , self#json_of_described_parameter_list

ocamldoc-json-generator/Makefile

@@ -147,6 +147,28 @@ build-rescript: opt dummy
 	cp ../rescript/src/Tablecloth.ml ./_rescript/Tablecloth.ml
 	~/.npm-global/bin/esy build
 
+rescript-interfaces: opt dummy
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothBool.mli > ./_rescript/TableclothBool.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothComparator.mli > ./_rescript/TableclothComparator.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothFloat.mli > ./_rescript/TableclothFloat.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothFun.mli > ./_rescript/TableclothFun.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothInt.mli > ./_rescript/TableclothInt.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothArray.mli > ./_rescript/TableclothArray.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothChar.mli > ./_rescript/TableclothChar.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothList.mli > ./_rescript/TableclothList.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothMap.mli > ./_rescript/TableclothMap.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothOption.mli > ./_rescript/TableclothOption.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothResult.mli > ./_rescript/TableclothResult.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothSet.mli > ./_rescript/TableclothSet.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothString.mli > ./_rescript/TableclothString.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothTuple2.mli > ./_rescript/TableclothTuple2.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothTuple3.mli > ./_rescript/TableclothTuple3.resi
+	# These are not interfaces, so we do just pretend that they actually are. Still works!
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/Internal.ml > ./_rescript/Internal.resi 
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothComparator.ml > ./_rescript/TableclothComparator.resi
+	~/.npm-global/bin/esy bsc -format res ../rescript/src/TableclothContainer.ml > ./_rescript/TableclothContainer.resi
+
+
 doc-native: build-native
 	DESTINATION_JSON=model.json \
 	~/.npm-global/bin/esy ocamldoc.opt \
@@ -234,6 +256,6 @@ doc-rescript: build-rescript
 doc: doc-native doc-rescript
 
 clean:
-	rm -f _rescript/* *.cm* *.o *.a
+	rm -f _rescript/* *.cm* *.o *.a 
 	rm -f _native/* *.cm* *.o *.a
 

ocamldoc-json-generator/esy.json

@@ -4,15 +4,17 @@
     "ocaml": "4.12.x",
     "melange": "melange-re/melange",
     "@opam/base": "v0.14.1",
-    "@opam/menhir": "20210419"
+    "@opam/menhir": "20210419",
+    "@opam/ocamlformat":"*"
   },
   "esy": {
     "buildsInSource": "unsafe",
     "build": [
       "rm -rf node_modules/bs-platform",
       "ln -sfn #{melange.install} node_modules/bs-platform",
       "bsb -make-world"
-    ]
+    ],
+    "format": "dune build @fmt --auto-promote"
   },
   "installConfig": {
     "pnp": false

ocamldoc-json-generator/readme.md

@@ -1,6 +1,6 @@
 # Ocamldoc Json Generator
 
-JsonGenerator.ml is responsible for taking the `/native` and `/rescript` source files and turning them into json files (`website/model.json` and `website/model-rescript.json`) which the website project then turns into the `/api` page.
+JsonGenerator.ml is responsible for taking the `/native` and `/rescript` source files and turning them into json files (`website/model.json` and `website/model-rescript.json`) which the website project then turns into the `/docs` page.
 
 ## Setup
 To generate both native and rescript versions we'll need (esy)[https://esy.sh/docs/en/getting-started.html]. 
@@ -15,10 +15,10 @@ Next, install dependancies
 esy
 ```
 
-Then build the project files
+Then generate rescript interfaces
 
 ```sh
-make deps
+make rescript-interfaces
 ```
 
 ## Usage

rescript/src/TableclothMap.ml

@@ -105,7 +105,9 @@ module Poly = struct
 end
 
 module Int = struct
-  type nonrec 'value t = 'value Of(TableclothInt).t
+  type identity
+
+  type nonrec 'value t = (TableclothInt.t, 'value, identity) t
 
   let fromArray a = Poly.fromArray a |> Obj.magic
 
@@ -117,7 +119,9 @@ module Int = struct
 end
 
 module String = struct
-  type nonrec 'value t = 'value Of(TableclothString).t
+  type identity
+
+  type nonrec 'value t = (TableclothString.t, 'value, identity) t
 
   let fromArray a = Poly.fromArray a |> Obj.magic
 

rescript/src/TableclothMap.mli

@@ -515,7 +515,9 @@ end
 
 (** Construct a Map with {!Int}s for keys. *)
 module Int : sig
-  type nonrec 'value t = 'value Of(TableclothInt).t
+  type identity
+
+  type nonrec 'value t = (TableclothInt.t, 'value, identity) t
 
   val empty : 'value t
   (** A map with nothing in it. *)
@@ -537,7 +539,9 @@ end
 
 (** Construct a Map with {!String}s for keys. *)
 module String : sig
-  type nonrec 'value t = 'value Of(TableclothString).t
+  type identity
+
+  type nonrec 'value t = (TableclothString.t, 'value, identity) t
 
   val empty : 'value t
   (** A map with nothing in it. *)

rescript/src/TableclothSet.ml

@@ -90,7 +90,9 @@ module Poly = struct
 end
 
 module Int = struct
-  type nonrec t = Of(TableclothInt).t
+  type identity
+
+  type nonrec t = (TableclothInt.t, identity) t
 
   let fromArray a = Poly.fromArray a |> Obj.magic
 
@@ -102,7 +104,9 @@ module Int = struct
 end
 
 module String = struct
-  type nonrec t = Of(TableclothString).t
+  type identity
+
+  type nonrec t = (TableclothString.t, identity) t
 
   let fromArray a = Poly.fromArray a |> Obj.magic
 

rescript/src/TableclothSet.mli

@@ -300,7 +300,9 @@ end
 
 (** Construct sets of {!Int}s *)
 module Int : sig
-  type nonrec t = Of(TableclothInt).t
+  type identity
+
+  type nonrec t = (TableclothInt.t, identity) t
 
   val empty : t
   (** A set with nothing in it. *)
@@ -332,7 +334,9 @@ end
 
 (** Construct sets of {!String}s *)
 module String : sig
-  type nonrec t = Of(TableclothString).t
+  type identity
+
+  type nonrec t = (TableclothString.t, identity) t
 
   val empty : t
   (** A set with nothing in it. *)