Remove sexp and pretty printers in favor of to_dyn

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

src/blang.ml

@@ -15,6 +15,16 @@ module Op = struct
     | (Neq | Lt  | Lte) , Lt
     | (Neq | Gt  | Gte) , Gt -> true
     | _, _ -> false
+
+  let to_dyn =
+    let open Dyn.Encoder in
+    function
+    | Eq -> string "Eq"
+    | Gt -> string "Gt"
+    | Gte -> string "Gte"
+    | Lte -> string "Lte"
+    | Lt -> string "Lt"
+    | Neq -> string "Neq"
 end
 
 type t =
@@ -43,3 +53,23 @@ let rec eval t ~dir ~f =
     let x = String_with_vars.expand x ~mode:Many ~dir ~f
     and y = String_with_vars.expand y ~mode:Many ~dir ~f in
     Op.eval op (Value.L.compare_vals ~dir x y)
+
+include (
+  Dyn.Make(struct
+    type nonrec t = t
+
+    let rec to_dyn =
+      let open Dyn.Encoder in
+      function
+      | Const b -> constr "Const" [bool b]
+      | Expr e -> constr "Expr" [via_sexp String_with_vars.to_sexp e]
+      | And t -> constr "And" (List.map ~f:to_dyn t)
+      | Or t -> constr "Or" (List.map ~f:to_dyn t)
+      | Compare (o, s1, s2) ->
+        constr "Compare"
+          [ Op.to_dyn o
+          ; via_sexp String_with_vars.to_sexp s1
+          ; via_sexp String_with_vars.to_sexp s2
+          ]
+  end)
+)

src/blang.mli

@@ -24,3 +24,5 @@ val eval
   -> dir:Path.t
   -> f:Value.t list option  String_with_vars.expander
   -> bool
+
+include Dyn.S with type t := t

src/dune_project.ml

@@ -13,14 +13,13 @@ module Name : sig
     | Named     of string
     | Anonymous of Path.t
 
-  val pp : t Fmt.t
+  include Dyn.S with type t := t
 
   val compare : t -> t -> Ordering.t
 
   val to_string_hum : t -> string
 
   val decode : t Dune_lang.Decoder.t
-  val to_sexp : t Sexp.Encoder.t
 
   val to_encoded_string : t -> string
   val of_encoded_string : string -> t
@@ -55,23 +54,19 @@ end = struct
 
   let anonymous_root = Anonymous Path.root
 
-  let pp fmt = function
-    | Named n ->
-      Format.fprintf fmt "Named %S" n
-    | Anonymous p ->
-      Format.fprintf fmt "Anonymous %s" (Path.to_string_maybe_quoted p)
+  include Dyn.Make (struct
+      type nonrec t = t
+      let to_dyn =
+        let open Dyn.Encoder in
+        function
+        | Named n -> constr "Named" [string n]
+        | Anonymous p -> constr "Anonymous" [Path.to_dyn p]
+    end)
 
   let to_string_hum = function
     | Named     s -> s
     | Anonymous p -> sprintf "<anonymous %s>" (Path.to_string_maybe_quoted p)
 
-  let to_sexp = function
-    | Named s -> Sexp.Encoder.string s
-    | Anonymous p ->
-      List [ Atom "anonymous"
-           ; Path.to_sexp p
-           ]
-
   let validate name =
     let len = String.length name in
     len > 0 &&
@@ -139,36 +134,40 @@ module Project_file = struct
     ; project_name   : Name.t
     }
 
-  let pp fmt { file ; exists; project_name } =
-    Fmt.record fmt
-      [ "file", Fmt.const Path.pp file
-      ; "exists", Fmt.const Format.pp_print_bool exists
-      ; "project_name", (fun fmt () -> Name.pp fmt project_name)
-      ]
-
-  let to_sexp { file; exists; project_name } =
-    let open Sexp.Encoder  in
-    record
-      [ "file", Path.to_sexp file
-      ; "exists", bool exists
-      ; "project_name", Name.to_sexp project_name
-      ]
+  include(
+    Dyn.Make(struct
+      type nonrec t = t
+      let to_dyn { file; exists; project_name } =
+        let open Dyn.Encoder  in
+        record
+          [ "file", Path.to_dyn file
+          ; "exists", bool exists
+          ; "project_name", Name.to_dyn project_name
+          ]
+    end))
 end
 
 module Source_kind = struct
   type t =
     | Github of string * string
     | Url of string
 
+  include Dyn.Make(struct
+      type nonrec t = t
+      let to_dyn =
+        let open Dyn.Encoder in
+        function
+        | Github (user,repo) ->
+          constr "Github" [string user; string repo]
+        | Url url ->
+          constr "Url" [string url]
+    end)
+
   let pp fmt = function
     | Github (user,repo) ->
       Format.fprintf fmt "git+https://github.com/%s/%s.git" user repo
     | Url u -> Format.pp_print_string fmt u
 
-  let to_sexp = function
-    | Github (user,repo) -> Sexp.(List [Atom "github"; Atom user; Atom repo])
-    | Url url -> Sexp.(List [Atom "url"; Atom url])
-
   let decode =
     let open Stanza.Decoder in
     sum
@@ -183,8 +182,6 @@ end
 
 module Opam = struct
 
-  let pp_constr fmt _ = Format.fprintf fmt "<constraint>"
-
   let decode_constraint = Blang_decode.decode
 
   module Package = struct
@@ -208,13 +205,18 @@ module Opam = struct
                              (repeat decode_constraint) in
         { name; synopsis; description; constraints })
 
-    let pp fmt { name; synopsis; constraints; description } =
-      Fmt.record fmt
-        [ "name", Fmt.const Package.Name.pp name
-        ; "synopsis", Fmt.const Format.pp_print_string synopsis
-        ; "description", Fmt.const Format.pp_print_string description
-        ; "constraints", Fmt.(const (list pp_constr) constraints)
-        ]
+    include (
+      Dyn.Make(struct
+        type nonrec t = t
+        let to_dyn { name; synopsis; constraints; description } =
+          let open Dyn.Encoder in
+          record
+            [ "name", Package.Name.to_dyn name
+            ; "synopsis", string synopsis
+            ; "description", string description
+            ; "constraints", list Blang.to_dyn constraints
+            ]
+      end))
   end
 
   type t =
@@ -223,20 +225,16 @@ module Opam = struct
     ; packages: Package.t list
     }
 
-  let pp fmt { tags; constraints; packages } =
-    Fmt.record fmt
-      [ "tags", Fmt.(const (list Format.pp_print_string) tags)
-      ; "constraints", Fmt.(const (list pp_constr) constraints)
-      ; "packages", Fmt.(const (list Package.pp) packages)
-      ]
-
-  let to_sexp { tags; constraints = _ ; packages = _ } =
-    let open Sexp.Encoder in
-    record
-      [ "tags", list string tags
-      ; "constraints", list string ["TODO"]
-      ; "packages", list string ["TODO"]
-      ]
+  include Dyn.Make (struct
+      type nonrec t = t
+      let to_dyn { tags; constraints ; packages } =
+        let open Dyn.Encoder in
+        record
+          [ "tags", list string tags
+          ; "constraints", list Blang.to_dyn constraints
+          ; "packages", list Package.to_dyn packages
+          ]
+    end)
 
   let decode =
     let open Stanza.Decoder in
@@ -292,32 +290,35 @@ let implicit_transitive_deps t = t.implicit_transitive_deps
 let allow_approx_merlin t = t.allow_approx_merlin
 let gen_opam_file t = t.gen_opam_file
 
-let pp fmt { name ; root ; version ; source; license; authors
-           ; opam; project_file ; parsing_context = _
-           ; extension_args = _; stanza_parser = _ ; packages
-           ; implicit_transitive_deps ; dune_version
-           ; allow_approx_merlin ; gen_opam_file} =
-  Fmt.record fmt
-    [ "name", Fmt.const Name.pp name
-    ; "root", Fmt.const Path.Local.pp root
-    ; "version", Fmt.const (Fmt.optional Format.pp_print_string) version
-    ; "source", Fmt.const (Fmt.optional Source_kind.pp) source
-    ; "license", Fmt.const (Fmt.optional Format.pp_print_string) license
-    ; "authors", Fmt.const (Fmt.list Format.pp_print_string) authors
-    ; "opam", Fmt.const (Fmt.optional Opam.pp) opam
-    ; "project_file", Fmt.const Project_file.pp project_file
-    ; "packages",
-      Fmt.const
-        (Fmt.ocaml_list (Fmt.tuple Package.Name.pp Package.pp))
-        (Package.Name.Map.to_list packages)
-    ; "implicit_transitive_deps",
-      Fmt.const Format.pp_print_bool implicit_transitive_deps
-    ; "dune_version", Fmt.const Syntax.Version.pp dune_version
-    ; "allow_approx_merlin"
-    , Fmt.const Format.pp_print_bool allow_approx_merlin
-    ; "gen_opam_file"
-    , Fmt.const Format.pp_print_bool gen_opam_file
-    ]
+include (Dyn.Make(
+struct
+  type nonrec t = t
+  let to_dyn
+        { name ; root ; version ; source; license; authors
+        ; opam; project_file ; parsing_context = _
+        ; extension_args = _; stanza_parser = _ ; packages
+        ; implicit_transitive_deps ; dune_version
+        ; allow_approx_merlin ; gen_opam_file } =
+    let open Dyn.Encoder in
+    record
+      [ "name", Name.to_dyn name
+      ; "root", via_sexp Path.Local.to_sexp root
+      ; "version", (option string) version
+      ; "source", (option Source_kind.to_dyn) source
+      ; "license", (option string) license
+      ; "authors", (list string) authors
+      ; "opam", (option Opam.to_dyn) opam
+      ; "project_file", Project_file.to_dyn project_file
+      ; "packages",
+        (list (pair Package.Name.to_dyn Package.to_dyn))
+          (Package.Name.Map.to_list packages)
+      ; "implicit_transitive_deps",
+        bool implicit_transitive_deps
+      ; "dune_version", Syntax.Version.to_dyn dune_version
+      ; "allow_approx_merlin", bool allow_approx_merlin
+      ; "gen_opam_file", bool gen_opam_file
+      ]
+end))
 
 let find_extension_args t key =
   Univ_map.find t.extension_args key

src/dune_project.mli

@@ -18,13 +18,13 @@ module Name : sig
     | Named     of string
     | Anonymous of Path.t
 
+  include Dyn.S with type t := t
+
   val compare : t -> t -> Ordering.t
 
   (** Convert to a string that is suitable for human readable messages *)
   val to_string_hum : t -> string
 
-  val to_sexp : t Sexp.Encoder.t
-
   (** Convert to/from an encoded string that is suitable to use in filenames *)
   val to_encoded_string : t -> string
   val of_encoded_string : string -> t
@@ -36,14 +36,15 @@ end
 
 module Project_file : sig
   type t
+  include Dyn.S with type t := t
 end
 
 module Source_kind : sig
   type t =
     | Github of string * string
     | Url of string
 
-  val pp : t Fmt.t
+  include Dyn.S with type t := t
 end
 
 module Opam : sig
@@ -54,6 +55,7 @@ module Opam : sig
       ; description: string
       ; constraints: Blang.t list
       }
+    include Dyn.S with type t := t
   end
 
   type t = private
@@ -64,11 +66,15 @@ module Opam : sig
 
   type package_name
 
+  include Dyn.S with type t := t
+
   val find : t -> package_name -> Package.t option
 end with type package_name := Package.Name.t
 
 type t
 
+include Dyn.S with type t := t
+
 val packages : t -> Package.t Package.Name.Map.t
 val version : t -> string option
 val name : t -> Name.t
@@ -167,5 +173,3 @@ val set_parsing_context : t -> 'a Dune_lang.Decoder.t -> 'a Dune_lang.Decoder.t
 val implicit_transitive_deps : t -> bool
 
 val dune_version : t -> Syntax.Version.t
-
-val pp : t Fmt.t

src/stdune/dyn.ml

@@ -126,3 +126,18 @@ module Encoder = struct
 end
 
 let opaque = String "<opaque>"
+
+type dyn = t
+
+module type S = sig
+  type t
+  val to_dyn : t -> dyn
+  val pp : Format.formatter -> t -> unit
+  val to_sexp : t -> Sexp0.t
+end
+
+module Make (S : sig type t val to_dyn : t -> dyn end) = struct
+  include S
+  let pp fmt t = pp fmt (to_dyn t)
+  let to_sexp t = to_sexp (to_dyn t)
+end

src/stdune/dyn.mli

@@ -48,3 +48,14 @@ val pp : Format.formatter -> t -> unit
 val opaque : t
 
 val to_sexp : t Sexp.Encoder.t
+
+type dyn = t
+
+module type S = sig
+  type t
+  val to_dyn : t -> dyn
+  val pp : Format.formatter -> t -> unit
+  val to_sexp : t -> Sexp0.t
+end
+
+module Make (D : sig type t val to_dyn : t -> dyn end) : S with type t := D.t

src/syntax.ml

@@ -23,6 +23,10 @@ module Version = struct
 
   let to_sexp t = Sexp.Atom (to_string t)
 
+  let to_dyn t =
+    let open Dyn.Encoder in
+    pair int int t
+
   let hash = Hashtbl.hash
 
   let encode t = Dune_lang.Encoder.string (to_string t)