From 88819e36e3ea3bb86bc43598fc391f89942ae007 Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Tue, 8 Oct 2024 17:16:27 +0200
Subject: [PATCH 01/24] Proof of concept to print type_expr
---
tools/src/print_tast.ml | 265 ++++++++++++++++++++++++++++++++++++++++
tools/src/tools.ml | 18 ++-
2 files changed, 282 insertions(+), 1 deletion(-)
create mode 100644 tools/src/print_tast.ml
diff --git a/tools/src/print_tast.ml b/tools/src/print_tast.ml
new file mode 100644
index 000000000..98380930e
--- /dev/null
+++ b/tools/src/print_tast.ml
@@ -0,0 +1,265 @@
+(* *)
+
+(** Transform the AST types to the more generic Oak format *)
+module Oak = struct
+ type application = {name: string; argument: oak}
+
+ and namedField = {name: string; value: oak}
+
+ and oak =
+ | Application of application
+ | Record of namedField list
+ | Ident of string
+ | Tuple of namedField list
+ | List of oak list
+
+ let rec path_to_string = function
+ | Path.Pident id -> Ident.name id
+ | Path.Pdot (p, s, _) -> path_to_string p ^ "." ^ s
+ | Path.Papply (p1, p2) -> path_to_string p1 ^ "(" ^ path_to_string p2 ^ ")"
+
+ let rec mk_type_desc (desc : Types.type_desc) : oak =
+ match desc with
+ | Tvar _ -> Ident "type_desc.Tvar"
+ | Tarrow (_, t1, t2, _) ->
+ Application
+ {
+ name = "type_desc.Tarrow";
+ argument =
+ Tuple
+ [
+ {name = "t1"; value = mk_type_desc t1.desc};
+ {name = "t2"; value = mk_type_desc t2.desc};
+ ];
+ }
+ | Ttuple _ -> Ident "type_desc.Ttuple"
+ | Tconstr (path, ts, _) ->
+ let ts =
+ ts |> List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc)
+ in
+ Application
+ {
+ name = "type_desc.Tconstr";
+ argument =
+ Tuple
+ [
+ {name = "path"; value = Ident (path_to_string path)};
+ {name = "ts"; value = List ts};
+ ];
+ }
+ | Tobject _ -> Ident "type_desc.Tobject"
+ | Tfield _ -> Ident "type_desc.Tfield"
+ | Tnil -> Ident "type_desc.Tnil"
+ | Tlink {desc} -> Ident "type_desc.Tlink"
+ | Tsubst _ -> Ident "type_desc.Tsubst"
+ | Tvariant row_descr -> Ident "type_desc.Tvariant"
+ | Tunivar _ -> Ident "type_desc.Tunivar"
+ | Tpoly _ -> Ident "type_desc.Tpoly"
+ | Tpackage _ -> Ident "type_desc.Tpackage"
+end
+
+(** Transform the Oak types to string *)
+module CodePrinter = struct
+ type writerEvents =
+ | Write of string
+ | WriteLine
+ | IndentBy of int
+ | UnindentBy of int
+
+ type context = {
+ indent_size: int;
+ max_line_length: int;
+ current_indent: int;
+ current_line_column: int;
+ events: writerEvents list;
+ }
+
+ let countLines (ctx : context) =
+ ctx.events
+ |> List.filter (fun event ->
+ match event with
+ | WriteLine -> true
+ | _ -> false)
+ |> List.length
+
+ type appendEvents = context -> context
+
+ let emptyContext =
+ {
+ indent_size = 2;
+ max_line_length = 80;
+ current_indent = 0;
+ current_line_column = 0;
+ events = [];
+ }
+
+ (* Type representing the writer context during code printing
+
+ - [indent_size] is the configured indentation size, typically 2
+ - [current_indent] is the current indentation size
+ - [current_line_column] is the characters written on the current line
+ - [events] is the write events in reverse order, head event is last written
+ *)
+
+ let id x = x
+
+ (** add a write event to the context *)
+ let ( !- ) str ctx =
+ {
+ ctx with
+ events = Write str :: ctx.events;
+ current_line_column = ctx.current_line_column + String.length str;
+ }
+
+ (** compose two context transforming functions *)
+ let ( +> ) f g ctx = g (f ctx)
+
+ let sepNln ctx =
+ {ctx with events = WriteLine :: ctx.events; current_line_column = 0}
+
+ let sepComma ctx = !-", " ctx
+ let sepSemi ctx = !-"; " ctx
+ let sepOpenT ctx = !-"(" ctx
+ let sepCloseT ctx = !-")" ctx
+ let sepOpenR ctx = !-"{" ctx
+ let sepCloseR ctx = !-"}" ctx
+ let sepOpenL ctx = !-"[" ctx
+ let sepCloseL ctx = !-"]" ctx
+ let sepEq ctx = !-" = " ctx
+ let indent ctx =
+ let nextIdent = ctx.current_indent + ctx.indent_size in
+ {
+ ctx with
+ current_indent = nextIdent;
+ current_line_column = nextIdent;
+ events = IndentBy ctx.indent_size :: ctx.events;
+ }
+ let unindent ctx =
+ let nextIdent = ctx.current_indent - ctx.indent_size in
+ {
+ ctx with
+ current_indent = nextIdent;
+ current_line_column = nextIdent;
+ events = UnindentBy ctx.indent_size :: ctx.events;
+ }
+
+ let indentAndNln f = indent +> sepNln +> f +> unindent
+
+ let col (f : 't -> appendEvents) (intertwine : appendEvents) items ctx =
+ let rec visit items ctx =
+ match items with
+ | [] -> ctx
+ | [item] -> f item ctx
+ | item :: rest ->
+ let ctx' = (f item +> intertwine) ctx in
+ visit rest ctx'
+ in
+ visit items ctx
+
+ let expressionFitsOnRestOfLine (f : appendEvents) (fallback : appendEvents)
+ (ctx : context) =
+ let current_line_count = countLines ctx in
+ let shortCtx = f ctx in
+ let nextLineCount = countLines shortCtx in
+ if
+ current_line_count == nextLineCount
+ && shortCtx.current_line_column <= ctx.max_line_length
+ then shortCtx
+ else fallback ctx
+
+ (** Fold all the events in context into text *)
+ let dump (ctx : context) =
+ let addSpaces n = String.make n ' ' in
+
+ List.fold_right
+ (fun event (acc, current_indent) ->
+ match event with
+ | Write str -> (acc ^ str, current_indent)
+ | WriteLine -> (acc ^ "\n" ^ addSpaces current_indent, current_indent)
+ | IndentBy n -> (acc, current_indent + n)
+ | UnindentBy n -> (acc, current_indent - n))
+ ctx.events ("", 0)
+ |> fst
+
+ let rec genOak (oak : Oak.oak) : appendEvents =
+ match oak with
+ | Oak.Application application -> genApplication application
+ | Oak.Record record -> genRecord record
+ | Oak.Ident ident -> genIdent ident
+ | Oak.Tuple ts -> genTuple ts
+ | Oak.List xs -> genList xs
+
+ and genApplication (application : Oak.application) : appendEvents =
+ let short =
+ !-(application.name) +> sepOpenT
+ +> genOak application.argument
+ +> sepCloseT
+ in
+ let long =
+ !-(application.name) +> sepOpenT
+ +> indentAndNln (genOak application.argument)
+ +> sepNln +> sepCloseT
+ in
+ expressionFitsOnRestOfLine short long
+
+ and genRecord (recordFields : Oak.namedField list) : appendEvents =
+ let short =
+ sepOpenR +> col genNamedField sepSemi recordFields +> sepCloseR
+ in
+ let long =
+ sepOpenR
+ +> indentAndNln (col genNamedField sepNln recordFields)
+ +> sepNln +> sepCloseR
+ in
+ expressionFitsOnRestOfLine short long
+
+ and genTuple (oaks : Oak.namedField list) : appendEvents =
+ let short = col genNamedField sepComma oaks in
+ let long = col genNamedField sepNln oaks in
+ expressionFitsOnRestOfLine short long
+
+ and genIdent (ident : string) : appendEvents = !-ident
+
+ and genNamedField (field : Oak.namedField) : appendEvents =
+ let short = !-(field.name) +> sepEq +> genOak field.value in
+ let long =
+ !-(field.name) +> sepEq
+ +>
+ match field.value with
+ | Oak.List _ -> genOak field.value
+ | _ -> indentAndNln (genOak field.value)
+ in
+ expressionFitsOnRestOfLine short long
+
+ and genList (items : Oak.oak list) : appendEvents =
+ let short = sepOpenL +> col genOak sepSemi items +> sepCloseL in
+ let long =
+ sepOpenL +> indentAndNln (col genOak sepNln items) +> sepNln +> sepCloseL
+ in
+ expressionFitsOnRestOfLine short long
+end
+
+let print_type_expr (typ : Types.type_expr) : string =
+ CodePrinter.genOak (Oak.mk_type_desc typ.desc) CodePrinter.emptyContext
+ |> CodePrinter.dump
+
+(* let oak =
+ Oak.Application
+ {
+ Oak.name = "foo";
+ argument =
+ Oak.Tuple [{Oak.name = "foo"; value = Oak.Ident "baaaaaaaaaaaaaaaaar"}];
+ } *)
+(* Oak.Record
+ [
+ {Oak.name = "foo"; value = Oak.Ident "baaaaaaaaaaaaaaaaar"};
+ {Oak.name = "member"; value = Oak.Ident "Zigbar"};
+ ] *)
+
+(* let _ =
+ CodePrinter.genOak oak CodePrinter.emptyContext
+ |> CodePrinter.dump |> Format.printf "%s\n" *)
+
+(*
+ Interpret using ocaml /home/nojaf/projects/rescript-vscode/tools/src/print_tast.ml
+*)
diff --git a/tools/src/tools.ml b/tools/src/tools.ml
index 08837943b..08f0eb0ac 100644
--- a/tools/src/tools.ml
+++ b/tools/src/tools.ml
@@ -18,11 +18,14 @@ type constructorDoc = {
items: constructorPayload option;
}
+type valueSignature = {parameters: string list; returnType: string}
+
type source = {filepath: string; line: int; col: int}
type docItemDetail =
| Record of {fieldDocs: fieldDoc list}
| Variant of {constructorDocs: constructorDoc list}
+ | Signature of valueSignature
type docItem =
| Value of {
@@ -31,6 +34,7 @@ type docItem =
signature: string;
name: string;
deprecated: string option;
+ detail: docItemDetail option;
source: source;
}
| Type of {
@@ -147,6 +151,7 @@ let stringifyDetail ?(indentation = 0) (detail : docItemDetail) =
])
|> array) );
]
+ | Signature {parameters; returnType} -> returnType
let stringifySource ~indentation source =
let open Protocol in
@@ -160,7 +165,7 @@ let stringifySource ~indentation source =
let rec stringifyDocItem ?(indentation = 0) ~originalEnv (item : docItem) =
let open Protocol in
match item with
- | Value {id; docstring; signature; name; deprecated; source} ->
+ | Value {id; docstring; signature; name; deprecated; source; detail} ->
stringifyObject ~startOnNewline:true ~indentation
[
("id", Some (wrapInQuotes id));
@@ -173,6 +178,11 @@ let rec stringifyDocItem ?(indentation = 0) ~originalEnv (item : docItem) =
("signature", Some (signature |> String.trim |> wrapInQuotes));
("docstrings", Some (stringifyDocstrings docstring));
("source", Some (stringifySource ~indentation:(indentation + 1) source));
+ ( "detail",
+ match detail with
+ | None -> None
+ | Some detail ->
+ Some (stringifyDetail ~indentation:(indentation + 1) detail) );
]
| Type {id; docstring; signature; name; deprecated; detail; source} ->
stringifyObject ~startOnNewline:true ~indentation
@@ -310,6 +320,11 @@ let typeDetail typ ~env ~full =
})
| _ -> None
+let valueDetail (item : SharedTypes.Module.item) (typ : Types.type_expr) =
+ let s = Print_tast.print_type_expr typ in
+ Format.printf "%s\n" s;
+ Some (Signature {parameters = []; returnType = s})
+
let makeId modulePath ~identifier =
identifier :: modulePath |> List.rev |> SharedTypes.ident
@@ -398,6 +413,7 @@ let extractDocs ~entryPointFile ~debug =
^ Shared.typeToString typ;
name = item.name;
deprecated = item.deprecated;
+ detail = valueDetail item typ;
source;
})
| Type (typ, _) ->
From c88a9c9bc2786afe6dd63f1a5229e1041de2d2fe Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Tue, 8 Oct 2024 20:06:44 +0200
Subject: [PATCH 02/24] Print more variants of type_desc
---
tools/bin/main.ml | 5 +++
tools/src/print_tast.ml | 84 +++++++++++++++++++++++++++++++++++++----
tools/src/tools.ml | 60 ++++++++++++++++++++++++++++-
3 files changed, 140 insertions(+), 9 deletions(-)
diff --git a/tools/bin/main.ml b/tools/bin/main.ml
index 06be383b1..1183a2aa4 100644
--- a/tools/bin/main.ml
+++ b/tools/bin/main.ml
@@ -31,6 +31,11 @@ let version = Version.version
let main () =
match Sys.argv |> Array.to_list |> List.tl with
+ | "temp" :: rest -> (
+ match rest with
+ | ["-h"] | ["--help"] -> logAndExit (Ok docHelp)
+ | [path] -> logAndExit (Tools.dump ~entryPointFile:path ~debug:false)
+ | _ -> logAndExit (Error docHelp))
| "doc" :: rest -> (
match rest with
| ["-h"] | ["--help"] -> logAndExit (Ok docHelp)
diff --git a/tools/src/print_tast.ml b/tools/src/print_tast.ml
index 98380930e..2c01f2141 100644
--- a/tools/src/print_tast.ml
+++ b/tools/src/print_tast.ml
@@ -50,12 +50,65 @@ module Oak = struct
| Tobject _ -> Ident "type_desc.Tobject"
| Tfield _ -> Ident "type_desc.Tfield"
| Tnil -> Ident "type_desc.Tnil"
- | Tlink {desc} -> Ident "type_desc.Tlink"
+ | Tlink {desc} ->
+ Application {name = "type_desc.Tlink"; argument = mk_type_desc desc}
| Tsubst _ -> Ident "type_desc.Tsubst"
- | Tvariant row_descr -> Ident "type_desc.Tvariant"
+ | Tvariant row_descr ->
+ Application
+ {name = "type_desc.Tvariant"; argument = mk_row_desc row_descr}
| Tunivar _ -> Ident "type_desc.Tunivar"
| Tpoly _ -> Ident "type_desc.Tpoly"
| Tpackage _ -> Ident "type_desc.Tpackage"
+
+ and mk_row_desc (row_desc : Types.row_desc) : oak =
+ let fields =
+ [
+ {
+ name = "row_fields";
+ value =
+ ( row_desc.row_fields
+ |> List.map (fun (label, row_field) ->
+ Tuple
+ [
+ {name = "label"; value = Ident label};
+ {name = "row_field"; value = mk_row_field row_field};
+ ])
+ |> fun ts -> List ts );
+ };
+ {name = "row_more"; value = mk_type_desc row_desc.row_more.desc};
+ {name = "row_closed"; value = mk_bool row_desc.row_closed};
+ {name = "row_fixed"; value = mk_bool row_desc.row_fixed};
+ ]
+ in
+ match row_desc.row_name with
+ | None -> Record fields
+ | Some (path, ts) ->
+ Record
+ ({
+ name = "row_name";
+ value =
+ Tuple
+ [
+ {name = "Path.t"; value = Ident (path_to_string path)};
+ {
+ name = "fields";
+ value =
+ List
+ (ts
+ |> List.map (fun (t : Types.type_expr) ->
+ mk_type_desc t.desc));
+ };
+ ];
+ }
+ :: fields)
+
+ and mk_row_field (row_field : Types.row_field) : oak =
+ match row_field with
+ | Rpresent _ -> Ident "row_field.Rpresent"
+ | Reither _ -> Ident "row_field.Reither"
+ | Rabsent -> Ident "row_field.Rabsent"
+
+ and mk_bool (b : bool) : oak = if b then Ident "true" else Ident "false"
end
(** Transform the Oak types to string *)
@@ -116,7 +169,7 @@ module CodePrinter = struct
let sepNln ctx =
{ctx with events = WriteLine :: ctx.events; current_line_column = 0}
-
+ let sepSpace ctx = !-" " ctx
let sepComma ctx = !-", " ctx
let sepSemi ctx = !-"; " ctx
let sepOpenT ctx = !-"(" ctx
@@ -126,6 +179,7 @@ module CodePrinter = struct
let sepOpenL ctx = !-"[" ctx
let sepCloseL ctx = !-"]" ctx
let sepEq ctx = !-" = " ctx
+ let wrapInParentheses f = sepOpenT +> f +> sepCloseT
let indent ctx =
let nextIdent = ctx.current_indent + ctx.indent_size in
{
@@ -197,14 +251,18 @@ module CodePrinter = struct
in
let long =
!-(application.name) +> sepOpenT
- +> indentAndNln (genOak application.argument)
- +> sepNln +> sepCloseT
+ +> (match application.argument with
+ | Oak.List _ | Oak.Record _ -> genOak application.argument
+ | _ -> indentAndNln (genOak application.argument) +> sepNln)
+ +> sepCloseT
in
expressionFitsOnRestOfLine short long
and genRecord (recordFields : Oak.namedField list) : appendEvents =
let short =
- sepOpenR +> col genNamedField sepSemi recordFields +> sepCloseR
+ sepOpenR +> sepSpace
+ +> col genNamedField sepSemi recordFields
+ +> sepSpace +> sepCloseR
in
let long =
sepOpenR
@@ -232,9 +290,19 @@ module CodePrinter = struct
expressionFitsOnRestOfLine short long
and genList (items : Oak.oak list) : appendEvents =
- let short = sepOpenL +> col genOak sepSemi items +> sepCloseL in
+ let genItem = function
+ | Oak.Tuple _ as item -> wrapInParentheses (genOak item)
+ | item -> genOak item
+ in
+ let short =
+ match items with
+ | [] -> sepOpenL +> sepCloseL
+ | _ ->
+ sepOpenL +> sepSpace +> col genItem sepSemi items +> sepSpace
+ +> sepCloseL
+ in
let long =
- sepOpenL +> indentAndNln (col genOak sepNln items) +> sepNln +> sepCloseL
+ sepOpenL +> indentAndNln (col genItem sepNln items) +> sepNln +> sepCloseL
in
expressionFitsOnRestOfLine short long
end
diff --git a/tools/src/tools.ml b/tools/src/tools.ml
index 08f0eb0ac..7f9ff0306 100644
--- a/tools/src/tools.ml
+++ b/tools/src/tools.ml
@@ -322,7 +322,6 @@ let typeDetail typ ~env ~full =
let valueDetail (item : SharedTypes.Module.item) (typ : Types.type_expr) =
let s = Print_tast.print_type_expr typ in
- Format.printf "%s\n" s;
Some (Signature {parameters = []; returnType = s})
let makeId modulePath ~identifier =
@@ -337,6 +336,65 @@ let getSource ~rootPath ({loc_start} : Location.t) =
in
{filepath; line = line + 1; col = col + 1}
+let dump ~entryPointFile ~debug =
+ let path =
+ match Filename.is_relative entryPointFile with
+ | true -> Unix.realpath entryPointFile
+ | false -> entryPointFile
+ in
+ if debug then Printf.printf "extracting docs for %s\n" path;
+ let result =
+ match
+ FindFiles.isImplementation path = false
+ && FindFiles.isInterface path = false
+ with
+ | false -> (
+ let path =
+ if FindFiles.isImplementation path then
+ let pathAsResi =
+ (path |> Filename.dirname) ^ "/"
+ ^ (path |> Filename.basename |> Filename.chop_extension)
+ ^ ".resi"
+ in
+ if Sys.file_exists pathAsResi then (
+ if debug then
+ Printf.printf "preferring found resi file for impl: %s\n"
+ pathAsResi;
+ pathAsResi)
+ else path
+ else path
+ in
+ match Cmt.loadFullCmtFromPath ~path with
+ | None ->
+ Error
+ (Printf.sprintf
+ "error: failed to generate doc for %s, try to build the project"
+ path)
+ | Some full ->
+ let file = full.file in
+ let structure = file.structure in
+ let open SharedTypes in
+ let extractDocsForModule (structure : Module.structure) =
+ structure.items
+ |> List.filter_map (fun (item : Module.item) ->
+ match item.kind with
+ | Value typ -> (
+ match valueDetail item typ with
+ | Some (Signature {returnType = rt}) -> Some rt
+ | _ -> None)
+ | _ -> None)
+ |> String.concat "\n"
+ in
+ let docs = extractDocsForModule structure in
+ Ok docs)
+ | true ->
+ Error
+ (Printf.sprintf
+ "error: failed to read %s, expected an .res or .resi file" path)
+ in
+
+ result
+
let extractDocs ~entryPointFile ~debug =
let path =
match Filename.is_relative entryPointFile with
From 4d596d8fc23479d92890130893aa28643078bcb8 Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Tue, 8 Oct 2024 21:11:21 +0200
Subject: [PATCH 03/24] Initial signature dump
---
tools/bin/main.ml | 5 --
tools/src/print_tast.ml | 35 ++++-------
tools/src/tools.ml | 135 +++++++++++++++++++++-------------------
3 files changed, 81 insertions(+), 94 deletions(-)
diff --git a/tools/bin/main.ml b/tools/bin/main.ml
index 1183a2aa4..06be383b1 100644
--- a/tools/bin/main.ml
+++ b/tools/bin/main.ml
@@ -31,11 +31,6 @@ let version = Version.version
let main () =
match Sys.argv |> Array.to_list |> List.tl with
- | "temp" :: rest -> (
- match rest with
- | ["-h"] | ["--help"] -> logAndExit (Ok docHelp)
- | [path] -> logAndExit (Tools.dump ~entryPointFile:path ~debug:false)
- | _ -> logAndExit (Error docHelp))
| "doc" :: rest -> (
match rest with
| ["-h"] | ["--help"] -> logAndExit (Ok docHelp)
diff --git a/tools/src/print_tast.ml b/tools/src/print_tast.ml
index 2c01f2141..4850e5e4d 100644
--- a/tools/src/print_tast.ml
+++ b/tools/src/print_tast.ml
@@ -1,5 +1,3 @@
-(* *)
-
(** Transform the AST types to the more generic Oak format *)
module Oak = struct
type application = {name: string; argument: oak}
@@ -20,7 +18,10 @@ module Oak = struct
let rec mk_type_desc (desc : Types.type_desc) : oak =
match desc with
- | Tvar _ -> Ident "type_desc.Tvar"
+ | Tvar var -> (
+ match var with
+ | None -> Application {name = "type_desc.Tvar"; argument = Ident "None"}
+ | Some s -> Application {name = "type_desc.Tvar"; argument = Ident s})
| Tarrow (_, t1, t2, _) ->
Application
{
@@ -113,6 +114,13 @@ end
(** Transform the Oak types to string *)
module CodePrinter = struct
+ (**
+ The idea is that we capture events in a context type.
+ Doing this allows us to reason about the current state of the writer
+ and whether the next expression fits on the current line or not.
+
+ *)
+
type writerEvents =
| Write of string
| WriteLine
@@ -310,24 +318,3 @@ end
let print_type_expr (typ : Types.type_expr) : string =
CodePrinter.genOak (Oak.mk_type_desc typ.desc) CodePrinter.emptyContext
|> CodePrinter.dump
-
-(* let oak =
- Oak.Application
- {
- Oak.name = "foo";
- argument =
- Oak.Tuple [{Oak.name = "foo"; value = Oak.Ident "baaaaaaaaaaaaaaaaar"}];
- } *)
-(* Oak.Record
- [
- {Oak.name = "foo"; value = Oak.Ident "baaaaaaaaaaaaaaaaar"};
- {Oak.name = "member"; value = Oak.Ident "Zigbar"};
- ] *)
-
-(* let _ =
- CodePrinter.genOak oak CodePrinter.emptyContext
- |> CodePrinter.dump |> Format.printf "%s\n" *)
-
-(*
- Interpret using ocaml /home/nojaf/projects/rescript-vscode/tools/src/print_tast.ml
-*)
diff --git a/tools/src/tools.ml b/tools/src/tools.ml
index 7f9ff0306..2b7258f57 100644
--- a/tools/src/tools.ml
+++ b/tools/src/tools.ml
@@ -18,7 +18,8 @@ type constructorDoc = {
items: constructorPayload option;
}
-type valueSignature = {parameters: string list; returnType: string}
+type typeDoc = {path: string; genericParameters: typeDoc list}
+type valueSignature = {parameters: typeDoc list; returnType: typeDoc}
type source = {filepath: string; line: int; col: int}
@@ -108,6 +109,19 @@ let stringifyConstructorPayload ~indentation
|> array) );
]
+let rec stringifyTypeDoc ~indentation (td : typeDoc) : string =
+ let open Protocol in
+ let ps =
+ match td.genericParameters with
+ | [] -> None
+ | ts ->
+ ts |> List.map (stringifyTypeDoc ~indentation:(indentation + 1))
+ |> fun ts -> Some (array ts)
+ in
+
+ stringifyObject ~indentation:(indentation + 1)
+ [("path", Some (wrapInQuotes td.path)); ("genericTypeParameters", ps)]
+
let stringifyDetail ?(indentation = 0) (detail : docItemDetail) =
let open Protocol in
match detail with
@@ -151,7 +165,19 @@ let stringifyDetail ?(indentation = 0) (detail : docItemDetail) =
])
|> array) );
]
- | Signature {parameters; returnType} -> returnType
+ | Signature {parameters; returnType} ->
+ let ps =
+ match parameters with
+ | [] -> None
+ | ps ->
+ ps |> List.map (stringifyTypeDoc ~indentation:(indentation + 1))
+ |> fun ps -> Some (array ps)
+ in
+ stringifyObject ~startOnNewline:false ~indentation
+ [
+ ("parameters", ps);
+ ("returnType", Some (stringifyTypeDoc ~indentation returnType));
+ ]
let stringifySource ~indentation source =
let open Protocol in
@@ -320,9 +346,47 @@ let typeDetail typ ~env ~full =
})
| _ -> None
-let valueDetail (item : SharedTypes.Module.item) (typ : Types.type_expr) =
- let s = Print_tast.print_type_expr typ in
- Some (Signature {parameters = []; returnType = s})
+(* split a list into two parts all the items except the last one and the last item *)
+let splitLast l =
+ let rec splitLast' acc = function
+ | [] -> failwith "splitLast: empty list"
+ | [x] -> (List.rev acc, x)
+ | x :: xs -> splitLast' (x :: acc) xs
+ in
+ splitLast' [] l
+
+let isFunction = function
+ | Path.Pident {name = "function$"} -> true
+ | _ -> false
+
+let valueDetail (typ : Types.type_expr) =
+ Printf.printf "%s\n" (Print_tast.print_type_expr typ);
+ let rec collectSignatureTypes (typ_desc : Types.type_desc) =
+ match typ_desc with
+ | Tlink t -> collectSignatureTypes t.desc
+ | Tconstr (path, [t; _], _) when isFunction path ->
+ collectSignatureTypes t.desc
+ | Tconstr (path, ts, _) -> (
+ let p = Print_tast.Oak.path_to_string path in
+ match ts with
+ | [] -> [{path = p; genericParameters = []}]
+ | ts ->
+ let ts =
+ ts
+ |> List.concat_map (fun (t : Types.type_expr) ->
+ collectSignatureTypes t.desc)
+ in
+ [{path = p; genericParameters = ts}])
+ | Tarrow (_, t1, t2, _) ->
+ collectSignatureTypes t1.desc @ collectSignatureTypes t2.desc
+ | Tvar None -> [{path = "_"; genericParameters = []}]
+ | _ -> []
+ in
+ match collectSignatureTypes typ.desc with
+ | [] -> None
+ | ts ->
+ let parameters, returnType = splitLast ts in
+ Some (Signature {parameters; returnType})
let makeId modulePath ~identifier =
identifier :: modulePath |> List.rev |> SharedTypes.ident
@@ -336,65 +400,6 @@ let getSource ~rootPath ({loc_start} : Location.t) =
in
{filepath; line = line + 1; col = col + 1}
-let dump ~entryPointFile ~debug =
- let path =
- match Filename.is_relative entryPointFile with
- | true -> Unix.realpath entryPointFile
- | false -> entryPointFile
- in
- if debug then Printf.printf "extracting docs for %s\n" path;
- let result =
- match
- FindFiles.isImplementation path = false
- && FindFiles.isInterface path = false
- with
- | false -> (
- let path =
- if FindFiles.isImplementation path then
- let pathAsResi =
- (path |> Filename.dirname) ^ "/"
- ^ (path |> Filename.basename |> Filename.chop_extension)
- ^ ".resi"
- in
- if Sys.file_exists pathAsResi then (
- if debug then
- Printf.printf "preferring found resi file for impl: %s\n"
- pathAsResi;
- pathAsResi)
- else path
- else path
- in
- match Cmt.loadFullCmtFromPath ~path with
- | None ->
- Error
- (Printf.sprintf
- "error: failed to generate doc for %s, try to build the project"
- path)
- | Some full ->
- let file = full.file in
- let structure = file.structure in
- let open SharedTypes in
- let extractDocsForModule (structure : Module.structure) =
- structure.items
- |> List.filter_map (fun (item : Module.item) ->
- match item.kind with
- | Value typ -> (
- match valueDetail item typ with
- | Some (Signature {returnType = rt}) -> Some rt
- | _ -> None)
- | _ -> None)
- |> String.concat "\n"
- in
- let docs = extractDocsForModule structure in
- Ok docs)
- | true ->
- Error
- (Printf.sprintf
- "error: failed to read %s, expected an .res or .resi file" path)
- in
-
- result
-
let extractDocs ~entryPointFile ~debug =
let path =
match Filename.is_relative entryPointFile with
@@ -471,7 +476,7 @@ let extractDocs ~entryPointFile ~debug =
^ Shared.typeToString typ;
name = item.name;
deprecated = item.deprecated;
- detail = valueDetail item typ;
+ detail = valueDetail typ;
source;
})
| Type (typ, _) ->
From 312eee01eccf06a82850640830dfef2641c0432a Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Wed, 9 Oct 2024 10:46:04 +0200
Subject: [PATCH 04/24] Add dump command to view full file
---
tools/bin/main.ml | 1 +
tools/src/print_tast.ml | 134 +++++++++++++++++++++++++++++++++-------
tools/src/tools.ml | 40 ++++++++++++
3 files changed, 152 insertions(+), 23 deletions(-)
diff --git a/tools/bin/main.ml b/tools/bin/main.ml
index 06be383b1..633b0b61b 100644
--- a/tools/bin/main.ml
+++ b/tools/bin/main.ml
@@ -31,6 +31,7 @@ let version = Version.version
let main () =
match Sys.argv |> Array.to_list |> List.tl with
+ | ["dump"; file] -> Tools.dump file |> logAndExit
| "doc" :: rest -> (
match rest with
| ["-h"] | ["--help"] -> logAndExit (Ok docHelp)
diff --git a/tools/src/print_tast.ml b/tools/src/print_tast.ml
index 4850e5e4d..e6c4ade87 100644
--- a/tools/src/print_tast.ml
+++ b/tools/src/print_tast.ml
@@ -1,3 +1,5 @@
+open Analysis
+
(** Transform the AST types to the more generic Oak format *)
module Oak = struct
type application = {name: string; argument: oak}
@@ -10,12 +12,39 @@ module Oak = struct
| Ident of string
| Tuple of namedField list
| List of oak list
+ | String of string
+ let mk_bool (b : bool) : oak = if b then Ident "true" else Ident "false"
+
+ let mk_string_option (o : string option) : oak =
+ match o with
+ | None -> Ident "None"
+ | Some s -> Application {name = "Some"; argument = String s}
+
+ let mk_string_list (items : string list) : oak =
+ List (items |> List.map (fun s -> String s))
+
+ let path_to_string path =
+ let buf = Buffer.create 64 in
+ let rec aux = function
+ | Path.Pident id -> Buffer.add_string buf (Ident.name id)
+ | Path.Pdot (p, s, _) ->
+ aux p;
+ Buffer.add_char buf '.';
+ Buffer.add_string buf s
+ | Path.Papply (p1, p2) ->
+ aux p1;
+ Buffer.add_char buf '(';
+ aux p2;
+ Buffer.add_char buf ')'
+ in
+ aux path;
+ Buffer.contents buf
- let rec path_to_string = function
- | Path.Pident id -> Ident.name id
- | Path.Pdot (p, s, _) -> path_to_string p ^ "." ^ s
- | Path.Papply (p1, p2) -> path_to_string p1 ^ "(" ^ path_to_string p2 ^ ")"
-
+ let mk_row_field (row_field : Types.row_field) : oak =
+ match row_field with
+ | Rpresent _ -> Ident "row_field.Rpresent"
+ | Reither _ -> Ident "row_field.Reither"
+ | Rabsent -> Ident "row_field.Rabsent"
let rec mk_type_desc (desc : Types.type_desc) : oak =
match desc with
| Tvar var -> (
@@ -103,13 +132,57 @@ module Oak = struct
}
:: fields)
- and mk_row_field (row_field : Types.row_field) : oak =
- match row_field with
- | Rpresent _ -> Ident "row_field.Rpresent"
- | Reither _ -> Ident "row_field.Reither"
- | Rabsent -> Ident "row_field.Rabsent"
+ let mk_package (package : SharedTypes.package) : oak =
+ Record
+ [
+ {
+ name = "genericJsxModule";
+ value = mk_string_option package.genericJsxModule;
+ };
+ ]
- and mk_bool (b : bool) : oak = if b then Ident "true" else Ident "false"
+ let mk_Uri (uri : Uri.t) : oak = String (Uri.toString uri)
+
+ let mk_item (item : SharedTypes.Module.item) : oak =
+ let kind =
+ match item.kind with
+ | SharedTypes.Module.Value v ->
+ Application
+ {name = "SharedTypes.Module.Value"; argument = mk_type_desc v.desc}
+ | SharedTypes.Module.Type _ -> Ident "Type"
+ | SharedTypes.Module.Module _ -> Ident "Module"
+ in
+ Record
+ [
+ {name = "kind"; value = kind};
+ {name = "name"; value = String item.name};
+ {name = "docstring"; value = mk_string_list item.docstring};
+ {name = "deprecated"; value = mk_string_option item.deprecated};
+ ]
+
+ let mk_structure (structure : SharedTypes.Module.structure) : oak =
+ Record
+ [
+ {name = "name"; value = String structure.name};
+ {name = "docstring"; value = mk_string_list structure.docstring};
+ {name = "items"; value = List (List.map mk_item structure.items)};
+ {name = "deprecated"; value = mk_string_option structure.deprecated};
+ ]
+
+ let mk_file (file : SharedTypes.File.t) : oak =
+ Record
+ [
+ {name = "uri"; value = mk_Uri file.uri};
+ {name = "moduleName"; value = String file.moduleName};
+ {name = "structure"; value = mk_structure file.structure};
+ ]
+
+ let mk_full (full : SharedTypes.full) : oak =
+ Record
+ [
+ {name = "package"; value = mk_package full.package};
+ {name = "file"; value = mk_file full.file};
+ ]
end
(** Transform the Oak types to string *)
@@ -231,23 +304,31 @@ module CodePrinter = struct
(** Fold all the events in context into text *)
let dump (ctx : context) =
- let addSpaces n = String.make n ' ' in
+ let buf = Buffer.create 1024 in
+ let addSpaces n = Buffer.add_string buf (String.make n ' ') in
List.fold_right
- (fun event (acc, current_indent) ->
+ (fun event current_indent ->
match event with
- | Write str -> (acc ^ str, current_indent)
- | WriteLine -> (acc ^ "\n" ^ addSpaces current_indent, current_indent)
- | IndentBy n -> (acc, current_indent + n)
- | UnindentBy n -> (acc, current_indent - n))
- ctx.events ("", 0)
- |> fst
+ | Write str ->
+ Buffer.add_string buf str;
+ current_indent
+ | WriteLine ->
+ Buffer.add_char buf '\n';
+ addSpaces current_indent;
+ current_indent
+ | IndentBy n -> current_indent + n
+ | UnindentBy n -> current_indent - n)
+ ctx.events ctx.current_indent
+ |> ignore;
+ Buffer.contents buf
let rec genOak (oak : Oak.oak) : appendEvents =
match oak with
| Oak.Application application -> genApplication application
| Oak.Record record -> genRecord record
| Oak.Ident ident -> genIdent ident
+ | Oak.String str -> !-(Format.sprintf "\"%s\"" str)
| Oak.Tuple ts -> genTuple ts
| Oak.List xs -> genList xs
@@ -268,9 +349,12 @@ module CodePrinter = struct
and genRecord (recordFields : Oak.namedField list) : appendEvents =
let short =
- sepOpenR +> sepSpace
- +> col genNamedField sepSemi recordFields
- +> sepSpace +> sepCloseR
+ match recordFields with
+ | [] -> sepOpenR +> sepCloseR
+ | fields ->
+ sepOpenR +> sepSpace
+ +> col genNamedField sepSemi fields
+ +> sepSpace +> sepCloseR
in
let long =
sepOpenR
@@ -292,7 +376,7 @@ module CodePrinter = struct
!-(field.name) +> sepEq
+>
match field.value with
- | Oak.List _ -> genOak field.value
+ | Oak.List _ | Oak.Record _ -> genOak field.value
| _ -> indentAndNln (genOak field.value)
in
expressionFitsOnRestOfLine short long
@@ -318,3 +402,7 @@ end
let print_type_expr (typ : Types.type_expr) : string =
CodePrinter.genOak (Oak.mk_type_desc typ.desc) CodePrinter.emptyContext
|> CodePrinter.dump
+
+let print_full (full : SharedTypes.full) : string =
+ CodePrinter.genOak (Oak.mk_full full) CodePrinter.emptyContext
+ |> CodePrinter.dump
diff --git a/tools/src/tools.ml b/tools/src/tools.ml
index 2b7258f57..3d8335c9f 100644
--- a/tools/src/tools.ml
+++ b/tools/src/tools.ml
@@ -640,3 +640,43 @@ let extractEmbedded ~extensionPoints ~filename =
("loc", Some (Analysis.Utils.cmtLocToRange loc |> stringifyRange));
])
|> List.rev |> array
+
+let dump entryPointFile =
+ let path =
+ match Filename.is_relative entryPointFile with
+ | true -> Unix.realpath entryPointFile
+ | false -> entryPointFile
+ in
+ let result =
+ match
+ FindFiles.isImplementation path = false
+ && FindFiles.isInterface path = false
+ with
+ | false -> (
+ let path =
+ if FindFiles.isImplementation path then
+ let pathAsResi =
+ (path |> Filename.dirname) ^ "/"
+ ^ (path |> Filename.basename |> Filename.chop_extension)
+ ^ ".resi"
+ in
+ if Sys.file_exists pathAsResi then (
+ Printf.printf "preferring found resi file for impl: %s\n" pathAsResi;
+ pathAsResi)
+ else path
+ else path
+ in
+ match Cmt.loadFullCmtFromPath ~path with
+ | None ->
+ Error
+ (Printf.sprintf
+ "error: failed to generate doc for %s, try to build the project"
+ path)
+ | Some full -> Ok (Print_tast.print_full full))
+ | true ->
+ Error
+ (Printf.sprintf
+ "error: failed to read %s, expected an .res or .resi file" path)
+ in
+
+ result
From 6f3e7fd5e4e562f03e322a4c88b1b8abb909c1b0 Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Wed, 9 Oct 2024 11:16:49 +0200
Subject: [PATCH 05/24] Try CPS
---
tools/src/print_tast.ml | 168 +++++++++++++++++++++-------------------
1 file changed, 90 insertions(+), 78 deletions(-)
diff --git a/tools/src/print_tast.ml b/tools/src/print_tast.ml
index e6c4ade87..3e6be3392 100644
--- a/tools/src/print_tast.ml
+++ b/tools/src/print_tast.ml
@@ -45,92 +45,104 @@ module Oak = struct
| Rpresent _ -> Ident "row_field.Rpresent"
| Reither _ -> Ident "row_field.Reither"
| Rabsent -> Ident "row_field.Rabsent"
- let rec mk_type_desc (desc : Types.type_desc) : oak =
+
+ let rec mk_type_desc_cps (desc : Types.type_desc) (continuation : oak -> oak)
+ : oak =
match desc with
- | Tvar var -> (
- match var with
- | None -> Application {name = "type_desc.Tvar"; argument = Ident "None"}
- | Some s -> Application {name = "type_desc.Tvar"; argument = Ident s})
+ | Tvar var ->
+ continuation
+ (Application {name = "type_desc.Tvar"; argument = mk_string_option var})
| Tarrow (_, t1, t2, _) ->
- Application
- {
- name = "type_desc.Tarrow";
- argument =
- Tuple
- [
- {name = "t1"; value = mk_type_desc t1.desc};
- {name = "t2"; value = mk_type_desc t2.desc};
- ];
- }
- | Ttuple _ -> Ident "type_desc.Ttuple"
+ mk_type_desc_cps t1.desc (fun t1_result ->
+ mk_type_desc_cps t2.desc (fun t2_result ->
+ continuation
+ (Application
+ {
+ name = "type_desc.Tarrow";
+ argument =
+ Tuple
+ [
+ {name = "t1"; value = t1_result};
+ {name = "t2"; value = t2_result};
+ ];
+ })))
+ | Ttuple _ -> continuation (Ident "type_desc.Ttuple")
| Tconstr (path, ts, _) ->
let ts =
- ts |> List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc)
+ List.map
+ (fun (t : Types.type_expr) -> mk_type_desc_cps t.desc (fun t -> t))
+ ts
in
- Application
- {
- name = "type_desc.Tconstr";
- argument =
- Tuple
- [
- {name = "path"; value = Ident (path_to_string path)};
- {name = "ts"; value = List ts};
- ];
- }
- | Tobject _ -> Ident "type_desc.Tobject"
- | Tfield _ -> Ident "type_desc.Tfield"
- | Tnil -> Ident "type_desc.Tnil"
+ continuation
+ (Application
+ {
+ name = "type_desc.Tconstr";
+ argument =
+ Tuple
+ [
+ {name = "path"; value = Ident (path_to_string path)};
+ {name = "ts"; value = List ts};
+ ];
+ })
+ | Tobject _ -> continuation (Ident "type_desc.Tobject")
+ | Tfield _ -> continuation (Ident "type_desc.Tfield")
+ | Tnil -> continuation (Ident "type_desc.Tnil")
| Tlink {desc} ->
- Application {name = "type_desc.Tlink"; argument = mk_type_desc desc}
- | Tsubst _ -> Ident "type_desc.Tsubst"
+ mk_type_desc_cps desc (fun result ->
+ continuation
+ (Application {name = "type_desc.Tlink"; argument = result}))
+ | Tsubst _ -> continuation (Ident "type_desc.Tsubst")
| Tvariant row_descr ->
- Application
- {name = "type_desc.Tvariant"; argument = mk_row_desc row_descr}
- | Tunivar _ -> Ident "type_desc.Tunivar"
- | Tpoly _ -> Ident "type_desc.Tpoly"
- | Tpackage _ -> Ident "type_desc.Tpackage"
-
- and mk_row_desc (row_desc : Types.row_desc) : oak =
- let fields =
- [
- {
- name = "row_fields";
- value =
- ( row_desc.row_fields
- |> List.map (fun (label, row_field) ->
- Tuple
- [
- {name = "label"; value = Ident label};
- {name = "row_field"; value = mk_row_field row_field};
- ])
- |> fun ts -> List ts );
- };
- {name = "row_more"; value = mk_type_desc row_desc.row_more.desc};
- {name = "row_closed"; value = mk_bool row_desc.row_closed};
- {name = "row_fixed"; value = mk_bool row_desc.row_fixed};
- ]
- in
- match row_desc.row_name with
- | None -> Record fields
- | Some (path, ts) ->
- Record
- ({
- name = "row_name";
+ continuation
+ (Application {name = "type_desc.Tvariant"; argument = Ident "row_descr"})
+ | Tunivar _ -> continuation (Ident "type_desc.Tunivar")
+ | Tpoly _ -> continuation (Ident "type_desc.Tpoly")
+ | Tpackage _ -> continuation (Ident "type_desc.Tpackage")
+
+ let mk_type_desc (desc : Types.type_desc) : oak =
+ mk_type_desc_cps desc (fun result -> result)
+
+ (* and mk_row_desc (row_desc : Types.row_desc) : oak =
+ let fields =
+ [
+ {
+ name = "row_fields";
value =
- Tuple
- [
- {name = "Path.t"; value = Ident (path_to_string path)};
- {
- name = "fields";
- value =
- List
- (ts
- |> List.map (fun (t : Types.type_expr) ->
- mk_type_desc t.desc));
- };
- ];
- }
- :: fields)
+ ( row_desc.row_fields
+ |> List.map (fun (label, row_field) ->
+ Tuple
+ [
+ {name = "label"; value = Ident label};
+ {name = "row_field"; value = mk_row_field row_field};
+ ])
+ |> fun ts -> List ts );
+ };
+ {name = "row_more"; value = mk_type_desc row_desc.row_more.desc};
+ {name = "row_closed"; value = mk_bool row_desc.row_closed};
+ {name = "row_fixed"; value = mk_bool row_desc.row_fixed};
+ ]
+ in
+ match row_desc.row_name with
+ | None -> Record fields
+ | Some (path, ts) ->
+ Record
+ ({
+ name = "row_name";
+ value =
+ Tuple
+ [
+ {name = "Path.t"; value = Ident (path_to_string path)};
+ {
+ name = "fields";
+ value =
+ List
+ (ts
+ |> List.map (fun (t : Types.type_expr) ->
+ mk_type_desc t.desc));
+ };
+ ];
+ }
+ :: fields) *)
let mk_package (package : SharedTypes.package) : oak =
Record
From 765a49f8ab0a30e30226b4f66e81e9f12de6d2cd Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Wed, 9 Oct 2024 13:00:00 +0200
Subject: [PATCH 06/24] Revert "Try CPS"
This reverts commit 6f3e7fd5e4e562f03e322a4c88b1b8abb909c1b0.
---
tools/src/print_tast.ml | 168 +++++++++++++++++++---------------------
1 file changed, 78 insertions(+), 90 deletions(-)
diff --git a/tools/src/print_tast.ml b/tools/src/print_tast.ml
index 3e6be3392..e6c4ade87 100644
--- a/tools/src/print_tast.ml
+++ b/tools/src/print_tast.ml
@@ -45,104 +45,92 @@ module Oak = struct
| Rpresent _ -> Ident "row_field.Rpresent"
| Reither _ -> Ident "row_field.Reither"
| Rabsent -> Ident "row_field.Rabsent"
-
- let rec mk_type_desc_cps (desc : Types.type_desc) (continuation : oak -> oak)
- : oak =
+ let rec mk_type_desc (desc : Types.type_desc) : oak =
match desc with
- | Tvar var ->
- continuation
- (Application {name = "type_desc.Tvar"; argument = mk_string_option var})
+ | Tvar var -> (
+ match var with
+ | None -> Application {name = "type_desc.Tvar"; argument = Ident "None"}
+ | Some s -> Application {name = "type_desc.Tvar"; argument = Ident s})
| Tarrow (_, t1, t2, _) ->
- mk_type_desc_cps t1.desc (fun t1_result ->
- mk_type_desc_cps t2.desc (fun t2_result ->
- continuation
- (Application
- {
- name = "type_desc.Tarrow";
- argument =
- Tuple
- [
- {name = "t1"; value = t1_result};
- {name = "t2"; value = t2_result};
- ];
- })))
- | Ttuple _ -> continuation (Ident "type_desc.Ttuple")
+ Application
+ {
+ name = "type_desc.Tarrow";
+ argument =
+ Tuple
+ [
+ {name = "t1"; value = mk_type_desc t1.desc};
+ {name = "t2"; value = mk_type_desc t2.desc};
+ ];
+ }
+ | Ttuple _ -> Ident "type_desc.Ttuple"
| Tconstr (path, ts, _) ->
let ts =
- List.map
- (fun (t : Types.type_expr) -> mk_type_desc_cps t.desc (fun t -> t))
- ts
+ ts |> List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc)
in
- continuation
- (Application
- {
- name = "type_desc.Tconstr";
- argument =
- Tuple
- [
- {name = "path"; value = Ident (path_to_string path)};
- {name = "ts"; value = List ts};
- ];
- })
- | Tobject _ -> continuation (Ident "type_desc.Tobject")
- | Tfield _ -> continuation (Ident "type_desc.Tfield")
- | Tnil -> continuation (Ident "type_desc.Tnil")
+ Application
+ {
+ name = "type_desc.Tconstr";
+ argument =
+ Tuple
+ [
+ {name = "path"; value = Ident (path_to_string path)};
+ {name = "ts"; value = List ts};
+ ];
+ }
+ | Tobject _ -> Ident "type_desc.Tobject"
+ | Tfield _ -> Ident "type_desc.Tfield"
+ | Tnil -> Ident "type_desc.Tnil"
| Tlink {desc} ->
- mk_type_desc_cps desc (fun result ->
- continuation
- (Application {name = "type_desc.Tlink"; argument = result}))
- | Tsubst _ -> continuation (Ident "type_desc.Tsubst")
+ Application {name = "type_desc.Tlink"; argument = mk_type_desc desc}
+ | Tsubst _ -> Ident "type_desc.Tsubst"
| Tvariant row_descr ->
- continuation
- (Application {name = "type_desc.Tvariant"; argument = Ident "row_descr"})
- | Tunivar _ -> continuation (Ident "type_desc.Tunivar")
- | Tpoly _ -> continuation (Ident "type_desc.Tpoly")
- | Tpackage _ -> continuation (Ident "type_desc.Tpackage")
-
- let mk_type_desc (desc : Types.type_desc) : oak =
- mk_type_desc_cps desc (fun result -> result)
-
- (* and mk_row_desc (row_desc : Types.row_desc) : oak =
- let fields =
- [
- {
- name = "row_fields";
+ Application
+ {name = "type_desc.Tvariant"; argument = mk_row_desc row_descr}
+ | Tunivar _ -> Ident "type_desc.Tunivar"
+ | Tpoly _ -> Ident "type_desc.Tpoly"
+ | Tpackage _ -> Ident "type_desc.Tpackage"
+
+ and mk_row_desc (row_desc : Types.row_desc) : oak =
+ let fields =
+ [
+ {
+ name = "row_fields";
+ value =
+ ( row_desc.row_fields
+ |> List.map (fun (label, row_field) ->
+ Tuple
+ [
+ {name = "label"; value = Ident label};
+ {name = "row_field"; value = mk_row_field row_field};
+ ])
+ |> fun ts -> List ts );
+ };
+ {name = "row_more"; value = mk_type_desc row_desc.row_more.desc};
+ {name = "row_closed"; value = mk_bool row_desc.row_closed};
+ {name = "row_fixed"; value = mk_bool row_desc.row_fixed};
+ ]
+ in
+ match row_desc.row_name with
+ | None -> Record fields
+ | Some (path, ts) ->
+ Record
+ ({
+ name = "row_name";
value =
- ( row_desc.row_fields
- |> List.map (fun (label, row_field) ->
- Tuple
- [
- {name = "label"; value = Ident label};
- {name = "row_field"; value = mk_row_field row_field};
- ])
- |> fun ts -> List ts );
- };
- {name = "row_more"; value = mk_type_desc row_desc.row_more.desc};
- {name = "row_closed"; value = mk_bool row_desc.row_closed};
- {name = "row_fixed"; value = mk_bool row_desc.row_fixed};
- ]
- in
- match row_desc.row_name with
- | None -> Record fields
- | Some (path, ts) ->
- Record
- ({
- name = "row_name";
- value =
- Tuple
- [
- {name = "Path.t"; value = Ident (path_to_string path)};
- {
- name = "fields";
- value =
- List
- (ts
- |> List.map (fun (t : Types.type_expr) ->
- mk_type_desc t.desc));
- };
- ];
- }
- :: fields) *)
+ Tuple
+ [
+ {name = "Path.t"; value = Ident (path_to_string path)};
+ {
+ name = "fields";
+ value =
+ List
+ (ts
+ |> List.map (fun (t : Types.type_expr) ->
+ mk_type_desc t.desc));
+ };
+ ];
+ }
+ :: fields)
let mk_package (package : SharedTypes.package) : oak =
Record
From 46ab52f61de3587825e48781d57a02e7a5b94e1a Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Wed, 9 Oct 2024 13:21:07 +0200
Subject: [PATCH 07/24] Print name_of_type_desc
---
tools/src/print_tast.ml | 46 ++++++++++++++++++++++++++++-------------
1 file changed, 32 insertions(+), 14 deletions(-)
diff --git a/tools/src/print_tast.ml b/tools/src/print_tast.ml
index e6c4ade87..db826d06a 100644
--- a/tools/src/print_tast.ml
+++ b/tools/src/print_tast.ml
@@ -45,24 +45,32 @@ module Oak = struct
| Rpresent _ -> Ident "row_field.Rpresent"
| Reither _ -> Ident "row_field.Reither"
| Rabsent -> Ident "row_field.Rabsent"
+
+ let name_of_type_desc (desc : Types.type_desc) =
+ match desc with
+ | Tvar _ -> "Tvar"
+ | Tarrow _ -> "Tarrow"
+ | Ttuple _ -> "Ttuple"
+ | Tconstr _ -> "Tconstr"
+ | Tobject _ -> "Tobject"
+ | Tfield _ -> "Tfield"
+ | Tnil -> "Tnil"
+ | Tlink _ -> "Tlink"
+ | Tsubst _ -> "Tsubst"
+ | Tvariant _ -> "Tvariant"
+ | Tunivar _ -> "Tunivar"
+ | Tpoly _ -> "Tpoly"
+ | Tpackage _ -> "Tpackage"
+
let rec mk_type_desc (desc : Types.type_desc) : oak =
+ Printf.printf "entering mk_type_desc for %s\n" (name_of_type_desc desc);
match desc with
+ | Tlink {desc} ->
+ Application {name = "type_desc.Tlink"; argument = mk_type_desc desc}
| Tvar var -> (
match var with
| None -> Application {name = "type_desc.Tvar"; argument = Ident "None"}
| Some s -> Application {name = "type_desc.Tvar"; argument = Ident s})
- | Tarrow (_, t1, t2, _) ->
- Application
- {
- name = "type_desc.Tarrow";
- argument =
- Tuple
- [
- {name = "t1"; value = mk_type_desc t1.desc};
- {name = "t2"; value = mk_type_desc t2.desc};
- ];
- }
- | Ttuple _ -> Ident "type_desc.Ttuple"
| Tconstr (path, ts, _) ->
let ts =
ts |> List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc)
@@ -77,11 +85,21 @@ module Oak = struct
{name = "ts"; value = List ts};
];
}
+ | Tarrow (_, t1, t2, _) ->
+ Application
+ {
+ name = "type_desc.Tarrow";
+ argument =
+ Tuple
+ [
+ {name = "t1"; value = mk_type_desc t1.desc};
+ {name = "t2"; value = mk_type_desc t2.desc};
+ ];
+ }
+ | Ttuple _ -> Ident "type_desc.Ttuple"
| Tobject _ -> Ident "type_desc.Tobject"
| Tfield _ -> Ident "type_desc.Tfield"
| Tnil -> Ident "type_desc.Tnil"
- | Tlink {desc} ->
- Application {name = "type_desc.Tlink"; argument = mk_type_desc desc}
| Tsubst _ -> Ident "type_desc.Tsubst"
| Tvariant row_descr ->
Application
From b6ae20c846ac61701195406c29e6481e7fafcada Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Thu, 10 Oct 2024 10:31:09 +0200
Subject: [PATCH 08/24] Extract printer from tast transformer
---
tools/src/prettier_printer.ml | 280 ++++++++++++++++++++++++++++++++++
tools/src/print_tast.ml | 254 +-----------------------------
tools/src/tools.ml | 2 +-
3 files changed, 288 insertions(+), 248 deletions(-)
create mode 100644 tools/src/prettier_printer.ml
diff --git a/tools/src/prettier_printer.ml b/tools/src/prettier_printer.ml
new file mode 100644
index 000000000..3b57c0fd5
--- /dev/null
+++ b/tools/src/prettier_printer.ml
@@ -0,0 +1,280 @@
+(* open Analysis *)
+
+module DSL = struct
+ type application = {name: string; argument: oak}
+
+ and namedField = {name: string; value: oak}
+
+ and oak =
+ | Application of application
+ | Record of namedField list
+ | Ident of string
+ | Tuple of namedField list
+ | List of oak list
+ | String of string
+end
+
+(** Transform the Oak types to string *)
+module CodePrinter = struct
+ open DSL
+
+ (**
+ The idea is that we capture events in a context type.
+ Doing this allows us to reason about the current state of the writer
+ and whether the next expression fits on the current line or not.
+
+ *)
+
+ type writerEvents =
+ | Write of string
+ | WriteLine
+ | IndentBy of int
+ | UnindentBy of int
+
+ type context = {
+ indent_size: int;
+ max_line_length: int;
+ current_indent: int;
+ current_line_column: int;
+ events: writerEvents list;
+ line_count: int;
+ nesting_level: int;
+ }
+
+ type appendEvents = context -> context
+
+ let emptyContext =
+ {
+ indent_size = 2;
+ max_line_length = 80;
+ current_indent = 0;
+ current_line_column = 0;
+ events = [];
+ line_count = 0;
+ nesting_level = 0;
+ }
+
+ (** Fold all the events in context into text *)
+ let dump (ctx : context) =
+ let buf = Buffer.create 1024 in
+ let addSpaces n = Buffer.add_string buf (String.make n ' ') in
+
+ List.fold_right
+ (fun event current_indent ->
+ match event with
+ | Write str ->
+ Buffer.add_string buf str;
+ current_indent
+ | WriteLine ->
+ Buffer.add_char buf '\n';
+ addSpaces current_indent;
+ current_indent
+ | IndentBy n -> current_indent + n
+ | UnindentBy n -> current_indent - n)
+ ctx.events ctx.current_indent
+ |> ignore;
+ Buffer.contents buf
+
+ let debug_context (ctx : context) =
+ Format.printf "Current indent: %d, Current line: %d, Events: %d\n"
+ ctx.current_indent ctx.line_count (List.length ctx.events);
+ ctx
+
+ let increase_nesting ctx = {ctx with nesting_level = ctx.nesting_level + 1}
+
+ let decrease_nesting ctx =
+ {ctx with nesting_level = max 0 (ctx.nesting_level - 1)}
+
+ (* Type representing the writer context during code printing
+
+ - [indent_size] is the configured indentation size, typically 2
+ - [current_indent] is the current indentation size
+ - [current_line_column] is the characters written on the current line
+ - [events] is the write events in reverse order, head event is last written
+ *)
+
+ let id x = x
+
+ (** add a write event to the context *)
+ let ( !- ) str ctx =
+ {
+ ctx with
+ events = Write str :: ctx.events;
+ current_line_column = ctx.current_line_column + String.length str;
+ }
+
+ (** compose two context transforming functions *)
+ let ( +> ) f g ctx = g (f ctx)
+
+ let sepNln ctx =
+ {
+ ctx with
+ events = WriteLine :: ctx.events;
+ current_line_column = ctx.current_indent;
+ line_count = ctx.line_count + 1;
+ }
+ let sepSpace ctx = !-" " ctx
+ let sepComma ctx = !-", " ctx
+ let sepSemi ctx = !-"; " ctx
+ let sepOpenT ctx = !-"(" ctx
+ let sepCloseT ctx = !-")" ctx
+ let sepOpenR ctx = !-"{" ctx
+ let sepCloseR ctx = !-"}" ctx
+ let sepOpenL ctx = !-"[" ctx
+ let sepCloseL ctx = !-"]" ctx
+ let sepEq ctx = !-" = " ctx
+ let wrapInParentheses f = sepOpenT +> f +> sepCloseT
+ let indent ctx =
+ let nextIdent = ctx.current_indent + ctx.indent_size in
+ {
+ ctx with
+ current_indent = nextIdent;
+ current_line_column = nextIdent;
+ events = IndentBy ctx.indent_size :: ctx.events;
+ }
+ let unindent ctx =
+ let nextIdent = ctx.current_indent - ctx.indent_size in
+ {
+ ctx with
+ current_indent = nextIdent;
+ current_line_column = nextIdent;
+ events = UnindentBy ctx.indent_size :: ctx.events;
+ }
+
+ let indentAndNln f = indent +> sepNln +> f +> unindent
+
+ let col (f : 't -> appendEvents) (intertwine : appendEvents) items ctx =
+ let rec visit items ctx =
+ match items with
+ | [] -> ctx
+ | [item] -> f item ctx
+ | item :: rest ->
+ let ctx' = (f item +> intertwine) ctx in
+ visit rest ctx'
+ in
+ visit items ctx
+
+ let expressionFitsOnRestOfLine (f : appendEvents) (fallback : appendEvents)
+ (ctx : context) =
+ (* create a short context and check if the expression fits on the current line *)
+ let shortCtx = f ctx in
+ if
+ ctx.line_count == shortCtx.line_count
+ && shortCtx.current_line_column <= ctx.max_line_length
+ then shortCtx
+ else fallback ctx
+
+ let rec genOak (oak : oak) : appendEvents =
+ match oak with
+ | Application application -> genApplication application
+ | Record record -> genRecord record
+ | Ident ident -> genIdent ident
+ | String str -> !-(Format.sprintf "\"%s\"" str)
+ | Tuple ts -> genTuple ts
+ | List xs -> genList xs
+
+ and genApplication (application : application) : appendEvents =
+ let short =
+ !-(application.name) +> sepOpenT
+ +> genOak application.argument
+ +> sepCloseT
+ in
+ let long =
+ !-(application.name) +> sepOpenT
+ +> (match application.argument with
+ | List _ | Record _ -> genOak application.argument
+ | _ -> indentAndNln (genOak application.argument) +> sepNln)
+ +> sepCloseT
+ in
+ expressionFitsOnRestOfLine short long
+
+ and genRecord (recordFields : namedField list) : appendEvents =
+ let short =
+ match recordFields with
+ | [] -> sepOpenR +> sepCloseR
+ | fields ->
+ sepOpenR +> sepSpace
+ +> col genNamedField sepSemi fields
+ +> sepSpace +> sepCloseR
+ in
+ let long =
+ sepOpenR
+ +> indentAndNln (col genNamedField sepNln recordFields)
+ +> sepNln +> sepCloseR
+ in
+ expressionFitsOnRestOfLine short long
+
+ and genTuple (oaks : namedField list) : appendEvents =
+ let short = col genNamedField sepComma oaks in
+ let long = col genNamedField sepNln oaks in
+ expressionFitsOnRestOfLine short long
+
+ and genIdent (ident : string) : appendEvents = !-ident
+
+ and genNamedField (field : namedField) : appendEvents =
+ let short = !-(field.name) +> sepEq +> genOak field.value in
+ let long =
+ !-(field.name) +> sepEq
+ +>
+ match field.value with
+ | List _ | Record _ -> genOak field.value
+ | _ -> indentAndNln (genOak field.value)
+ in
+ expressionFitsOnRestOfLine short long
+
+ and genList (items : oak list) : appendEvents =
+ let genItem = function
+ | Tuple _ as item -> wrapInParentheses (genOak item)
+ | item -> genOak item
+ in
+ let short =
+ match items with
+ | [] -> sepOpenL +> sepCloseL
+ | _ ->
+ sepOpenL +> sepSpace +> col genItem sepSemi items +> sepSpace
+ +> sepCloseL
+ in
+ let long =
+ sepOpenL +> indentAndNln (col genItem sepNln items) +> sepNln +> sepCloseL
+ in
+ expressionFitsOnRestOfLine short long
+end
+
+open DSL
+
+let oak =
+ DSL.Record
+ [
+ {
+ name = "zig";
+ value =
+ DSL.Record
+ [
+ {name = "foo"; value = Ident "baaaaaaaaaaaaaaaaar"};
+ {name = "member"; value = Ident "Zigbaaaaaaaaar"};
+ ];
+ };
+ {
+ name = "roxas";
+ value =
+ List
+ [
+ Ident "jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjj";
+ Ident "meeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee";
+ DSL.Record
+ [
+ {name = "foo"; value = Ident "baaaaaaaaaaaaaaaaar"};
+ {name = "member"; value = Ident "Zigbaaaaaaaaar"};
+ ];
+ ];
+ };
+ {name = "foo"; value = Ident "baaaaaaaaaaaaaaaaar"};
+ ]
+
+(* let _ =
+ CodePrinter.genOak oak {CodePrinter.emptyContext with max_line_length = 20}
+ |> CodePrinter.dump |> Format.printf "%s\n" *)
+
+(*
+ Interpret using ocaml /home/nojaf/projects/rescript-vscode/tools/src/prettier_printer.ml
+*)
diff --git a/tools/src/print_tast.ml b/tools/src/print_tast.ml
index db826d06a..2f4955ef8 100644
--- a/tools/src/print_tast.ml
+++ b/tools/src/print_tast.ml
@@ -1,18 +1,8 @@
+open Prettier_printer
+open DSL
open Analysis
-(** Transform the AST types to the more generic Oak format *)
-module Oak = struct
- type application = {name: string; argument: oak}
-
- and namedField = {name: string; value: oak}
-
- and oak =
- | Application of application
- | Record of namedField list
- | Ident of string
- | Tuple of namedField list
- | List of oak list
- | String of string
+module Transform = struct
let mk_bool (b : bool) : oak = if b then Ident "true" else Ident "false"
let mk_string_option (o : string option) : oak =
@@ -46,24 +36,7 @@ module Oak = struct
| Reither _ -> Ident "row_field.Reither"
| Rabsent -> Ident "row_field.Rabsent"
- let name_of_type_desc (desc : Types.type_desc) =
- match desc with
- | Tvar _ -> "Tvar"
- | Tarrow _ -> "Tarrow"
- | Ttuple _ -> "Ttuple"
- | Tconstr _ -> "Tconstr"
- | Tobject _ -> "Tobject"
- | Tfield _ -> "Tfield"
- | Tnil -> "Tnil"
- | Tlink _ -> "Tlink"
- | Tsubst _ -> "Tsubst"
- | Tvariant _ -> "Tvariant"
- | Tunivar _ -> "Tunivar"
- | Tpoly _ -> "Tpoly"
- | Tpackage _ -> "Tpackage"
-
let rec mk_type_desc (desc : Types.type_desc) : oak =
- Printf.printf "entering mk_type_desc for %s\n" (name_of_type_desc desc);
match desc with
| Tlink {desc} ->
Application {name = "type_desc.Tlink"; argument = mk_type_desc desc}
@@ -172,8 +145,8 @@ module Oak = struct
in
Record
[
- {name = "kind"; value = kind};
{name = "name"; value = String item.name};
+ {name = "kind"; value = kind};
{name = "docstring"; value = mk_string_list item.docstring};
{name = "deprecated"; value = mk_string_option item.deprecated};
]
@@ -203,224 +176,11 @@ module Oak = struct
]
end
-(** Transform the Oak types to string *)
-module CodePrinter = struct
- (**
- The idea is that we capture events in a context type.
- Doing this allows us to reason about the current state of the writer
- and whether the next expression fits on the current line or not.
-
- *)
-
- type writerEvents =
- | Write of string
- | WriteLine
- | IndentBy of int
- | UnindentBy of int
-
- type context = {
- indent_size: int;
- max_line_length: int;
- current_indent: int;
- current_line_column: int;
- events: writerEvents list;
- }
-
- let countLines (ctx : context) =
- ctx.events
- |> List.filter (fun event ->
- match event with
- | WriteLine -> true
- | _ -> false)
- |> List.length
-
- type appendEvents = context -> context
-
- let emptyContext =
- {
- indent_size = 2;
- max_line_length = 80;
- current_indent = 0;
- current_line_column = 0;
- events = [];
- }
-
- (* Type representing the writer context during code printing
-
- - [indent_size] is the configured indentation size, typically 2
- - [current_indent] is the current indentation size
- - [current_line_column] is the characters written on the current line
- - [events] is the write events in reverse order, head event is last written
- *)
-
- let id x = x
-
- (** add a write event to the context *)
- let ( !- ) str ctx =
- {
- ctx with
- events = Write str :: ctx.events;
- current_line_column = ctx.current_line_column + String.length str;
- }
-
- (** compose two context transforming functions *)
- let ( +> ) f g ctx = g (f ctx)
-
- let sepNln ctx =
- {ctx with events = WriteLine :: ctx.events; current_line_column = 0}
- let sepSpace ctx = !-" " ctx
- let sepComma ctx = !-", " ctx
- let sepSemi ctx = !-"; " ctx
- let sepOpenT ctx = !-"(" ctx
- let sepCloseT ctx = !-")" ctx
- let sepOpenR ctx = !-"{" ctx
- let sepCloseR ctx = !-"}" ctx
- let sepOpenL ctx = !-"[" ctx
- let sepCloseL ctx = !-"]" ctx
- let sepEq ctx = !-" = " ctx
- let wrapInParentheses f = sepOpenT +> f +> sepCloseT
- let indent ctx =
- let nextIdent = ctx.current_indent + ctx.indent_size in
- {
- ctx with
- current_indent = nextIdent;
- current_line_column = nextIdent;
- events = IndentBy ctx.indent_size :: ctx.events;
- }
- let unindent ctx =
- let nextIdent = ctx.current_indent - ctx.indent_size in
- {
- ctx with
- current_indent = nextIdent;
- current_line_column = nextIdent;
- events = UnindentBy ctx.indent_size :: ctx.events;
- }
-
- let indentAndNln f = indent +> sepNln +> f +> unindent
-
- let col (f : 't -> appendEvents) (intertwine : appendEvents) items ctx =
- let rec visit items ctx =
- match items with
- | [] -> ctx
- | [item] -> f item ctx
- | item :: rest ->
- let ctx' = (f item +> intertwine) ctx in
- visit rest ctx'
- in
- visit items ctx
-
- let expressionFitsOnRestOfLine (f : appendEvents) (fallback : appendEvents)
- (ctx : context) =
- let current_line_count = countLines ctx in
- let shortCtx = f ctx in
- let nextLineCount = countLines shortCtx in
- if
- current_line_count == nextLineCount
- && shortCtx.current_line_column <= ctx.max_line_length
- then shortCtx
- else fallback ctx
-
- (** Fold all the events in context into text *)
- let dump (ctx : context) =
- let buf = Buffer.create 1024 in
- let addSpaces n = Buffer.add_string buf (String.make n ' ') in
-
- List.fold_right
- (fun event current_indent ->
- match event with
- | Write str ->
- Buffer.add_string buf str;
- current_indent
- | WriteLine ->
- Buffer.add_char buf '\n';
- addSpaces current_indent;
- current_indent
- | IndentBy n -> current_indent + n
- | UnindentBy n -> current_indent - n)
- ctx.events ctx.current_indent
- |> ignore;
- Buffer.contents buf
-
- let rec genOak (oak : Oak.oak) : appendEvents =
- match oak with
- | Oak.Application application -> genApplication application
- | Oak.Record record -> genRecord record
- | Oak.Ident ident -> genIdent ident
- | Oak.String str -> !-(Format.sprintf "\"%s\"" str)
- | Oak.Tuple ts -> genTuple ts
- | Oak.List xs -> genList xs
-
- and genApplication (application : Oak.application) : appendEvents =
- let short =
- !-(application.name) +> sepOpenT
- +> genOak application.argument
- +> sepCloseT
- in
- let long =
- !-(application.name) +> sepOpenT
- +> (match application.argument with
- | Oak.List _ | Oak.Record _ -> genOak application.argument
- | _ -> indentAndNln (genOak application.argument) +> sepNln)
- +> sepCloseT
- in
- expressionFitsOnRestOfLine short long
-
- and genRecord (recordFields : Oak.namedField list) : appendEvents =
- let short =
- match recordFields with
- | [] -> sepOpenR +> sepCloseR
- | fields ->
- sepOpenR +> sepSpace
- +> col genNamedField sepSemi fields
- +> sepSpace +> sepCloseR
- in
- let long =
- sepOpenR
- +> indentAndNln (col genNamedField sepNln recordFields)
- +> sepNln +> sepCloseR
- in
- expressionFitsOnRestOfLine short long
-
- and genTuple (oaks : Oak.namedField list) : appendEvents =
- let short = col genNamedField sepComma oaks in
- let long = col genNamedField sepNln oaks in
- expressionFitsOnRestOfLine short long
-
- and genIdent (ident : string) : appendEvents = !-ident
-
- and genNamedField (field : Oak.namedField) : appendEvents =
- let short = !-(field.name) +> sepEq +> genOak field.value in
- let long =
- !-(field.name) +> sepEq
- +>
- match field.value with
- | Oak.List _ | Oak.Record _ -> genOak field.value
- | _ -> indentAndNln (genOak field.value)
- in
- expressionFitsOnRestOfLine short long
-
- and genList (items : Oak.oak list) : appendEvents =
- let genItem = function
- | Oak.Tuple _ as item -> wrapInParentheses (genOak item)
- | item -> genOak item
- in
- let short =
- match items with
- | [] -> sepOpenL +> sepCloseL
- | _ ->
- sepOpenL +> sepSpace +> col genItem sepSemi items +> sepSpace
- +> sepCloseL
- in
- let long =
- sepOpenL +> indentAndNln (col genItem sepNln items) +> sepNln +> sepCloseL
- in
- expressionFitsOnRestOfLine short long
-end
-
let print_type_expr (typ : Types.type_expr) : string =
- CodePrinter.genOak (Oak.mk_type_desc typ.desc) CodePrinter.emptyContext
+ CodePrinter.genOak (Transform.mk_type_desc typ.desc) CodePrinter.emptyContext
|> CodePrinter.dump
let print_full (full : SharedTypes.full) : string =
- CodePrinter.genOak (Oak.mk_full full) CodePrinter.emptyContext
+ CodePrinter.genOak (Transform.mk_full full) CodePrinter.emptyContext
+ |> CodePrinter.debug_context
|> CodePrinter.dump
diff --git a/tools/src/tools.ml b/tools/src/tools.ml
index 3d8335c9f..a784a6863 100644
--- a/tools/src/tools.ml
+++ b/tools/src/tools.ml
@@ -367,7 +367,7 @@ let valueDetail (typ : Types.type_expr) =
| Tconstr (path, [t; _], _) when isFunction path ->
collectSignatureTypes t.desc
| Tconstr (path, ts, _) -> (
- let p = Print_tast.Oak.path_to_string path in
+ let p = Print_tast.Transform.path_to_string path in
match ts with
| [] -> [{path = p; genericParameters = []}]
| ts ->
From 30f74542cac27dc2e4f3330b189779879951ef7d Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Thu, 10 Oct 2024 13:59:57 +0200
Subject: [PATCH 09/24] Fix performance of expressionFitsOnRestOfLine
---
tools/src/prettier_printer.ml | 100 +++++++++++++++++++++++-----------
tools/src/print_tast.ml | 1 -
2 files changed, 67 insertions(+), 34 deletions(-)
diff --git a/tools/src/prettier_printer.ml b/tools/src/prettier_printer.ml
index 3b57c0fd5..c1a135b8a 100644
--- a/tools/src/prettier_printer.ml
+++ b/tools/src/prettier_printer.ml
@@ -22,7 +22,6 @@ module CodePrinter = struct
The idea is that we capture events in a context type.
Doing this allows us to reason about the current state of the writer
and whether the next expression fits on the current line or not.
-
*)
type writerEvents =
@@ -31,14 +30,26 @@ module CodePrinter = struct
| IndentBy of int
| UnindentBy of int
+ type writerMode = Standard | TrySingleLine | ConfirmedMultiline
+
+ (* Type representing the writer context during code printing
+
+ - [indent_size] is the configured indentation size, typically 2
+ - [max_line_length] is the maximum line length before we break the line
+ - [current_indent] is the current indentation size
+ - [current_line_column] is the characters written on the current line
+ - [line_count] is the number of lines written
+ - [events] is the write events in reverse order, head event is last written
+ - [mode] is the current writer mode (Standard or SingleLine)
+ *)
type context = {
indent_size: int;
max_line_length: int;
current_indent: int;
current_line_column: int;
- events: writerEvents list;
line_count: int;
- nesting_level: int;
+ events: writerEvents list;
+ mode: writerMode;
}
type appendEvents = context -> context
@@ -46,12 +57,12 @@ module CodePrinter = struct
let emptyContext =
{
indent_size = 2;
- max_line_length = 80;
+ max_line_length = 120;
current_indent = 0;
current_line_column = 0;
- events = [];
line_count = 0;
- nesting_level = 0;
+ events = [];
+ mode = Standard;
}
(** Fold all the events in context into text *)
@@ -76,22 +87,30 @@ module CodePrinter = struct
Buffer.contents buf
let debug_context (ctx : context) =
- Format.printf "Current indent: %d, Current line: %d, Events: %d\n"
- ctx.current_indent ctx.line_count (List.length ctx.events);
+ let mode =
+ match ctx.mode with
+ | Standard -> "Standard"
+ | TrySingleLine _ -> "TrySingleLine"
+ | ConfirmedMultiline -> "ConfirmedMultiline"
+ in
+ Format.printf
+ "Current indent: %d, Current column: %d, # Lines: %d Events: %d, Mode: %s\n"
+ ctx.current_indent ctx.current_line_column ctx.line_count
+ (List.length ctx.events) mode;
ctx
- let increase_nesting ctx = {ctx with nesting_level = ctx.nesting_level + 1}
-
- let decrease_nesting ctx =
- {ctx with nesting_level = max 0 (ctx.nesting_level - 1)}
-
- (* Type representing the writer context during code printing
-
- - [indent_size] is the configured indentation size, typically 2
- - [current_indent] is the current indentation size
- - [current_line_column] is the characters written on the current line
- - [events] is the write events in reverse order, head event is last written
- *)
+ let updateMode (newlineWasAdded : bool) (ctx : context) =
+ match ctx.mode with
+ | Standard -> ctx
+ | ConfirmedMultiline -> ctx
+ | TrySingleLine ->
+ {
+ ctx with
+ mode =
+ (if newlineWasAdded || ctx.current_line_column > ctx.max_line_length
+ then ConfirmedMultiline
+ else TrySingleLine);
+ }
let id x = x
@@ -102,9 +121,14 @@ module CodePrinter = struct
events = Write str :: ctx.events;
current_line_column = ctx.current_line_column + String.length str;
}
+ |> updateMode false
(** compose two context transforming functions *)
- let ( +> ) f g ctx = g (f ctx)
+ let ( +> ) f g ctx =
+ let fCtx = f ctx in
+ match fCtx.mode with
+ | ConfirmedMultiline -> fCtx
+ | _ -> g fCtx
let sepNln ctx =
{
@@ -113,6 +137,8 @@ module CodePrinter = struct
current_line_column = ctx.current_indent;
line_count = ctx.line_count + 1;
}
+ |> updateMode true
+
let sepSpace ctx = !-" " ctx
let sepComma ctx = !-", " ctx
let sepSemi ctx = !-"; " ctx
@@ -156,13 +182,20 @@ module CodePrinter = struct
let expressionFitsOnRestOfLine (f : appendEvents) (fallback : appendEvents)
(ctx : context) =
- (* create a short context and check if the expression fits on the current line *)
- let shortCtx = f ctx in
- if
- ctx.line_count == shortCtx.line_count
- && shortCtx.current_line_column <= ctx.max_line_length
- then shortCtx
- else fallback ctx
+ match ctx.mode with
+ | ConfirmedMultiline -> ctx
+ | _ -> (
+ let shortCtx =
+ match ctx.mode with
+ | Standard -> {ctx with mode = TrySingleLine}
+ | _ -> ctx
+ in
+ let resultCtx = f shortCtx in
+ match resultCtx.mode with
+ | ConfirmedMultiline -> fallback ctx
+ | TrySingleLine -> {resultCtx with mode = ctx.mode}
+ | Standard ->
+ failwith "Unexpected Standard mode after trying SingleLine mode")
let rec genOak (oak : oak) : appendEvents =
match oak with
@@ -240,6 +273,11 @@ module CodePrinter = struct
expressionFitsOnRestOfLine short long
end
+(*
+ Interpret using ocaml /home/nojaf/projects/rescript-vscode/tools/src/prettier_printer.ml
+*)
+
+(*
open DSL
let oak =
@@ -271,10 +309,6 @@ let oak =
{name = "foo"; value = Ident "baaaaaaaaaaaaaaaaar"};
]
-(* let _ =
+ let _ =
CodePrinter.genOak oak {CodePrinter.emptyContext with max_line_length = 20}
|> CodePrinter.dump |> Format.printf "%s\n" *)
-
-(*
- Interpret using ocaml /home/nojaf/projects/rescript-vscode/tools/src/prettier_printer.ml
-*)
diff --git a/tools/src/print_tast.ml b/tools/src/print_tast.ml
index 2f4955ef8..c97850c9d 100644
--- a/tools/src/print_tast.ml
+++ b/tools/src/print_tast.ml
@@ -182,5 +182,4 @@ let print_type_expr (typ : Types.type_expr) : string =
let print_full (full : SharedTypes.full) : string =
CodePrinter.genOak (Transform.mk_full full) CodePrinter.emptyContext
- |> CodePrinter.debug_context
|> CodePrinter.dump
From d7af0288501e34e4eb2e80700ddb79d62adfc765 Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Thu, 10 Oct 2024 16:42:57 +0200
Subject: [PATCH 10/24] Extend mk_package
---
tools/src/print_tast.ml | 73 +++++++++++++++++++++++++++++++++++++++++
1 file changed, 73 insertions(+)
diff --git a/tools/src/print_tast.ml b/tools/src/print_tast.ml
index c97850c9d..49b306168 100644
--- a/tools/src/print_tast.ml
+++ b/tools/src/print_tast.ml
@@ -123,6 +123,55 @@ module Transform = struct
}
:: fields)
+ let mk_FileSet (fileSet : SharedTypes.FileSet.t) : oak =
+ List (fileSet |> SharedTypes.FileSet.to_list |> List.map (fun s -> String s))
+
+ let mk_builtInCompletionModules
+ (builtInCompletionModules : SharedTypes.builtInCompletionModules) : oak =
+ Record
+ [
+ {
+ name = "arrayModulePath";
+ value = mk_string_list builtInCompletionModules.arrayModulePath;
+ };
+ {
+ name = "optionModulePath";
+ value = mk_string_list builtInCompletionModules.optionModulePath;
+ };
+ {
+ name = "stringModulePath";
+ value = mk_string_list builtInCompletionModules.stringModulePath;
+ };
+ {
+ name = "intModulePath";
+ value = mk_string_list builtInCompletionModules.intModulePath;
+ };
+ {
+ name = "floatModulePath";
+ value = mk_string_list builtInCompletionModules.floatModulePath;
+ };
+ {
+ name = "promiseModulePath";
+ value = mk_string_list builtInCompletionModules.promiseModulePath;
+ };
+ {
+ name = "listModulePath";
+ value = mk_string_list builtInCompletionModules.listModulePath;
+ };
+ {
+ name = "resultModulePath";
+ value = mk_string_list builtInCompletionModules.resultModulePath;
+ };
+ {
+ name = "exnModulePath";
+ value = mk_string_list builtInCompletionModules.exnModulePath;
+ };
+ {
+ name = "regexpModulePath";
+ value = mk_string_list builtInCompletionModules.regexpModulePath;
+ };
+ ]
+
let mk_package (package : SharedTypes.package) : oak =
Record
[
@@ -130,6 +179,30 @@ module Transform = struct
name = "genericJsxModule";
value = mk_string_option package.genericJsxModule;
};
+ {name = "suffix"; value = String package.suffix};
+ {name = "rootPath"; value = String package.rootPath};
+ {name = "projectFiles"; value = mk_FileSet package.projectFiles};
+ {
+ name = "dependenciesFiles";
+ value = mk_FileSet package.dependenciesFiles;
+ };
+ {name = "namespace"; value = mk_string_option package.namespace};
+ {
+ name = "builtInCompletionModules";
+ value = mk_builtInCompletionModules package.builtInCompletionModules;
+ };
+ {name = "opens"; value = mk_string_list (List.concat package.opens)};
+ {name = "uncurried"; value = mk_bool package.uncurried};
+ {
+ name = "rescriptVersion";
+ value =
+ (let major, minor = package.rescriptVersion in
+ Tuple
+ [
+ {name = "major"; value = String (string_of_int major)};
+ {name = "minor"; value = String (string_of_int minor)};
+ ]);
+ };
]
let mk_Uri (uri : Uri.t) : oak = String (Uri.toString uri)
From 2c487c53332d7b1b974c62eead915d1ac2339c43 Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Thu, 10 Oct 2024 16:44:45 +0200
Subject: [PATCH 11/24] Wrap tuple in parentheses in named field
---
tools/src/prettier_printer.ml | 9 +++++++--
1 file changed, 7 insertions(+), 2 deletions(-)
diff --git a/tools/src/prettier_printer.ml b/tools/src/prettier_printer.ml
index c1a135b8a..e2e276619 100644
--- a/tools/src/prettier_printer.ml
+++ b/tools/src/prettier_printer.ml
@@ -245,13 +245,18 @@ module CodePrinter = struct
and genIdent (ident : string) : appendEvents = !-ident
and genNamedField (field : namedField) : appendEvents =
- let short = !-(field.name) +> sepEq +> genOak field.value in
+ let genValue =
+ match field.value with
+ | Tuple _ -> sepOpenT +> genOak field.value +> sepCloseT
+ | _ -> genOak field.value
+ in
+ let short = !-(field.name) +> sepEq +> genValue in
let long =
!-(field.name) +> sepEq
+>
match field.value with
| List _ | Record _ -> genOak field.value
- | _ -> indentAndNln (genOak field.value)
+ | _ -> indentAndNln genValue
in
expressionFitsOnRestOfLine short long
From f6fd9a7330d048cbae9e4760c579701cb2ea1a03 Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Thu, 10 Oct 2024 17:07:37 +0200
Subject: [PATCH 12/24] Complete mk_type_desc
---
tools/src/prettier_printer.ml | 26 +++-----
tools/src/print_tast.ml | 116 +++++++++++++++++++++++++---------
2 files changed, 95 insertions(+), 47 deletions(-)
diff --git a/tools/src/prettier_printer.ml b/tools/src/prettier_printer.ml
index e2e276619..60639e3f8 100644
--- a/tools/src/prettier_printer.ml
+++ b/tools/src/prettier_printer.ml
@@ -1,12 +1,10 @@
(* open Analysis *)
module DSL = struct
- type application = {name: string; argument: oak}
-
- and namedField = {name: string; value: oak}
+ type namedField = {name: string; value: oak}
and oak =
- | Application of application
+ | Application of string * oak
| Record of namedField list
| Ident of string
| Tuple of namedField list
@@ -90,7 +88,7 @@ module CodePrinter = struct
let mode =
match ctx.mode with
| Standard -> "Standard"
- | TrySingleLine _ -> "TrySingleLine"
+ | TrySingleLine -> "TrySingleLine"
| ConfirmedMultiline -> "ConfirmedMultiline"
in
Format.printf
@@ -199,24 +197,20 @@ module CodePrinter = struct
let rec genOak (oak : oak) : appendEvents =
match oak with
- | Application application -> genApplication application
+ | Application (name, argument) -> genApplication name argument
| Record record -> genRecord record
| Ident ident -> genIdent ident
| String str -> !-(Format.sprintf "\"%s\"" str)
| Tuple ts -> genTuple ts
| List xs -> genList xs
- and genApplication (application : application) : appendEvents =
- let short =
- !-(application.name) +> sepOpenT
- +> genOak application.argument
- +> sepCloseT
- in
+ and genApplication (name : string) (argument : oak) : appendEvents =
+ let short = !-name +> sepOpenT +> genOak argument +> sepCloseT in
let long =
- !-(application.name) +> sepOpenT
- +> (match application.argument with
- | List _ | Record _ -> genOak application.argument
- | _ -> indentAndNln (genOak application.argument) +> sepNln)
+ !-name +> sepOpenT
+ +> (match argument with
+ | List _ | Record _ -> genOak argument
+ | _ -> indentAndNln (genOak argument) +> sepNln)
+> sepCloseT
in
expressionFitsOnRestOfLine short long
diff --git a/tools/src/print_tast.ml b/tools/src/print_tast.ml
index 49b306168..b780a5ce8 100644
--- a/tools/src/print_tast.ml
+++ b/tools/src/print_tast.ml
@@ -8,7 +8,7 @@ module Transform = struct
let mk_string_option (o : string option) : oak =
match o with
| None -> Ident "None"
- | Some s -> Application {name = "Some"; argument = String s}
+ | Some s -> Application ("Some", String s)
let mk_string_list (items : string list) : oak =
List (items |> List.map (fun s -> String s))
@@ -36,50 +36,105 @@ module Transform = struct
| Reither _ -> Ident "row_field.Reither"
| Rabsent -> Ident "row_field.Rabsent"
+ let mk_field_kind = function
+ | Types.Fvar _ -> Ident "field_kind.Fvar"
+ | Types.Fpresent -> Ident "field_kind.Fpresent"
+ | Types.Fabsent -> Ident "field_kind.Fabsent"
+
let rec mk_type_desc (desc : Types.type_desc) : oak =
match desc with
- | Tlink {desc} ->
- Application {name = "type_desc.Tlink"; argument = mk_type_desc desc}
+ | Tlink {desc} -> Application ("type_desc.Tlink", mk_type_desc desc)
| Tvar var -> (
match var with
- | None -> Application {name = "type_desc.Tvar"; argument = Ident "None"}
- | Some s -> Application {name = "type_desc.Tvar"; argument = Ident s})
+ | None -> Application ("type_desc.Tvar", Ident "None")
+ | Some s -> Application ("type_desc.Tvar", Ident s))
| Tconstr (path, ts, _) ->
let ts =
ts |> List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc)
in
Application
- {
- name = "type_desc.Tconstr";
- argument =
- Tuple
- [
- {name = "path"; value = Ident (path_to_string path)};
- {name = "ts"; value = List ts};
- ];
- }
+ ( "type_desc.Tconstr",
+ Tuple
+ [
+ {name = "path"; value = Ident (path_to_string path)};
+ {name = "ts"; value = List ts};
+ ] )
| Tarrow (_, t1, t2, _) ->
Application
- {
- name = "type_desc.Tarrow";
- argument =
+ ( "type_desc.Tarrow",
+ Tuple
+ [
+ {name = "t1"; value = mk_type_desc t1.desc};
+ {name = "t2"; value = mk_type_desc t2.desc};
+ ] )
+ | Ttuple ts ->
+ let ts =
+ ts |> List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc)
+ in
+ Application ("type_desc.Ttuple", List ts)
+ | Tobject (t, r) -> (
+ match !r with
+ | None -> Application ("type_desc.Tobject", mk_type_desc t.desc)
+ | Some (path, ts) ->
+ Application
+ ( "type_desc.Tobject",
Tuple
[
- {name = "t1"; value = mk_type_desc t1.desc};
- {name = "t2"; value = mk_type_desc t2.desc};
- ];
- }
- | Ttuple _ -> Ident "type_desc.Ttuple"
- | Tobject _ -> Ident "type_desc.Tobject"
- | Tfield _ -> Ident "type_desc.Tfield"
+ {name = "type_expr"; value = mk_type_desc t.desc};
+ {name = "path"; value = Ident (path_to_string path)};
+ {
+ name = "ts";
+ value =
+ List
+ (ts
+ |> List.map (fun (t : Types.type_expr) ->
+ mk_type_desc t.desc));
+ };
+ ] ))
+ | Tfield (field, fk, t1, t2) ->
+ Application
+ ( "type_desc.Tfield",
+ Tuple
+ [
+ {name = "name"; value = String field};
+ {name = "field_kind"; value = mk_field_kind fk};
+ {name = "t1"; value = mk_type_desc t1.desc};
+ {name = "t2"; value = mk_type_desc t2.desc};
+ ] )
| Tnil -> Ident "type_desc.Tnil"
- | Tsubst _ -> Ident "type_desc.Tsubst"
+ | Tsubst t -> Application ("type_desc.Tsubst", mk_type_desc t.desc)
| Tvariant row_descr ->
+ Application ("type_desc.Tvariant", mk_row_desc row_descr)
+ | Tunivar so -> Application ("type_desc.Tunivar", mk_string_option so)
+ | Tpoly (t, ts) ->
+ let ts =
+ ts |> List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc)
+ in
+ Application
+ ( "type_desc.Tpoly",
+ Tuple
+ [
+ {name = "t"; value = mk_type_desc t.desc};
+ {name = "ts"; value = List ts};
+ ] )
+ | Tpackage (path, lids, ts) ->
+ let lids =
+ lids
+ |> List.map (fun (lid : Longident.t) ->
+ List
+ (Longident.flatten lid |> List.map (fun ident -> String ident)))
+ in
+ let ts =
+ ts |> List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc)
+ in
Application
- {name = "type_desc.Tvariant"; argument = mk_row_desc row_descr}
- | Tunivar _ -> Ident "type_desc.Tunivar"
- | Tpoly _ -> Ident "type_desc.Tpoly"
- | Tpackage _ -> Ident "type_desc.Tpackage"
+ ( "type_desc.Tpackage",
+ Tuple
+ [
+ {name = "path"; value = Ident (path_to_string path)};
+ {name = "lids"; value = List lids};
+ {name = "ts"; value = List ts};
+ ] )
and mk_row_desc (row_desc : Types.row_desc) : oak =
let fields =
@@ -211,8 +266,7 @@ module Transform = struct
let kind =
match item.kind with
| SharedTypes.Module.Value v ->
- Application
- {name = "SharedTypes.Module.Value"; argument = mk_type_desc v.desc}
+ Application ("SharedTypes.Module.Value", mk_type_desc v.desc)
| SharedTypes.Module.Type _ -> Ident "Type"
| SharedTypes.Module.Module _ -> Ident "Module"
in
From e1227bcf2b84fcf921655c4362878def88e823f6 Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Fri, 11 Oct 2024 09:34:54 +0200
Subject: [PATCH 13/24] Add support for Type.t
---
tools/src/print_tast.ml | 215 +++++++++++++++++++++++++++++++++++-----
1 file changed, 190 insertions(+), 25 deletions(-)
diff --git a/tools/src/print_tast.ml b/tools/src/print_tast.ml
index b780a5ce8..f42dccfc3 100644
--- a/tools/src/print_tast.ml
+++ b/tools/src/print_tast.ml
@@ -5,13 +5,21 @@ open Analysis
module Transform = struct
let mk_bool (b : bool) : oak = if b then Ident "true" else Ident "false"
- let mk_string_option (o : string option) : oak =
+ let mk_option f o =
match o with
| None -> Ident "None"
- | Some s -> Application ("Some", String s)
+ | Some x -> Application ("Some", f x)
+
+ let mk_string_option (o : string option) : oak =
+ mk_option (fun s -> String s) o
+
+ let mk_list f l = List (List.map f l)
let mk_string_list (items : string list) : oak =
- List (items |> List.map (fun s -> String s))
+ mk_list (fun s -> String s) items
+
+ let mk_int_list (items : int list) : oak =
+ mk_list (fun i -> Ident (string_of_int i)) items
let path_to_string path =
let buf = Buffer.create 64 in
@@ -44,20 +52,14 @@ module Transform = struct
let rec mk_type_desc (desc : Types.type_desc) : oak =
match desc with
| Tlink {desc} -> Application ("type_desc.Tlink", mk_type_desc desc)
- | Tvar var -> (
- match var with
- | None -> Application ("type_desc.Tvar", Ident "None")
- | Some s -> Application ("type_desc.Tvar", Ident s))
+ | Tvar var -> Application ("type_desc.Tvar", mk_string_option var)
| Tconstr (path, ts, _) ->
- let ts =
- ts |> List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc)
- in
Application
( "type_desc.Tconstr",
Tuple
[
{name = "path"; value = Ident (path_to_string path)};
- {name = "ts"; value = List ts};
+ {name = "ts"; value = mk_type_expr_list ts};
] )
| Tarrow (_, t1, t2, _) ->
Application
@@ -67,11 +69,7 @@ module Transform = struct
{name = "t1"; value = mk_type_desc t1.desc};
{name = "t2"; value = mk_type_desc t2.desc};
] )
- | Ttuple ts ->
- let ts =
- ts |> List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc)
- in
- Application ("type_desc.Ttuple", List ts)
+ | Ttuple ts -> Application ("type_desc.Ttuple", mk_type_expr_list ts)
| Tobject (t, r) -> (
match !r with
| None -> Application ("type_desc.Tobject", mk_type_desc t.desc)
@@ -107,15 +105,12 @@ module Transform = struct
Application ("type_desc.Tvariant", mk_row_desc row_descr)
| Tunivar so -> Application ("type_desc.Tunivar", mk_string_option so)
| Tpoly (t, ts) ->
- let ts =
- ts |> List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc)
- in
Application
( "type_desc.Tpoly",
Tuple
[
{name = "t"; value = mk_type_desc t.desc};
- {name = "ts"; value = List ts};
+ {name = "ts"; value = mk_type_expr_list ts};
] )
| Tpackage (path, lids, ts) ->
let lids =
@@ -124,16 +119,13 @@ module Transform = struct
List
(Longident.flatten lid |> List.map (fun ident -> String ident)))
in
- let ts =
- ts |> List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc)
- in
Application
( "type_desc.Tpackage",
Tuple
[
{name = "path"; value = Ident (path_to_string path)};
{name = "lids"; value = List lids};
- {name = "ts"; value = List ts};
+ {name = "ts"; value = mk_type_expr_list ts};
] )
and mk_row_desc (row_desc : Types.row_desc) : oak =
@@ -178,6 +170,9 @@ module Transform = struct
}
:: fields)
+ and mk_type_expr_list ts =
+ List (List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc) ts)
+
let mk_FileSet (fileSet : SharedTypes.FileSet.t) : oak =
List (fileSet |> SharedTypes.FileSet.to_list |> List.map (fun s -> String s))
@@ -262,12 +257,182 @@ module Transform = struct
let mk_Uri (uri : Uri.t) : oak = String (Uri.toString uri)
+ let mk_rec_status = function
+ | Types.Trec_not -> Ident "Trec_not"
+ | Types.Trec_first -> Ident "Trec_first"
+ | Types.Trec_next -> Ident "Trec_next"
+
+ let mk_field (field : SharedTypes.field) : oak =
+ Record
+ [
+ {name = "stamp"; value = Ident (string_of_int field.stamp)};
+ {name = "fname"; value = String field.fname.txt};
+ {name = "typ"; value = mk_type_desc field.typ.desc};
+ {name = "optional"; value = mk_bool field.optional};
+ {name = "docstring"; value = mk_string_list field.docstring};
+ {name = "deprecated"; value = mk_string_option field.deprecated};
+ ]
+
+ let mk_pos (pos : Lexing.position) : oak =
+ Record
+ [
+ {name = "pos_fname"; value = String pos.pos_fname};
+ {name = "pos_lnum"; value = Ident (string_of_int pos.pos_lnum)};
+ {name = "pos_bol"; value = Ident (string_of_int pos.pos_bol)};
+ {name = "pos_cnum"; value = Ident (string_of_int pos.pos_cnum)};
+ ]
+
+ let mk_location (loc : Location.t) =
+ Record
+ [
+ {name = "loc_start"; value = mk_pos loc.loc_start};
+ {name = "loc_end"; value = mk_pos loc.loc_end};
+ {name = "loc_ghost"; value = mk_bool loc.loc_ghost};
+ ]
+
+ let mk_string_loc (loc : string Location.loc) : oak =
+ Record
+ [
+ {name = "txt"; value = String loc.txt};
+ {name = "loc"; value = mk_location loc.loc};
+ ]
+
+ let mk_constructor_args (args : SharedTypes.constructorArgs) : oak =
+ match args with
+ | SharedTypes.InlineRecord fields ->
+ Application
+ ("constructorArgs.InlineRecord", List (fields |> List.map mk_field))
+ | SharedTypes.Args ts ->
+ let ts =
+ ts
+ |> List.map (fun ((t : Types.type_expr), loc) ->
+ Tuple
+ [
+ {name = "type"; value = mk_type_desc t.desc};
+ {name = "loc"; value = mk_location loc};
+ ])
+ in
+ Application ("constructorArgs.Tuple", List ts)
+
+ let mk_constructor (ctor : SharedTypes.Constructor.t) : oak =
+ Record
+ [
+ {name = "stamp"; value = Ident (string_of_int ctor.stamp)};
+ {
+ name = "cname";
+ value =
+ Record
+ [
+ {name = "txt"; value = String ctor.cname.txt};
+ {name = "loc"; value = mk_location ctor.cname.loc};
+ ];
+ };
+ {name = "args"; value = mk_constructor_args ctor.args};
+ {name = "docstring"; value = mk_string_list ctor.docstring};
+ {name = "deprecated"; value = mk_string_option ctor.deprecated};
+ ]
+ let mk_attribute_payload (payload : Parsetree.payload) : oak =
+ match payload with
+ | PStr _ -> Ident "payload.PStr"
+ | PSig _ -> Ident "payload.PSig"
+ | PTyp _ -> Ident "payload.PTyp"
+ | PPat _ -> Ident "payload.PPat"
+
+ let mk_attribute (attribute : Parsetree.attribute) : oak =
+ let loc, payload = attribute in
+ Tuple
+ [
+ {name = "loc"; value = mk_string_loc loc};
+ {name = "payload"; value = mk_attribute_payload payload};
+ ]
+
+ let mk_attribute_list (attributes : Parsetree.attributes) =
+ List (attributes |> List.map mk_attribute)
+
+ let mk_type_kind (kind : SharedTypes.Type.kind) : oak =
+ match kind with
+ | SharedTypes.Type.Abstract _ -> Ident "Type.kind.Abstract"
+ | SharedTypes.Type.Open -> Ident "Type.kind.Open"
+ | SharedTypes.Type.Tuple ts ->
+ Application ("Type.kind.Tuple", mk_type_expr_list ts)
+ | SharedTypes.Type.Record fields ->
+ let fields = List.map mk_field fields in
+ Application ("Type.kind.Record", List fields)
+ | SharedTypes.Type.Variant ctors ->
+ Application ("Type.kind.Variant", List (ctors |> List.map mk_constructor))
+
+ let mk_type_declaration_type_kind (type_kind : Types.type_kind) : oak =
+ match type_kind with
+ | Type_abstract -> Ident "type_kind.Type_abstract"
+ | Type_variant _ -> Ident "type_kind.Type_variant"
+ | Type_record _ -> Ident "type_kind.Type_record"
+ | Type_open -> Ident "type_kind.Type_open"
+
+ let mk_private_flag = function
+ | Asttypes.Private -> Ident "Private"
+ | Asttypes.Public -> Ident "Public"
+
+ let mk_unboxed_status (status : Types.unboxed_status) : oak =
+ Record
+ [
+ {name = "unboxed"; value = mk_bool status.unboxed};
+ {name = "default"; value = mk_bool status.default};
+ ]
+
+ let mk_type_declaration (td : Types.type_declaration) : oak =
+ Record
+ [
+ {name = "type_params"; value = mk_type_expr_list td.type_params};
+ {name = "type_arity"; value = Ident (string_of_int td.type_arity)};
+ {name = "type_kind"; value = mk_type_declaration_type_kind td.type_kind};
+ {name = "type_private"; value = mk_private_flag td.type_private};
+ {
+ name = "type_manifest";
+ value =
+ mk_option
+ (fun (te : Types.type_expr) -> mk_type_desc te.desc)
+ td.type_manifest;
+ };
+ {
+ name = "type_newtype_level";
+ value =
+ mk_option
+ (fun (i1, i2) ->
+ Tuple
+ [
+ {name = "i1"; value = Ident (string_of_int i1)};
+ {name = "i2"; value = Ident (string_of_int i2)};
+ ])
+ td.type_newtype_level;
+ };
+ {name = "type_loc"; value = mk_location td.type_loc};
+ {name = "type_attributes"; value = mk_attribute_list td.type_attributes};
+ {name = "type_immediate"; value = mk_bool td.type_immediate};
+ {name = "type_unboxed"; value = mk_unboxed_status td.type_unboxed};
+ ]
+
+ let mk_type (type_ : SharedTypes.Type.t) : oak =
+ Record
+ [
+ {name = "kind"; value = mk_type_kind type_.kind};
+ {name = "decl"; value = mk_type_declaration type_.decl};
+ {name = "name"; value = String type_.name};
+ {name = "attributes"; value = mk_attribute_list type_.attributes};
+ ]
+
let mk_item (item : SharedTypes.Module.item) : oak =
let kind =
match item.kind with
| SharedTypes.Module.Value v ->
Application ("SharedTypes.Module.Value", mk_type_desc v.desc)
- | SharedTypes.Module.Type _ -> Ident "Type"
+ | SharedTypes.Module.Type (t, rec_status) ->
+ Application
+ ( "Type",
+ Tuple
+ [
+ {name = "type"; value = mk_type t};
+ {name = "rec_status"; value = mk_rec_status rec_status};
+ ] )
| SharedTypes.Module.Module _ -> Ident "Module"
in
Record
From 2c2e5b7e98d2c8e0a39085fbdb3da5b21f029625 Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Fri, 11 Oct 2024 09:43:08 +0200
Subject: [PATCH 14/24] Print module
---
tools/src/print_tast.ml | 52 +++++++++++++++++++++++++++++------------
1 file changed, 37 insertions(+), 15 deletions(-)
diff --git a/tools/src/print_tast.ml b/tools/src/print_tast.ml
index f42dccfc3..4f8b1e997 100644
--- a/tools/src/print_tast.ml
+++ b/tools/src/print_tast.ml
@@ -38,6 +38,8 @@ module Transform = struct
aux path;
Buffer.contents buf
+ let mk_path path = Ident (path_to_string path)
+
let mk_row_field (row_field : Types.row_field) : oak =
match row_field with
| Rpresent _ -> Ident "row_field.Rpresent"
@@ -58,7 +60,7 @@ module Transform = struct
( "type_desc.Tconstr",
Tuple
[
- {name = "path"; value = Ident (path_to_string path)};
+ {name = "path"; value = mk_path path};
{name = "ts"; value = mk_type_expr_list ts};
] )
| Tarrow (_, t1, t2, _) ->
@@ -79,7 +81,7 @@ module Transform = struct
Tuple
[
{name = "type_expr"; value = mk_type_desc t.desc};
- {name = "path"; value = Ident (path_to_string path)};
+ {name = "path"; value = mk_path path};
{
name = "ts";
value =
@@ -123,7 +125,7 @@ module Transform = struct
( "type_desc.Tpackage",
Tuple
[
- {name = "path"; value = Ident (path_to_string path)};
+ {name = "path"; value = mk_path path};
{name = "lids"; value = List lids};
{name = "ts"; value = mk_type_expr_list ts};
] )
@@ -157,7 +159,7 @@ module Transform = struct
value =
Tuple
[
- {name = "Path.t"; value = Ident (path_to_string path)};
+ {name = "Path.t"; value = mk_path path};
{
name = "fields";
value =
@@ -419,8 +421,30 @@ module Transform = struct
{name = "name"; value = String type_.name};
{name = "attributes"; value = mk_attribute_list type_.attributes};
]
+ let rec mk_structure (structure : SharedTypes.Module.structure) : oak =
+ Record
+ [
+ {name = "name"; value = String structure.name};
+ {name = "docstring"; value = mk_string_list structure.docstring};
+ {name = "items"; value = List (List.map mk_item structure.items)};
+ {name = "deprecated"; value = mk_string_option structure.deprecated};
+ ]
+
+ and mk_module (module_ : SharedTypes.Module.t) : oak =
+ match module_ with
+ | SharedTypes.Module.Ident path -> Application ("Ident", mk_path path)
+ | SharedTypes.Module.Structure structure ->
+ Application ("Structure", mk_structure structure)
+ | SharedTypes.Module.Constraint (t1, t2) ->
+ Application
+ ( "Constraint",
+ Tuple
+ [
+ {name = "t1"; value = mk_module t1};
+ {name = "t2"; value = mk_module t2};
+ ] )
- let mk_item (item : SharedTypes.Module.item) : oak =
+ and mk_item (item : SharedTypes.Module.item) : oak =
let kind =
match item.kind with
| SharedTypes.Module.Value v ->
@@ -433,7 +457,14 @@ module Transform = struct
{name = "type"; value = mk_type t};
{name = "rec_status"; value = mk_rec_status rec_status};
] )
- | SharedTypes.Module.Module _ -> Ident "Module"
+ | SharedTypes.Module.Module m ->
+ Application
+ ( "Module",
+ Record
+ [
+ {name = "type_"; value = mk_module m.type_};
+ {name = "isModuleType"; value = mk_bool m.isModuleType};
+ ] )
in
Record
[
@@ -443,15 +474,6 @@ module Transform = struct
{name = "deprecated"; value = mk_string_option item.deprecated};
]
- let mk_structure (structure : SharedTypes.Module.structure) : oak =
- Record
- [
- {name = "name"; value = String structure.name};
- {name = "docstring"; value = mk_string_list structure.docstring};
- {name = "items"; value = List (List.map mk_item structure.items)};
- {name = "deprecated"; value = mk_string_option structure.deprecated};
- ]
-
let mk_file (file : SharedTypes.File.t) : oak =
Record
[
From eff807fdf697ce998323f5c86a84362e7983b15e Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Fri, 11 Oct 2024 09:47:47 +0200
Subject: [PATCH 15/24] Simplify dump code
---
tools/src/tools.ml | 37 +++++++++++--------------------------
1 file changed, 11 insertions(+), 26 deletions(-)
diff --git a/tools/src/tools.ml b/tools/src/tools.ml
index a784a6863..2c3ee7a35 100644
--- a/tools/src/tools.ml
+++ b/tools/src/tools.ml
@@ -641,42 +641,27 @@ let extractEmbedded ~extensionPoints ~filename =
])
|> List.rev |> array
+(** Dump the contents of a typed tree file *)
let dump entryPointFile =
let path =
- match Filename.is_relative entryPointFile with
- | true -> Unix.realpath entryPointFile
- | false -> entryPointFile
+ if Filename.is_relative entryPointFile then Unix.realpath entryPointFile
+ else entryPointFile
in
let result =
- match
+ if
FindFiles.isImplementation path = false
&& FindFiles.isInterface path = false
- with
- | false -> (
- let path =
- if FindFiles.isImplementation path then
- let pathAsResi =
- (path |> Filename.dirname) ^ "/"
- ^ (path |> Filename.basename |> Filename.chop_extension)
- ^ ".resi"
- in
- if Sys.file_exists pathAsResi then (
- Printf.printf "preferring found resi file for impl: %s\n" pathAsResi;
- pathAsResi)
- else path
- else path
- in
+ then
+ Error
+ (Printf.sprintf
+ "error: failed to read %s, expected an .res or .resi file" path)
+ else
match Cmt.loadFullCmtFromPath ~path with
| None ->
Error
(Printf.sprintf
- "error: failed to generate doc for %s, try to build the project"
- path)
- | Some full -> Ok (Print_tast.print_full full))
- | true ->
- Error
- (Printf.sprintf
- "error: failed to read %s, expected an .res or .resi file" path)
+ "error: failed to dump for %s, try to build the project" path)
+ | Some full -> Ok (Print_tast.print_full full)
in
result
From 3adb001a0134b3d7ec2c76ee9dab2d5df3a335b9 Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Fri, 11 Oct 2024 13:59:07 +0200
Subject: [PATCH 16/24] Clean up printer file
---
tools/src/prettier_printer.ml | 42 -----------------------------------
tools/src/printer_sandbox.ml | 39 ++++++++++++++++++++++++++++++++
2 files changed, 39 insertions(+), 42 deletions(-)
create mode 100644 tools/src/printer_sandbox.ml
diff --git a/tools/src/prettier_printer.ml b/tools/src/prettier_printer.ml
index 60639e3f8..f719f6409 100644
--- a/tools/src/prettier_printer.ml
+++ b/tools/src/prettier_printer.ml
@@ -1,5 +1,3 @@
-(* open Analysis *)
-
module DSL = struct
type namedField = {name: string; value: oak}
@@ -271,43 +269,3 @@ module CodePrinter = struct
in
expressionFitsOnRestOfLine short long
end
-
-(*
- Interpret using ocaml /home/nojaf/projects/rescript-vscode/tools/src/prettier_printer.ml
-*)
-
-(*
-open DSL
-
-let oak =
- DSL.Record
- [
- {
- name = "zig";
- value =
- DSL.Record
- [
- {name = "foo"; value = Ident "baaaaaaaaaaaaaaaaar"};
- {name = "member"; value = Ident "Zigbaaaaaaaaar"};
- ];
- };
- {
- name = "roxas";
- value =
- List
- [
- Ident "jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjj";
- Ident "meeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee";
- DSL.Record
- [
- {name = "foo"; value = Ident "baaaaaaaaaaaaaaaaar"};
- {name = "member"; value = Ident "Zigbaaaaaaaaar"};
- ];
- ];
- };
- {name = "foo"; value = Ident "baaaaaaaaaaaaaaaaar"};
- ]
-
- let _ =
- CodePrinter.genOak oak {CodePrinter.emptyContext with max_line_length = 20}
- |> CodePrinter.dump |> Format.printf "%s\n" *)
diff --git a/tools/src/printer_sandbox.ml b/tools/src/printer_sandbox.ml
new file mode 100644
index 000000000..31764e7f7
--- /dev/null
+++ b/tools/src/printer_sandbox.ml
@@ -0,0 +1,39 @@
+#use "prettier_printer.ml";;
+(*
+ Interpret using ocaml ./tools/src/printer_sandbox.ml
+*)
+
+open DSL
+
+let oak =
+ Record
+ [
+ {
+ name = "hello";
+ value =
+ Record
+ [
+ {name = "foo"; value = Ident "baaaaaaaaaaaaaaaaar"};
+ {name = "member"; value = Ident "baazaaaaaaar"};
+ ];
+ };
+ {
+ name = "roxas";
+ value =
+ List
+ [
+ Ident "jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjj";
+ Ident "meeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee";
+ Record
+ [
+ {name = "foo"; value = Ident "baaaaaaaaaaaaaaaaar"};
+ {name = "member"; value = Ident "bazaaaaaaaaar"};
+ ];
+ ];
+ };
+ {name = "foo"; value = Ident "baaaaaaaaaaaaaaaaar"};
+ ]
+
+let _ =
+ CodePrinter.genOak oak {CodePrinter.emptyContext with max_line_length = 20}
+ |> CodePrinter.dump |> Format.printf "%s\n"
From 47c4f797fddfa43292df67f5383e44dfcb86a7bc Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Fri, 11 Oct 2024 16:52:24 +0200
Subject: [PATCH 17/24] Update expected files
---
tools/src/printer_sandbox.ml | 6 +-
tools/src/tools.ml | 1 -
.../src/expected/DocExtraction2.res.json | 16 +++++
.../src/expected/DocExtraction2.resi.json | 16 +++++
.../src/expected/DocExtractionRes.res.json | 68 +++++++++++++++++++
tools/tests/src/expected/ModC.res.json | 5 ++
tools/tests/src/expected/ModC.resi.json | 5 ++
7 files changed, 114 insertions(+), 3 deletions(-)
diff --git a/tools/src/printer_sandbox.ml b/tools/src/printer_sandbox.ml
index 31764e7f7..7fd1b035f 100644
--- a/tools/src/printer_sandbox.ml
+++ b/tools/src/printer_sandbox.ml
@@ -1,7 +1,8 @@
-#use "prettier_printer.ml";;
(*
+#use "prettier_printer.ml";;
+
Interpret using ocaml ./tools/src/printer_sandbox.ml
-*)
+
open DSL
@@ -37,3 +38,4 @@ let oak =
let _ =
CodePrinter.genOak oak {CodePrinter.emptyContext with max_line_length = 20}
|> CodePrinter.dump |> Format.printf "%s\n"
+*)
\ No newline at end of file
diff --git a/tools/src/tools.ml b/tools/src/tools.ml
index 2c3ee7a35..fffac4fef 100644
--- a/tools/src/tools.ml
+++ b/tools/src/tools.ml
@@ -360,7 +360,6 @@ let isFunction = function
| _ -> false
let valueDetail (typ : Types.type_expr) =
- Printf.printf "%s\n" (Print_tast.print_type_expr typ);
let rec collectSignatureTypes (typ_desc : Types.type_desc) =
match typ_desc with
| Tlink t -> collectSignatureTypes t.desc
diff --git a/tools/tests/src/expected/DocExtraction2.res.json b/tools/tests/src/expected/DocExtraction2.res.json
index 224daefdc..770dbe1a6 100644
--- a/tools/tests/src/expected/DocExtraction2.res.json
+++ b/tools/tests/src/expected/DocExtraction2.res.json
@@ -30,6 +30,14 @@
"filepath": "src/DocExtraction2.resi",
"line": 7,
"col": 1
+ },
+ "detail": {
+ "parameters": [{
+ "path": "unit"
+ }],
+ "returnType": {
+ "path": "t"
+ }
}
},
{
@@ -65,6 +73,14 @@
"filepath": "src/DocExtraction2.resi",
"line": 15,
"col": 3
+ },
+ "detail": {
+ "parameters": [{
+ "path": "unit"
+ }],
+ "returnType": {
+ "path": "t"
+ }
}
}]
}]
diff --git a/tools/tests/src/expected/DocExtraction2.resi.json b/tools/tests/src/expected/DocExtraction2.resi.json
index 224daefdc..770dbe1a6 100644
--- a/tools/tests/src/expected/DocExtraction2.resi.json
+++ b/tools/tests/src/expected/DocExtraction2.resi.json
@@ -30,6 +30,14 @@
"filepath": "src/DocExtraction2.resi",
"line": 7,
"col": 1
+ },
+ "detail": {
+ "parameters": [{
+ "path": "unit"
+ }],
+ "returnType": {
+ "path": "t"
+ }
}
},
{
@@ -65,6 +73,14 @@
"filepath": "src/DocExtraction2.resi",
"line": 15,
"col": 3
+ },
+ "detail": {
+ "parameters": [{
+ "path": "unit"
+ }],
+ "returnType": {
+ "path": "t"
+ }
}
}]
}]
diff --git a/tools/tests/src/expected/DocExtractionRes.res.json b/tools/tests/src/expected/DocExtractionRes.res.json
index 93a727b3b..4c6dd2b1f 100644
--- a/tools/tests/src/expected/DocExtractionRes.res.json
+++ b/tools/tests/src/expected/DocExtractionRes.res.json
@@ -45,6 +45,14 @@
"filepath": "src/DocExtractionRes.res",
"line": 17,
"col": 5
+ },
+ "detail": {
+ "parameters": [{
+ "path": "string"
+ }],
+ "returnType": {
+ "path": "t"
+ }
}
},
{
@@ -57,6 +65,14 @@
"filepath": "src/DocExtractionRes.res",
"line": 23,
"col": 5
+ },
+ "detail": {
+ "parameters": [{
+ "path": "t"
+ }],
+ "returnType": {
+ "path": "t"
+ }
}
},
{
@@ -69,6 +85,11 @@
"filepath": "src/DocExtractionRes.res",
"line": 26,
"col": 5
+ },
+ "detail": {
+ "returnType": {
+ "path": "int"
+ }
}
},
{
@@ -184,6 +205,14 @@
"filepath": "src/DocExtractionRes.res",
"line": 49,
"col": 7
+ },
+ "detail": {
+ "parameters": [{
+ "path": "SomeInnerModule.status"
+ }],
+ "returnType": {
+ "path": "bool"
+ }
}
},
{
@@ -268,6 +297,14 @@
"filepath": "src/DocExtractionRes.res",
"line": 71,
"col": 3
+ },
+ "detail": {
+ "parameters": [{
+ "path": "unit"
+ }],
+ "returnType": {
+ "path": "t"
+ }
}
}]
},
@@ -304,6 +341,14 @@
"filepath": "src/DocExtractionRes.res",
"line": 109,
"col": 3
+ },
+ "detail": {
+ "parameters": [{
+ "path": "t"
+ }],
+ "returnType": {
+ "path": "t"
+ }
}
}]
},
@@ -341,6 +386,14 @@
"filepath": "src/DocExtractionRes.res",
"line": 128,
"col": 7
+ },
+ "detail": {
+ "parameters": [{
+ "path": "int"
+ }],
+ "returnType": {
+ "path": "int"
+ }
}
}]
},
@@ -365,6 +418,11 @@
"filepath": "src/DocExtractionRes.res",
"line": 132,
"col": 3
+ },
+ "detail": {
+ "returnType": {
+ "path": "int"
+ }
}
}]
},
@@ -390,6 +448,11 @@
"filepath": "src/DocExtractionRes.res",
"line": 136,
"col": 7
+ },
+ "detail": {
+ "returnType": {
+ "path": "int"
+ }
}
}]
},
@@ -426,6 +489,11 @@
"filepath": "src/DocExtractionRes.res",
"line": 141,
"col": 9
+ },
+ "detail": {
+ "returnType": {
+ "path": "int"
+ }
}
}]
}]
diff --git a/tools/tests/src/expected/ModC.res.json b/tools/tests/src/expected/ModC.res.json
index 4f68f6191..cff8a7315 100644
--- a/tools/tests/src/expected/ModC.res.json
+++ b/tools/tests/src/expected/ModC.res.json
@@ -29,6 +29,11 @@
"filepath": "src/ModC.resi",
"line": 5,
"col": 3
+ },
+ "detail": {
+ "returnType": {
+ "path": "string"
+ }
}
}]
}]
diff --git a/tools/tests/src/expected/ModC.resi.json b/tools/tests/src/expected/ModC.resi.json
index 4f68f6191..cff8a7315 100644
--- a/tools/tests/src/expected/ModC.resi.json
+++ b/tools/tests/src/expected/ModC.resi.json
@@ -29,6 +29,11 @@
"filepath": "src/ModC.resi",
"line": 5,
"col": 3
+ },
+ "detail": {
+ "returnType": {
+ "path": "string"
+ }
}
}]
}]
From 1e14581ceac77957152db54d2d8480082e93258f Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Sat, 12 Oct 2024 11:51:48 +0200
Subject: [PATCH 18/24] Update ReScript bindings
---
tools/npm/Tools_Docgen.res | 13 +++++++++++++
tools/npm/Tools_Docgen.resi | 14 ++++++++++++++
2 files changed, 27 insertions(+)
diff --git a/tools/npm/Tools_Docgen.res b/tools/npm/Tools_Docgen.res
index c6b7d450c..197a5ee05 100644
--- a/tools/npm/Tools_Docgen.res
+++ b/tools/npm/Tools_Docgen.res
@@ -17,10 +17,21 @@ type constructor = {
payload?: constructorPayload,
}
+type rec typeInSignature = {
+ path: string,
+ genericTypeParameters: array<typeInSignature>,
+}
+
+type signatureDetais = {
+ parameters: array<typeInSignature>,
+ returnType: typeInSignature,
+}
+
@tag("kind")
type detail =
| @as("record") Record({items: array<field>})
| @as("variant") Variant({items: array<constructor>})
+ | @as("alias") Signature(signatureDetais)
type source = {
filepath: string,
@@ -38,6 +49,8 @@ type rec item =
name: string,
deprecated?: string,
source: source,
+ /** Additional documentation of signature, if available. */
+ detail?: detail,
})
| @as("type")
Type({
diff --git a/tools/npm/Tools_Docgen.resi b/tools/npm/Tools_Docgen.resi
index 271f65f99..e0964da76 100644
--- a/tools/npm/Tools_Docgen.resi
+++ b/tools/npm/Tools_Docgen.resi
@@ -16,10 +16,22 @@ type constructor = {
deprecated?: string,
payload?: constructorPayload,
}
+
+type rec typeInSignature = {
+ path: string,
+ genericTypeParameters: array<typeInSignature>,
+}
+
+type signatureDetais = {
+ parameters: array<typeInSignature>,
+ returnType: typeInSignature,
+}
+
@tag("kind")
type detail =
| @as("record") Record({items: array<field>})
| @as("variant") Variant({items: array<constructor>})
+ | @as("alias") Signature(signatureDetais)
type source = {
filepath: string,
@@ -37,6 +49,8 @@ type rec item =
name: string,
deprecated?: string,
source: source,
+ /** Additional documentation of signature, if available. */
+ detail?: detail,
})
| @as("type")
Type({
From 3018283c117817ad9e6960c97cbac617969ce111 Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Wed, 16 Oct 2024 12:06:42 +0200
Subject: [PATCH 19/24] Correct signature detail in JSON
---
tools/npm/Tools_Docgen.resi | 2 +-
tools/src/tools.ml | 12 +++-
.../src/expected/DocExtraction2.res.json | 12 +++-
.../src/expected/DocExtraction2.resi.json | 12 +++-
.../src/expected/DocExtractionRes.res.json | 60 +++++++++++++++----
tools/tests/src/expected/ModC.res.json | 6 +-
tools/tests/src/expected/ModC.resi.json | 6 +-
7 files changed, 90 insertions(+), 20 deletions(-)
diff --git a/tools/npm/Tools_Docgen.resi b/tools/npm/Tools_Docgen.resi
index e0964da76..3328ba671 100644
--- a/tools/npm/Tools_Docgen.resi
+++ b/tools/npm/Tools_Docgen.resi
@@ -31,7 +31,7 @@ type signatureDetais = {
type detail =
| @as("record") Record({items: array<field>})
| @as("variant") Variant({items: array<constructor>})
- | @as("alias") Signature(signatureDetais)
+ | @as("signature") Signature(signatureDetais)
type source = {
filepath: string,
diff --git a/tools/src/tools.ml b/tools/src/tools.ml
index fffac4fef..a2134602f 100644
--- a/tools/src/tools.ml
+++ b/tools/src/tools.ml
@@ -173,10 +173,16 @@ let stringifyDetail ?(indentation = 0) (detail : docItemDetail) =
ps |> List.map (stringifyTypeDoc ~indentation:(indentation + 1))
|> fun ps -> Some (array ps)
in
- stringifyObject ~startOnNewline:false ~indentation
+ stringifyObject ~startOnNewline:true ~indentation
[
- ("parameters", ps);
- ("returnType", Some (stringifyTypeDoc ~indentation returnType));
+ ("kind", Some (wrapInQuotes "signature"));
+ ( "items",
+ Some
+ (stringifyObject ~startOnNewline:false ~indentation
+ [
+ ("parameters", ps);
+ ("returnType", Some (stringifyTypeDoc ~indentation returnType));
+ ]) );
]
let stringifySource ~indentation source =
diff --git a/tools/tests/src/expected/DocExtraction2.res.json b/tools/tests/src/expected/DocExtraction2.res.json
index 770dbe1a6..fd0e7784e 100644
--- a/tools/tests/src/expected/DocExtraction2.res.json
+++ b/tools/tests/src/expected/DocExtraction2.res.json
@@ -31,7 +31,10 @@
"line": 7,
"col": 1
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"parameters": [{
"path": "unit"
}],
@@ -39,6 +42,7 @@
"path": "t"
}
}
+ }
},
{
"id": "DocExtraction2.InnerModule",
@@ -74,7 +78,10 @@
"line": 15,
"col": 3
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"parameters": [{
"path": "unit"
}],
@@ -82,6 +89,7 @@
"path": "t"
}
}
+ }
}]
}]
}
diff --git a/tools/tests/src/expected/DocExtraction2.resi.json b/tools/tests/src/expected/DocExtraction2.resi.json
index 770dbe1a6..fd0e7784e 100644
--- a/tools/tests/src/expected/DocExtraction2.resi.json
+++ b/tools/tests/src/expected/DocExtraction2.resi.json
@@ -31,7 +31,10 @@
"line": 7,
"col": 1
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"parameters": [{
"path": "unit"
}],
@@ -39,6 +42,7 @@
"path": "t"
}
}
+ }
},
{
"id": "DocExtraction2.InnerModule",
@@ -74,7 +78,10 @@
"line": 15,
"col": 3
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"parameters": [{
"path": "unit"
}],
@@ -82,6 +89,7 @@
"path": "t"
}
}
+ }
}]
}]
}
diff --git a/tools/tests/src/expected/DocExtractionRes.res.json b/tools/tests/src/expected/DocExtractionRes.res.json
index 4c6dd2b1f..bf7fa2034 100644
--- a/tools/tests/src/expected/DocExtractionRes.res.json
+++ b/tools/tests/src/expected/DocExtractionRes.res.json
@@ -46,7 +46,10 @@
"line": 17,
"col": 5
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"parameters": [{
"path": "string"
}],
@@ -54,6 +57,7 @@
"path": "t"
}
}
+ }
},
{
"id": "DocExtractionRes.asOffline",
@@ -66,7 +70,10 @@
"line": 23,
"col": 5
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"parameters": [{
"path": "t"
}],
@@ -74,6 +81,7 @@
"path": "t"
}
}
+ }
},
{
"id": "DocExtractionRes.SomeConstant",
@@ -86,11 +94,15 @@
"line": 26,
"col": 5
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"returnType": {
"path": "int"
}
}
+ }
},
{
"id": "DocExtractionRes.SomeInnerModule",
@@ -206,7 +218,10 @@
"line": 49,
"col": 7
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"parameters": [{
"path": "SomeInnerModule.status"
}],
@@ -214,6 +229,7 @@
"path": "bool"
}
}
+ }
},
{
"id": "DocExtractionRes.AnotherModule.someVariantWithInlineRecords",
@@ -298,7 +314,10 @@
"line": 71,
"col": 3
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"parameters": [{
"path": "unit"
}],
@@ -306,6 +325,7 @@
"path": "t"
}
}
+ }
}]
},
{
@@ -342,7 +362,10 @@
"line": 109,
"col": 3
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"parameters": [{
"path": "t"
}],
@@ -350,6 +373,7 @@
"path": "t"
}
}
+ }
}]
},
{
@@ -387,7 +411,10 @@
"line": 128,
"col": 7
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"parameters": [{
"path": "int"
}],
@@ -395,6 +422,7 @@
"path": "int"
}
}
+ }
}]
},
{
@@ -419,11 +447,15 @@
"line": 132,
"col": 3
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"returnType": {
"path": "int"
}
}
+ }
}]
},
{
@@ -449,11 +481,15 @@
"line": 136,
"col": 7
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"returnType": {
"path": "int"
}
}
+ }
}]
},
{
@@ -490,11 +526,15 @@
"line": 141,
"col": 9
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"returnType": {
"path": "int"
}
}
+ }
}]
}]
}]
diff --git a/tools/tests/src/expected/ModC.res.json b/tools/tests/src/expected/ModC.res.json
index cff8a7315..031d09bf8 100644
--- a/tools/tests/src/expected/ModC.res.json
+++ b/tools/tests/src/expected/ModC.res.json
@@ -30,11 +30,15 @@
"line": 5,
"col": 3
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"returnType": {
"path": "string"
}
}
+ }
}]
}]
}
diff --git a/tools/tests/src/expected/ModC.resi.json b/tools/tests/src/expected/ModC.resi.json
index cff8a7315..031d09bf8 100644
--- a/tools/tests/src/expected/ModC.resi.json
+++ b/tools/tests/src/expected/ModC.resi.json
@@ -30,11 +30,15 @@
"line": 5,
"col": 3
},
- "detail": {
+ "detail":
+ {
+ "kind": "signature",
+ "items": {
"returnType": {
"path": "string"
}
}
+ }
}]
}]
}
From 900278e7cf6af53c71f83c65757c392a07d34eba Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Wed, 16 Oct 2024 12:08:28 +0200
Subject: [PATCH 20/24] Refactor infix operator
---
tools/src/prettier_printer.ml | 34 +++++++++++++++++-----------------
1 file changed, 17 insertions(+), 17 deletions(-)
diff --git a/tools/src/prettier_printer.ml b/tools/src/prettier_printer.ml
index f719f6409..118024c54 100644
--- a/tools/src/prettier_printer.ml
+++ b/tools/src/prettier_printer.ml
@@ -111,7 +111,7 @@ module CodePrinter = struct
let id x = x
(** add a write event to the context *)
- let ( !- ) str ctx =
+ let write str ctx =
{
ctx with
events = Write str :: ctx.events;
@@ -135,16 +135,16 @@ module CodePrinter = struct
}
|> updateMode true
- let sepSpace ctx = !-" " ctx
- let sepComma ctx = !-", " ctx
- let sepSemi ctx = !-"; " ctx
- let sepOpenT ctx = !-"(" ctx
- let sepCloseT ctx = !-")" ctx
- let sepOpenR ctx = !-"{" ctx
- let sepCloseR ctx = !-"}" ctx
- let sepOpenL ctx = !-"[" ctx
- let sepCloseL ctx = !-"]" ctx
- let sepEq ctx = !-" = " ctx
+ let sepSpace ctx = write " " ctx
+ let sepComma ctx = write ", " ctx
+ let sepSemi ctx = write "; " ctx
+ let sepOpenT ctx = write "(" ctx
+ let sepCloseT ctx = write ")" ctx
+ let sepOpenR ctx = write "{" ctx
+ let sepCloseR ctx = write "}" ctx
+ let sepOpenL ctx = write "[" ctx
+ let sepCloseL ctx = write "]" ctx
+ let sepEq ctx = write " = " ctx
let wrapInParentheses f = sepOpenT +> f +> sepCloseT
let indent ctx =
let nextIdent = ctx.current_indent + ctx.indent_size in
@@ -198,14 +198,14 @@ module CodePrinter = struct
| Application (name, argument) -> genApplication name argument
| Record record -> genRecord record
| Ident ident -> genIdent ident
- | String str -> !-(Format.sprintf "\"%s\"" str)
+ | String str -> write (Format.sprintf "\"%s\"" str)
| Tuple ts -> genTuple ts
| List xs -> genList xs
and genApplication (name : string) (argument : oak) : appendEvents =
- let short = !-name +> sepOpenT +> genOak argument +> sepCloseT in
+ let short = write name +> sepOpenT +> genOak argument +> sepCloseT in
let long =
- !-name +> sepOpenT
+ write name +> sepOpenT
+> (match argument with
| List _ | Record _ -> genOak argument
| _ -> indentAndNln (genOak argument) +> sepNln)
@@ -234,7 +234,7 @@ module CodePrinter = struct
let long = col genNamedField sepNln oaks in
expressionFitsOnRestOfLine short long
- and genIdent (ident : string) : appendEvents = !-ident
+ and genIdent (ident : string) : appendEvents = write ident
and genNamedField (field : namedField) : appendEvents =
let genValue =
@@ -242,9 +242,9 @@ module CodePrinter = struct
| Tuple _ -> sepOpenT +> genOak field.value +> sepCloseT
| _ -> genOak field.value
in
- let short = !-(field.name) +> sepEq +> genValue in
+ let short = write (field.name) +> sepEq +> genValue in
let long =
- !-(field.name) +> sepEq
+ write (field.name) +> sepEq
+>
match field.value with
| List _ | Record _ -> genOak field.value
From abc13c9f94ddbfed609a9c874286de7eba991f79 Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Wed, 16 Oct 2024 12:12:25 +0200
Subject: [PATCH 21/24] Remove printer_sandbox
---
tools/src/printer_sandbox.ml | 41 ------------------------------------
1 file changed, 41 deletions(-)
delete mode 100644 tools/src/printer_sandbox.ml
diff --git a/tools/src/printer_sandbox.ml b/tools/src/printer_sandbox.ml
deleted file mode 100644
index 7fd1b035f..000000000
--- a/tools/src/printer_sandbox.ml
+++ /dev/null
@@ -1,41 +0,0 @@
-(*
-#use "prettier_printer.ml";;
-
- Interpret using ocaml ./tools/src/printer_sandbox.ml
-
-
-open DSL
-
-let oak =
- Record
- [
- {
- name = "hello";
- value =
- Record
- [
- {name = "foo"; value = Ident "baaaaaaaaaaaaaaaaar"};
- {name = "member"; value = Ident "baazaaaaaaar"};
- ];
- };
- {
- name = "roxas";
- value =
- List
- [
- Ident "jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjj";
- Ident "meeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee";
- Record
- [
- {name = "foo"; value = Ident "baaaaaaaaaaaaaaaaar"};
- {name = "member"; value = Ident "bazaaaaaaaaar"};
- ];
- ];
- };
- {name = "foo"; value = Ident "baaaaaaaaaaaaaaaaar"};
- ]
-
-let _ =
- CodePrinter.genOak oak {CodePrinter.emptyContext with max_line_length = 20}
- |> CodePrinter.dump |> Format.printf "%s\n"
-*)
\ No newline at end of file
From a37f17f9bb51b763e53bedf5d958ea3c55d17bb8 Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Wed, 16 Oct 2024 12:16:29 +0200
Subject: [PATCH 22/24] Inline isFunction check
---
tools/src/tools.ml | 6 +-----
1 file changed, 1 insertion(+), 5 deletions(-)
diff --git a/tools/src/tools.ml b/tools/src/tools.ml
index a2134602f..d24be8387 100644
--- a/tools/src/tools.ml
+++ b/tools/src/tools.ml
@@ -361,15 +361,11 @@ let splitLast l =
in
splitLast' [] l
-let isFunction = function
- | Path.Pident {name = "function$"} -> true
- | _ -> false
-
let valueDetail (typ : Types.type_expr) =
let rec collectSignatureTypes (typ_desc : Types.type_desc) =
match typ_desc with
| Tlink t -> collectSignatureTypes t.desc
- | Tconstr (path, [t; _], _) when isFunction path ->
+ | Tconstr (Path.Pident {name = "function$"}, [t; _], _) ->
collectSignatureTypes t.desc
| Tconstr (path, ts, _) -> (
let p = Print_tast.Transform.path_to_string path in
From 09088d6e268e1c983607ca8f0e85450cc9bb6e3c Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Wed, 16 Oct 2024 12:18:54 +0200
Subject: [PATCH 23/24] Update help
---
tools/bin/main.ml | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/tools/bin/main.ml b/tools/bin/main.ml
index 633b0b61b..61d0ba764 100644
--- a/tools/bin/main.ml
+++ b/tools/bin/main.ml
@@ -14,7 +14,8 @@ Usage: rescript-tools [command]
Commands:
-doc Generate documentation
+doc <file> Generate documentation
+dump <file> Dump the TAST of a file
reanalyze Reanalyze
-v, --version Print version
-h, --help Print help|}
From 339eb3a009f91e1243ee47372509e02ab879bcc3 Mon Sep 17 00:00:00 2001
From: nojaf <florian.verdonck@outlook.com>
Date: Thu, 17 Oct 2024 09:27:54 +0200
Subject: [PATCH 24/24] Refactor infix operator
---
tools/src/prettier_printer.ml | 82 +++++++++++++++++++++++------------
1 file changed, 54 insertions(+), 28 deletions(-)
diff --git a/tools/src/prettier_printer.ml b/tools/src/prettier_printer.ml
index 118024c54..a19abe784 100644
--- a/tools/src/prettier_printer.ml
+++ b/tools/src/prettier_printer.ml
@@ -120,12 +120,21 @@ module CodePrinter = struct
|> updateMode false
(** compose two context transforming functions *)
- let ( +> ) f g ctx =
+ let compose_aux f g ctx =
let fCtx = f ctx in
match fCtx.mode with
| ConfirmedMultiline -> fCtx
| _ -> g fCtx
+ let compose (fs : appendEvents list) ctx =
+ let rec visit fs =
+ match fs with
+ | [] -> id
+ | [f] -> f
+ | f :: g :: rest -> visit (compose_aux f g :: rest)
+ in
+ visit fs ctx
+
let sepNln ctx =
{
ctx with
@@ -145,7 +154,7 @@ module CodePrinter = struct
let sepOpenL ctx = write "[" ctx
let sepCloseL ctx = write "]" ctx
let sepEq ctx = write " = " ctx
- let wrapInParentheses f = sepOpenT +> f +> sepCloseT
+ let wrapInParentheses f = compose [sepOpenT; f; sepCloseT]
let indent ctx =
let nextIdent = ctx.current_indent + ctx.indent_size in
{
@@ -163,7 +172,7 @@ module CodePrinter = struct
events = UnindentBy ctx.indent_size :: ctx.events;
}
- let indentAndNln f = indent +> sepNln +> f +> unindent
+ let indentAndNln f = compose [indent; sepNln; f; unindent]
let col (f : 't -> appendEvents) (intertwine : appendEvents) items ctx =
let rec visit items ctx =
@@ -171,7 +180,7 @@ module CodePrinter = struct
| [] -> ctx
| [item] -> f item ctx
| item :: rest ->
- let ctx' = (f item +> intertwine) ctx in
+ let ctx' = compose [f item; intertwine] ctx in
visit rest ctx'
in
visit items ctx
@@ -203,29 +212,42 @@ module CodePrinter = struct
| List xs -> genList xs
and genApplication (name : string) (argument : oak) : appendEvents =
- let short = write name +> sepOpenT +> genOak argument +> sepCloseT in
+ let short = compose [write name; sepOpenT; genOak argument; sepCloseT] in
let long =
- write name +> sepOpenT
- +> (match argument with
- | List _ | Record _ -> genOak argument
- | _ -> indentAndNln (genOak argument) +> sepNln)
- +> sepCloseT
+ compose
+ [
+ write name;
+ sepOpenT;
+ (match argument with
+ | List _ | Record _ -> genOak argument
+ | _ -> compose [indentAndNln (genOak argument); sepNln]);
+ sepCloseT;
+ ]
in
expressionFitsOnRestOfLine short long
and genRecord (recordFields : namedField list) : appendEvents =
let short =
match recordFields with
- | [] -> sepOpenR +> sepCloseR
+ | [] -> compose [sepOpenR; sepCloseR]
| fields ->
- sepOpenR +> sepSpace
- +> col genNamedField sepSemi fields
- +> sepSpace +> sepCloseR
+ compose
+ [
+ sepOpenR;
+ sepSpace;
+ col genNamedField sepSemi fields;
+ sepSpace;
+ sepCloseR;
+ ]
in
let long =
- sepOpenR
- +> indentAndNln (col genNamedField sepNln recordFields)
- +> sepNln +> sepCloseR
+ compose
+ [
+ sepOpenR;
+ indentAndNln (col genNamedField sepNln recordFields);
+ sepNln;
+ sepCloseR;
+ ]
in
expressionFitsOnRestOfLine short long
@@ -239,16 +261,19 @@ module CodePrinter = struct
and genNamedField (field : namedField) : appendEvents =
let genValue =
match field.value with
- | Tuple _ -> sepOpenT +> genOak field.value +> sepCloseT
+ | Tuple _ -> compose [sepOpenT; genOak field.value; sepCloseT]
| _ -> genOak field.value
in
- let short = write (field.name) +> sepEq +> genValue in
+ let short = compose [write field.name; sepEq; genValue] in
let long =
- write (field.name) +> sepEq
- +>
- match field.value with
- | List _ | Record _ -> genOak field.value
- | _ -> indentAndNln genValue
+ compose
+ [
+ write field.name;
+ sepEq;
+ (match field.value with
+ | List _ | Record _ -> genOak field.value
+ | _ -> indentAndNln genValue);
+ ]
in
expressionFitsOnRestOfLine short long
@@ -259,13 +284,14 @@ module CodePrinter = struct
in
let short =
match items with
- | [] -> sepOpenL +> sepCloseL
+ | [] -> compose [sepOpenL; sepCloseL]
| _ ->
- sepOpenL +> sepSpace +> col genItem sepSemi items +> sepSpace
- +> sepCloseL
+ compose
+ [sepOpenL; sepSpace; col genItem sepSemi items; sepSpace; sepCloseL]
in
let long =
- sepOpenL +> indentAndNln (col genItem sepNln items) +> sepNln +> sepCloseL
+ compose
+ [sepOpenL; indentAndNln (col genItem sepNln items); sepNln; sepCloseL]
in
expressionFitsOnRestOfLine short long
end