diff --git a/lib/Styling.ml b/lib/Styling.ml index 4e5bf8f..ff10b95 100644 --- a/lib/Styling.ml +++ b/lib/Styling.ml @@ -34,6 +34,23 @@ let create { foreground; background; bold; dim; italic; underlined } ;; +let fg : [< Color.t ] -> t = fun foreground -> create ~foreground () +let bg : [< Color.t ] -> t = fun background -> create ~background () +let bold : t = { none with bold = true } +let dim : t = { none with dim = true } +let italic : t = { none with italic = true } +let underlined : t = { none with underlined = true } + +let ( & ) left right = + let foreground = Util.Option.last left.foreground right.foreground in + let background = Util.Option.last left.background right.background in + let bold = left.bold || right.bold in + let dim = left.dim || right.dim in + let italic = left.italic || right.italic in + let underlined = left.underlined || right.underlined in + { foreground; background; bold; dim; italic; underlined } +;; + let make_sgr_sequence (inner : string) : string = "\x1b[" ^ inner ^ "m" let add_color_to_buffer diff --git a/lib/Styling.mli b/lib/Styling.mli index 367d129..0f226f9 100644 --- a/lib/Styling.mli +++ b/lib/Styling.mli @@ -22,6 +22,44 @@ val create -> unit -> t +(** [fg color] is a convenient constructor for creating composable styles. +Creates a style with the specified foreground color only. See [&] for usage examples. *) +val fg : [< Color.t ] -> t + +(** [fg color] is a convenient constructor for creating composable styles. +Creates a style with the specified background color only. See [&] for usage +examples. *) +val bg : [< Color.t ] -> t + +(** [bold] is a convenient constructor for creating composable styles. +Creates a bold style only. See [&] for usage examples. *) +val bold : t + +(** [dim] is a convenient constructor for creating composable styles. +Creates a dim style only. See [&] for usage examples. *) +val dim : t + +(** [italic] is a convenient constructor for creating composable styles. +Creates an italic style only. See [&] for usage examples. *) +val italic : t + +(** [underlined] is a convenient constructor for creating composable styles. +Creates an underline style only. See [&] for usage examples. *) +val underlined : t + +(** [left & right] combines two styles with the following rules: + +- For colors, [right] is taken if it's present, otherwise [left] +- For boolean fields, the {b or} combination of both is applied + +Usage example: + +{[ + let my_style = Styling.(default_style & fg yellow & bg black & bold) in +]} +*) +val ( & ) : t -> t -> t + (** [to_ansi styling] renders the [styling] to an ANSI escape sequence as a string. *) val to_ansi : t -> string diff --git a/lib/Util.ml b/lib/Util.ml index 84a5a3d..0fd6421 100644 --- a/lib/Util.ml +++ b/lib/Util.ml @@ -77,7 +77,7 @@ module Triplet = struct | _, _, (Error _ as error) -> error ;; - (** [all_error triplet] returns a version of [triplet] wrapped in + (** [all_error triplet] returns a version of [triplet] wrapped in [result], which is of the [Error] variant if every member is also of the [Error] variant, otherwise it is whichever is the first [Ok]. *) @@ -94,7 +94,7 @@ module Triplet = struct (** [any_ok triplet] returns a version of [triplet] wrapped in [result], which is the first [Ok] encountered if there is any, otherwise it is the triplet wrapped in [Error]. - + It is the same as [all_error], but it is semantically useful to have it as a separate function. *) let any_ok = all_error @@ -116,3 +116,13 @@ module Triplet = struct map func func func ;; end + +module Option = struct + include Option + + let last left right = + match right with + | Some _ -> right + | None -> left + ;; +end