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