Add pretty printers to Findlib.Conf.t
This commit is contained in:
parent
ec3a3bf673
commit
5f237e3a4d
|
@ -11,6 +11,14 @@ module Rule = struct
|
|||
; value : string
|
||||
}
|
||||
|
||||
let pp fmt { preds_required; preds_forbidden; value } =
|
||||
Fmt.record fmt
|
||||
[ "preds_required", Fmt.const Ps.pp preds_required
|
||||
; "preds_forbidden", Fmt.const Ps.pp preds_forbidden
|
||||
; "value", Fmt.const (fun fmt -> Format.fprintf fmt "%S") value
|
||||
]
|
||||
|
||||
|
||||
let formal_predicates_count t =
|
||||
Ps.cardinal t.preds_required + Ps.cardinal t.preds_forbidden
|
||||
|
||||
|
@ -45,6 +53,12 @@ module Rules = struct
|
|||
; add_rules : Rule.t list
|
||||
}
|
||||
|
||||
let pp fmt { set_rules; add_rules } =
|
||||
Fmt.record fmt
|
||||
[ "set_rules", (fun fmt () -> Fmt.ocaml_list Rule.pp fmt set_rules)
|
||||
; "add_rules", (fun fmt () -> Fmt.ocaml_list Rule.pp fmt add_rules)
|
||||
]
|
||||
|
||||
let interpret t ~preds =
|
||||
let rec find_set_rule = function
|
||||
| [] -> None
|
||||
|
@ -92,6 +106,15 @@ module Config = struct
|
|||
; preds : Ps.t
|
||||
}
|
||||
|
||||
let pp fmt { vars; preds } =
|
||||
Fmt.record fmt
|
||||
[ "vars"
|
||||
, Fmt.const (Fmt.ocaml_list (Fmt.tuple Format.pp_print_string Rules.pp))
|
||||
(String.Map.to_list vars)
|
||||
; "preds"
|
||||
, Fmt.const Ps.pp preds
|
||||
]
|
||||
|
||||
let load path ~toolchain ~context =
|
||||
let path = Path.extend_basename path ~suffix:".d" in
|
||||
let conf_file = Path.relative path (toolchain ^ ".conf") in
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
(** Findlib database *)
|
||||
|
||||
open Stdune
|
||||
open Import
|
||||
|
||||
(** Findlib database *)
|
||||
type t
|
||||
|
@ -60,6 +60,9 @@ val dummy_package : t -> name:string -> Package.t
|
|||
|
||||
module Config : sig
|
||||
type t
|
||||
|
||||
val pp : t Fmt.t
|
||||
|
||||
val load : Path.t -> toolchain:string -> context:string -> t
|
||||
val get : t -> string -> string option
|
||||
|
||||
|
|
|
@ -150,6 +150,9 @@ module Fmt = struct
|
|||
let pp_sep fmt () = Format.fprintf fmt "@,; " in
|
||||
Format.fprintf fmt "@[<hv>{ %a@ }@]"
|
||||
(Format.pp_print_list ~pp_sep pp) xs
|
||||
|
||||
let tuple ppfa ppfb fmt (a, b) =
|
||||
Format.fprintf fmt "@[<hv>(%a, %a)@]" ppfa a ppfb b
|
||||
end
|
||||
|
||||
(* This is ugly *)
|
||||
|
|
|
@ -9,6 +9,8 @@ module type S = sig
|
|||
module Set : sig
|
||||
include Set.S with type elt = t
|
||||
val make : string list -> t
|
||||
|
||||
val pp : t Fmt.t
|
||||
end
|
||||
module Map : Map.S with type key = t
|
||||
module Table : sig
|
||||
|
@ -72,11 +74,15 @@ module Make() = struct
|
|||
|
||||
let to_string t = Table.get names t
|
||||
|
||||
let pp fmt t = Format.fprintf fmt "%S" (to_string t)
|
||||
|
||||
module Set = struct
|
||||
include Int_set
|
||||
|
||||
let make l =
|
||||
List.fold_left l ~init:empty ~f:(fun acc s -> add acc (make s))
|
||||
|
||||
let pp fmt (t : t) = Fmt.ocaml_list pp fmt (to_list t)
|
||||
end
|
||||
|
||||
module Map = Int_map
|
||||
|
|
|
@ -17,6 +17,8 @@ module type S = sig
|
|||
include Set.S with type elt = t
|
||||
|
||||
val make : string list -> t
|
||||
|
||||
val pp : t Fmt.t
|
||||
end
|
||||
|
||||
module Map : Map.S with type key = t
|
||||
|
|
Loading…
Reference in New Issue