Skip to content

feat(stdune): add tuple-free record codecs to Conv #16396

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
rgrinberg wants to merge 1 commit into
base: main
Choose a base branch
from
+759 −153
Open

feat(stdune): add tuple-free record codecs to Conv #16396

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
53 changes: 30 additions & 23 deletions otherlibs/dune-rpc/diagnostics_v1.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,11 +9,12 @@ module Related = struct

let sexp =
let open Conv in
let loc = field "loc" (required Loc.sexp) in
let message = field "message" (required sexp_pp_unit) in
let to_ (loc, message) = { loc; message } in
let from { loc; message } = loc, message in
iso (record (both loc message)) to_ from
record
(Record.make (fun loc message -> { loc; message })
|> Record.field "loc" (required Loc.sexp) ~get:(fun { loc; _ } -> loc)
|> Record.field "message" (required sexp_pp_unit) ~get:(fun { message; _ } ->
message)
|> Record.finish)
;;

let to_diagnostic_related t : Diagnostic.Related.t =
Expand Down Expand Up @@ -45,24 +46,30 @@ let sexp_severity =

let sexp =
let open Conv in
let from { targets; message; loc; severity; promotion; directory; id; related } =
targets, message, loc, severity, promotion, directory, id, related
in
let to_ (targets, message, loc, severity, promotion, directory, id, related) =
{ targets; message; loc; severity; promotion; directory; id; related }
in
let loc = field "loc" (optional Loc.sexp) in
let message = field "message" (required sexp_pp_unit) in
let targets = field "targets" (required (list Target.sexp)) in
let severity = field "severity" (optional sexp_severity) in
let directory = field "directory" (optional string) in
let promotion = field "promotion" (required (list Diagnostic.Promotion.sexp)) in
let id = field "id" (required Diagnostic.Id.sexp) in
let related = field "related" (required (list Related.sexp)) in
iso
(record (eight targets message loc severity promotion directory id related))
to_
from
record
(Record.make (fun targets message loc severity promotion directory id related ->
{ targets; message; loc; severity; promotion; directory; id; related })
|> Record.field
"targets"
(required (list Target.sexp))
~get:(fun { targets; _ } -> targets)
|> Record.field "message" (required sexp_pp_unit) ~get:(fun { message; _ } ->
message)
|> Record.field "loc" (optional Loc.sexp) ~get:(fun { loc; _ } -> loc)
|> Record.field "severity" (optional sexp_severity) ~get:(fun { severity; _ } ->
severity)
|> Record.field
"promotion"
(required (list Diagnostic.Promotion.sexp))
~get:(fun { promotion; _ } -> promotion)
|> Record.field "directory" (optional string) ~get:(fun { directory; _ } ->
directory)
|> Record.field "id" (required Diagnostic.Id.sexp) ~get:(fun { id; _ } -> id)
|> Record.field
"related"
(required (list Related.sexp))
~get:(fun { related; _ } -> related)
|> Record.finish)
;;

let to_diagnostic t : Diagnostic.t =
Expand Down
126 changes: 65 additions & 61 deletions otherlibs/dune-rpc/exported_types.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,26 +11,27 @@ module Loc = struct

let pos_sexp =
let open Conv in
let to_ (pos_fname, pos_lnum, pos_bol, pos_cnum) =
{ Lexing.pos_fname; pos_lnum; pos_bol; pos_cnum }
in
let from { Lexing.pos_fname; pos_lnum; pos_bol; pos_cnum } =
pos_fname, pos_lnum, pos_bol, pos_cnum
in
let pos_fname = field "pos_fname" (required string) in
let pos_lnum = field "pos_lnum" (required int) in
let pos_bol = field "pos_bol" (required int) in
let pos_cnum = field "pos_cnum" (required int) in
iso (record (four pos_fname pos_lnum pos_bol pos_cnum)) to_ from
record
(Record.make (fun pos_fname pos_lnum pos_bol pos_cnum ->
{ Lexing.pos_fname; pos_lnum; pos_bol; pos_cnum })
|> Record.field "pos_fname" (required string) ~get:(fun { Lexing.pos_fname; _ } ->
pos_fname)
|> Record.field "pos_lnum" (required int) ~get:(fun { Lexing.pos_lnum; _ } ->
pos_lnum)
|> Record.field "pos_bol" (required int) ~get:(fun { Lexing.pos_bol; _ } ->
pos_bol)
|> Record.field "pos_cnum" (required int) ~get:(fun { Lexing.pos_cnum; _ } ->
pos_cnum)
|> Record.finish)
;;

let sexp =
let open Conv in
let to_ (start, stop) = { start; stop } in
let from { start; stop } = start, stop in
let start = field "start" (required pos_sexp) in
let stop = field "stop" (required pos_sexp) in
iso (record (both start stop)) to_ from
record
(Record.make (fun start stop -> { start; stop })
|> Record.field "start" (required pos_sexp) ~get:start
|> Record.field "stop" (required pos_sexp) ~get:stop
|> Record.finish)
;;
end

Expand Down Expand Up @@ -462,11 +463,11 @@ module Diagnostic = struct

let sexp =
let open Conv in
let from { in_build; in_source } = in_build, in_source in
let to_ (in_build, in_source) = { in_build; in_source } in
let in_build = field "in_build" (required string) in
let in_source = field "in_source" (required string) in
iso (record (both in_build in_source)) to_ from
record
(Record.make (fun in_build in_source -> { in_build; in_source })
|> Record.field "in_build" (required string) ~get:in_build
|> Record.field "in_source" (required string) ~get:in_source
|> Record.finish)
;;
end

Expand All @@ -491,11 +492,14 @@ module Diagnostic = struct

let sexp =
let open Conv in
let loc = field "loc" (required Loc.sexp) in
let message = field "message" (required (Pp.sexp User_message.Style.sexp)) in
let to_ (loc, message) = { loc; message } in
let from { loc; message } = loc, message in
iso (record (both loc message)) to_ from
record
(Record.make (fun loc message -> { loc; message })
|> Record.field "loc" (required Loc.sexp) ~get:loc
|> Record.field
"message"
(required (Pp.sexp User_message.Style.sexp))
~get:message_with_style
|> Record.finish)
;;
end

Expand Down Expand Up @@ -532,24 +536,21 @@ module Diagnostic = struct

let sexp =
let open Conv in
let from { targets; message; loc; severity; promotion; directory; id; related } =
targets, message, loc, severity, promotion, directory, id, related
in
let to_ (targets, message, loc, severity, promotion, directory, id, related) =
{ targets; message; loc; severity; promotion; directory; id; related }
in
let loc = field "loc" (optional Loc.sexp) in
let message = field "message" (required (Pp.sexp User_message.Style.sexp)) in
let targets = field "targets" (required (list Target.sexp)) in
let severity = field "severity" (optional sexp_severity) in
let directory = field "directory" (optional string) in
let promotion = field "promotion" (required (list Promotion.sexp)) in
let id = field "id" (required Id.sexp) in
let related = field "related" (required (list Related.sexp)) in
iso
(record (eight targets message loc severity promotion directory id related))
to_
from
record
(Record.make (fun targets message loc severity promotion directory id related ->
{ targets; message; loc; severity; promotion; directory; id; related })
|> Record.field "targets" (required (list Target.sexp)) ~get:targets
|> Record.field
"message"
(required (Pp.sexp User_message.Style.sexp))
~get:message_with_style
|> Record.field "loc" (optional Loc.sexp) ~get:loc
|> Record.field "severity" (optional sexp_severity) ~get:severity
|> Record.field "promotion" (required (list Promotion.sexp)) ~get:promotion
|> Record.field "directory" (optional string) ~get:directory
|> Record.field "id" (required Id.sexp) ~get:id
|> Record.field "related" (required (list Related.sexp)) ~get:related
|> Record.finish)
;;

let to_dyn t = Sexp.to_dyn (Conv.to_sexp sexp t)
Expand Down Expand Up @@ -634,11 +635,11 @@ module Message = struct

let sexp =
let open Conv in
let from { payload; message } = payload, message in
let to_ (payload, message) = { payload; message } in
let payload = field "payload" (optional sexp) in
let message = field "message" (required string) in
iso (record (both payload message)) to_ from
record
(Record.make (fun payload message -> { payload; message })
|> Record.field "payload" (optional sexp) ~get:payload
|> Record.field "message" (required string) ~get:message
|> Record.finish)
;;

let to_sexp_unversioned = Conv.to_sexp sexp
Expand All @@ -661,13 +662,14 @@ module Job = struct

let sexp =
let open Conv in
let from { id; pid; description; started_at } = id, pid, description, started_at in
let to_ (id, pid, description, started_at) = { id; pid; description; started_at } in
let id = field "id" (required Id.sexp) in
let started_at = field "started_at" (required float) in
let pid = field "pid" (required int) in
let description = field "description" (required sexp_pp_unit) in
iso (record (four id pid description started_at)) to_ from
record
(Record.make (fun id pid description started_at ->
{ id; pid; description; started_at })
|> Record.field "id" (required Id.sexp) ~get:id
|> Record.field "pid" (required int) ~get:pid
|> Record.field "description" (required sexp_pp_unit) ~get:description
|> Record.field "started_at" (required float) ~get:started_at
|> Record.finish)
;;

module Event = struct
Expand Down Expand Up @@ -842,10 +844,12 @@ module Promote_targets = struct

let sexp =
let open Conv in
let files = field "files" (required Files_to_promote.sexp) in
let matching = field "matching" (required Matching.sexp) in
let to_ (files, matching) = { files; matching } in
let from { files; matching } = files, matching in
iso (record (both files matching)) to_ from
record
(Record.make (fun files matching -> { files; matching })
|> Record.field "files" (required Files_to_promote.sexp) ~get:(fun { files; _ } ->
files)
|> Record.field "matching" (required Matching.sexp) ~get:(fun { matching; _ } ->
matching)
|> Record.finish)
;;
end
20 changes: 12 additions & 8 deletions otherlibs/dune-rpc/procedures.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -87,11 +87,14 @@ module Public = struct
module V1 = struct
let req =
let open Conv in
let path = field "path" (required string) in
let contents = field "contents" (required string) in
let to_ (path, contents) = path, `Contents contents in
let from (path, `Contents contents) = path, contents in
iso (record (both path contents)) to_ from
record
(Record.make (fun path contents -> path, `Contents contents)
|> Record.field "path" (required string) ~get:fst
|> Record.field
"contents"
(required string)
~get:(fun (_, `Contents contents) -> contents)
|> Record.finish)
;;
end

Expand Down Expand Up @@ -179,9 +182,10 @@ module Public = struct

let conv =
let open Conv in
let to_ root = { root } in
let from { root } = root in
iso (record (field "root" (required string))) to_ from
record
(Record.make (fun root -> { root })
|> Record.field "root" (required string) ~get:(fun { root } -> root)
|> Record.finish)
;;
end

Expand Down
12 changes: 6 additions & 6 deletions otherlibs/dune-rpc/registry.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -47,12 +47,12 @@ module Dune = struct

let sexp : t Conv.value =
let open Conv in
let to_ (where, root, pid) = { where; root; pid } in
let from { where; root; pid } = where, root, pid in
let where = field "where" (required Where.sexp) in
let root = field "root" (required string) in
let pid = field "pid" (required Pid.conv) in
iso (record (three where root pid)) to_ from
record
(Record.make (fun where root pid -> { where; root; pid })
|> Record.field "where" (required Where.sexp) ~get:where
|> Record.field "root" (required string) ~get:root
|> Record.field "pid" (required Pid.conv) ~get:(fun { pid; _ } -> pid)
|> Record.finish)
;;

type error =
Expand Down
48 changes: 21 additions & 27 deletions otherlibs/dune-rpc/types.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -75,11 +75,11 @@ module Call = struct

let fields =
let open Conv in
let to_ (method_, params) = { method_; params } in
let from { method_; params } = method_, params in
let method_ = field "method" (required Method.Name.sexp) in
let params = field "params" (required sexp) in
iso (both method_ params) to_ from
Record.make (fun method_ params -> { method_; params })
|> Record.field "method" (required Method.Name.sexp) ~get:(fun { method_; _ } ->
method_)
|> Record.field "params" (required sexp) ~get:(fun { params; _ } -> params)
|> Record.finish
;;
end

Expand Down Expand Up @@ -131,19 +131,16 @@ module Response = struct

let sexp =
let open Conv in
let id = field "payload" (optional sexp) in
let message = field "message" (required string) in
let kind =
field
"kind"
(required
(enum [ "Invalid_request", Invalid_request; "Code_error", Code_error ]))
in
record
(iso
(three id message kind)
(fun (payload, message, kind) -> { payload; message; kind })
(fun { payload; message; kind } -> payload, message, kind))
(Record.make (fun payload message kind -> { payload; message; kind })
|> Record.field "payload" (optional sexp) ~get:payload
|> Record.field "message" (required string) ~get:message
|> Record.field
"kind"
(required
(enum [ "Invalid_request", Invalid_request; "Code_error", Code_error ]))
~get:kind
|> Record.finish)
;;

let to_dyn { payload; message; kind } =
Expand Down Expand Up @@ -214,16 +211,13 @@ module Initialize = struct

let sexp =
let open Conv in
let dune_version = field "dune_version" (required Version.sexp) in
let protocol_version = field "protocol_version" (required Protocol.sexp) in
let id = Id.required_field in
let to_ (dune_version, protocol_version, id) =
{ dune_version; protocol_version; id }
in
let from { dune_version; protocol_version; id } =
dune_version, protocol_version, id
in
record (iso (three dune_version protocol_version id) to_ from)
record
(Record.make (fun dune_version protocol_version id ->
{ dune_version; protocol_version; id })
|> Record.field "dune_version" (required Version.sexp) ~get:dune_version
|> Record.field "protocol_version" (required Protocol.sexp) ~get:protocol_version
|> Record.add Id.required_field ~get:id
|> Record.finish)
;;

let of_call { Call.method_; params } ~version =
Expand Down
Loading
Loading