Move fmt to stdune
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
6b130e809c
commit
274bb70994
|
@ -96,62 +96,6 @@ module No_io = struct
|
|||
module Io = struct end
|
||||
end
|
||||
|
||||
module Fmt = struct
|
||||
(* CR-someday diml: we should define a GADT for this:
|
||||
|
||||
{[
|
||||
type 'a t =
|
||||
| Int : int t
|
||||
| Box : ...
|
||||
| Colored : ...
|
||||
]}
|
||||
|
||||
This way we could separate the creation of messages from the
|
||||
actual rendering.
|
||||
*)
|
||||
type 'a t = Format.formatter -> 'a -> unit
|
||||
|
||||
let kstrf f fmt =
|
||||
let buf = Buffer.create 17 in
|
||||
let f fmt = Format.pp_print_flush fmt () ; f (Buffer.contents buf) in
|
||||
Format.kfprintf f (Format.formatter_of_buffer buf) fmt
|
||||
|
||||
let failwith fmt = kstrf failwith fmt
|
||||
|
||||
let list = Format.pp_print_list
|
||||
let string s ppf = Format.pp_print_string ppf s
|
||||
|
||||
let nl = Format.pp_print_newline
|
||||
|
||||
let prefix f g ppf x = f ppf; g ppf x
|
||||
|
||||
let ocaml_list pp fmt = function
|
||||
| [] -> Format.pp_print_string fmt "[]"
|
||||
| l ->
|
||||
Format.fprintf fmt "@[<hv>[ %a@ ]@]"
|
||||
(list ~pp_sep:(fun fmt () -> Format.fprintf fmt "@,; ")
|
||||
pp) l
|
||||
|
||||
let quoted fmt = Format.fprintf fmt "%S"
|
||||
|
||||
let const
|
||||
: 'a t -> 'a -> unit t
|
||||
= fun pp a' fmt () -> pp fmt a'
|
||||
|
||||
let record fmt = function
|
||||
| [] -> Format.pp_print_string fmt "{}"
|
||||
| xs ->
|
||||
let pp fmt (field, pp) =
|
||||
Format.fprintf fmt "@[<hov 1>%s@ =@ %a@]"
|
||||
field pp () in
|
||||
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 *)
|
||||
let printer = ref (Printf.eprintf "%s%!")
|
||||
let print_to_console s = !printer s
|
||||
|
|
|
@ -0,0 +1,54 @@
|
|||
|
||||
(* CR-someday diml: we should define a GADT for this:
|
||||
|
||||
{[
|
||||
type 'a t =
|
||||
| Int : int t
|
||||
| Box : ...
|
||||
| Colored : ...
|
||||
]}
|
||||
|
||||
This way we could separate the creation of messages from the
|
||||
actual rendering.
|
||||
*)
|
||||
type 'a t = Format.formatter -> 'a -> unit
|
||||
|
||||
let kstrf f fmt =
|
||||
let buf = Buffer.create 17 in
|
||||
let f fmt = Format.pp_print_flush fmt () ; f (Buffer.contents buf) in
|
||||
Format.kfprintf f (Format.formatter_of_buffer buf) fmt
|
||||
|
||||
let failwith fmt = kstrf failwith fmt
|
||||
|
||||
let list = Format.pp_print_list
|
||||
let string s ppf = Format.pp_print_string ppf s
|
||||
|
||||
let nl = Format.pp_print_newline
|
||||
|
||||
let prefix f g ppf x = f ppf; g ppf x
|
||||
|
||||
let ocaml_list pp fmt = function
|
||||
| [] -> Format.pp_print_string fmt "[]"
|
||||
| l ->
|
||||
Format.fprintf fmt "@[<hv>[ %a@ ]@]"
|
||||
(list ~pp_sep:(fun fmt () -> Format.fprintf fmt "@,; ")
|
||||
pp) l
|
||||
|
||||
let quoted fmt = Format.fprintf fmt "%S"
|
||||
|
||||
let const
|
||||
: 'a t -> 'a -> unit t
|
||||
= fun pp a' fmt () -> pp fmt a'
|
||||
|
||||
let record fmt = function
|
||||
| [] -> Format.pp_print_string fmt "{}"
|
||||
| xs ->
|
||||
let pp fmt (field, pp) =
|
||||
Format.fprintf fmt "@[<hov 1>%s@ =@ %a@]"
|
||||
field pp () in
|
||||
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
|
|
@ -0,0 +1,24 @@
|
|||
type 'a t = Format.formatter -> 'a -> unit
|
||||
|
||||
val list : ?pp_sep:unit t -> 'a t -> 'a list t
|
||||
|
||||
val failwith : ('a, Format.formatter, unit, 'b) format4 -> 'a
|
||||
|
||||
val string : string -> Format.formatter -> unit
|
||||
|
||||
val prefix
|
||||
: (Format.formatter -> unit)
|
||||
-> (Format.formatter -> 'b -> 'c)
|
||||
-> (Format.formatter -> 'b -> 'c)
|
||||
|
||||
val ocaml_list : 'a t -> 'a list t
|
||||
|
||||
val quoted : string t
|
||||
|
||||
val const : 'a t -> 'a -> unit t
|
||||
|
||||
val record : (string * unit t) list t
|
||||
|
||||
val tuple : 'a t -> 'b t -> ('a * 'b) t
|
||||
|
||||
val nl : unit t
|
|
@ -20,6 +20,7 @@ module String = String
|
|||
module Char = Char
|
||||
module Sexp = Sexp
|
||||
module Path = Path
|
||||
module Fmt = Fmt
|
||||
|
||||
external reraise : exn -> _ = "%reraise"
|
||||
|
||||
|
|
Loading…
Reference in New Issue