Merge pull request #5 from chshersh/chshersh/luminance

[#3] Move to polymorphic variants and implement color suggestion based on luminance
- Move Ground.t to polymorphic variants
- Move Color.t to polymorphic variant
- Refine types of color-returning functions
- Calculate luminance

lib/Color.ml

@@ -12,8 +12,9 @@ module Ground = struct
       color is on the foreground or the background. *)
 
   type t =
-    | Foreground
-    | Background
+    [ `Foreground
+    | `Background
+    ]
 
   (** [to_int ?bright ground] produces the corresponding leading
       digit for an SGR escape sequence to be set as foreground
@@ -24,16 +25,13 @@ module Ground = struct
     possible as it makes it more obscure - constants are easier
     to reason about and less error prone. *)
     match ground, bright with
-    | Foreground, false -> 3
-    | Background, false -> 4
-    | Foreground, true -> 9
-    | Background, true -> 10
+    | `Foreground, false -> 3
+    | `Background, false -> 4
+    | `Foreground, true -> 9
+    | `Background, true -> 10
   ;;
 end
 
-let foreground = Ground.Foreground
-let background = Ground.Background
-
 module Minimal = struct
   (** [Minimal] encodes the 8 default ANSI colors. *)
 
@@ -62,113 +60,119 @@ module Minimal = struct
 end
 
 type t =
-  (* Minimal could also be a tuple, but I like the explicitness
+  [ (* Minimal could also be a tuple, but I like the explicitness
      of records. *)
-  | Minimal of
-      { color : Minimal.t
-      ; bright : bool
-      }
-  | Advanced of Int8.t
-  (* Here, I don't think a record is needed - the order of the
+    `Minimal of minimal
+  | `Advanced of Int8.t
+  | (* Here, I don't think a record is needed - the order of the
      channels are literally given out by the constructor's name. *)
-  | Rgb of Int8.t * Int8.t * Int8.t
+    `Rgb of Int8.t * Int8.t * Int8.t
+  ]
+
+and minimal =
+  { color : Minimal.t
+  ; bright : bool
+  }
 
 (* It's handy for the user to have module-level constants for
    each minimal color. *)
 
 (** Default black color. *)
-let black : t = Minimal { color = Minimal.Black; bright = false }
+let black : t = `Minimal { color = Minimal.Black; bright = false }
 
 (** Default red color. *)
-let red : t = Minimal { color = Minimal.Red; bright = false }
+let red : t = `Minimal { color = Minimal.Red; bright = false }
 
 (** Default green color. *)
-let green : t = Minimal { color = Minimal.Green; bright = false }
+let green : t = `Minimal { color = Minimal.Green; bright = false }
 
 (** Default yellow color. *)
-let yellow : t = Minimal { color = Minimal.Yellow; bright = false }
+let yellow : t = `Minimal { color = Minimal.Yellow; bright = false }
 
 (** Default blue color. *)
-let blue : t = Minimal { color = Minimal.Blue; bright = false }
+let blue : t = `Minimal { color = Minimal.Blue; bright = false }
 
 (** Default magenta color. *)
-let magenta : t = Minimal { color = Minimal.Magenta; bright = false }
+let magenta : t = `Minimal { color = Minimal.Magenta; bright = false }
 
 (** Default cyan color. *)
-let cyan : t = Minimal { color = Minimal.Cyan; bright = false }
+let cyan : t = `Minimal { color = Minimal.Cyan; bright = false }
 
 (** Default white color. *)
-let white : t = Minimal { color = Minimal.White; bright = false }
+let white : t = `Minimal { color = Minimal.White; bright = false }
 
 (** Default bright black (gray) color. *)
-let bright_black : t = Minimal { color = Minimal.Black; bright = true }
+let bright_black : t = `Minimal { color = Minimal.Black; bright = true }
 
 (** Default bright red color. *)
-let bright_red : t = Minimal { color = Minimal.Red; bright = true }
+let bright_red : t = `Minimal { color = Minimal.Red; bright = true }
 
 (** Default bright green color. *)
-let bright_green : t = Minimal { color = Minimal.Green; bright = true }
+let bright_green : t = `Minimal { color = Minimal.Green; bright = true }
 
 (** Default bright yellow color. *)
-let bright_yellow : t = Minimal { color = Minimal.Yellow; bright = true }
+let bright_yellow : t = `Minimal { color = Minimal.Yellow; bright = true }
 
 (** Default bright blue color. *)
-let bright_blue : t = Minimal { color = Minimal.Blue; bright = true }
+let bright_blue : t = `Minimal { color = Minimal.Blue; bright = true }
 
 (** Default bright magenta color. *)
-let bright_magenta : t = Minimal { color = Minimal.Magenta; bright = true }
+let bright_magenta : t = `Minimal { color = Minimal.Magenta; bright = true }
 
 (** Default bright cyan color. *)
-let bright_cyan : t = Minimal { color = Minimal.Cyan; bright = true }
+let bright_cyan : t = `Minimal { color = Minimal.Cyan; bright = true }
 
 (** Default bright white color. *)
-let bright_white : t = Minimal { color = Minimal.White; bright = true }
+let bright_white : t = `Minimal { color = Minimal.White; bright = true }
 
 (* It's also useful for the user to have module-level functions
    to easily create colors without knowing the intricacies and
    details of their implementation. *)
 
 (** [make_minimal ?bright value] creates a minimal color.
     If [value] is not a valid color code, it returns [None].
-    
+
     A valid color code is an integer i where 0 <= i <= 7. *)
-let make_minimal ?(bright : bool = false) : int -> t option = function
-  | 0 -> Some (Minimal { color = Minimal.Black; bright })
-  | 1 -> Some (Minimal { color = Minimal.Red; bright })
-  | 2 -> Some (Minimal { color = Minimal.Green; bright })
-  | 3 -> Some (Minimal { color = Minimal.Yellow; bright })
-  | 4 -> Some (Minimal { color = Minimal.Blue; bright })
-  | 5 -> Some (Minimal { color = Minimal.Magenta; bright })
-  | 6 -> Some (Minimal { color = Minimal.Cyan; bright })
-  | 7 -> Some (Minimal { color = Minimal.White; bright })
+let make_minimal ?(bright : bool = false) : int -> [ `Minimal of minimal ] option
+  = function
+  | 0 -> Some (`Minimal { color = Minimal.Black; bright })
+  | 1 -> Some (`Minimal { color = Minimal.Red; bright })
+  | 2 -> Some (`Minimal { color = Minimal.Green; bright })
+  | 3 -> Some (`Minimal { color = Minimal.Yellow; bright })
+  | 4 -> Some (`Minimal { color = Minimal.Blue; bright })
+  | 5 -> Some (`Minimal { color = Minimal.Magenta; bright })
+  | 6 -> Some (`Minimal { color = Minimal.Cyan; bright })
+  | 7 -> Some (`Minimal { color = Minimal.White; bright })
   | _ -> None
 ;;
 
 (** [make_minimal_exn ?bright value] creates a minimal color.
     If [value] is not a valid color code, it raises a [Failure]
     exception.
-    
+
     A valid color code is an integer i where 0 <= i <= 7. *)
-let make_minimal_exn ?(bright : bool = false) (value : int) : t =
+let make_minimal_exn ?(bright : bool = false) (value : int) : [ `Minimal of minimal ] =
   match make_minimal ~bright value with
   | None -> failwith "value must be an integer between 0 and 7 (both included)"
   | Some color -> color
 ;;
 
 (** [make_advanced value] creates an advanced color.
     If [value] is not a valid color code, it returns [None].
-    
+
     A valid color code is an integer i where 0 <= i < 256. *)
-let make_advanced (value : int) : t option =
-  Option.map (fun (value : Int8.t) -> Advanced value) (Int8.of_int value)
+let make_advanced (value : int) : [ `Advanced of Int8.t ] option =
+  Option.map (fun (value : Int8.t) -> `Advanced value) (Int8.of_int value)
 ;;
 
 (** [make_advanced_exn value] creates an advanced color.
     If [value] is not a valid color code, it raises a [Failure]
     exception.
-    
+
     A valid color code is an integer i where 0 <= i < 256. *)
-let make_advanced_exn (value : int) : t = Advanced (Int8.of_int_exn value)
+let make_advanced_exn (value : int) : [ `Advanced of Int8.t ] =
+  `Advanced (Int8.of_int_exn value)
+;;
 
 module Channel = struct
   (** Represents an RGB channel - either red, green, or blue. *)
@@ -194,7 +198,7 @@ module Channel = struct
 
   (** [to_int8 channel] tries to convert the [channel]'s value
       into a [Int8] value.
-      
+
       If it fails, it returns the channel data wrapped in the
       [Error] variant. This is because this function is often
       applied in batch to every channel of an RGB component, so
@@ -217,12 +221,14 @@ end
     If any of [red], [green] or [blue] is not a valid channel
     value, it returns an [Error] which indicates which channel
     had an invalid value.
-    
+
     A valid channel value is an integer i where 0 <= i < 256.
-    
+
     For the version that returns an [option] instead, see
     [make_rgb_opt]. *)
-let make_rgb (red : int) (green : int) (blue : int) : (t, Channel.t) result =
+let make_rgb (red : int) (green : int) (blue : int)
+  : ([ `Rgb of Int8.t * Int8.t * Int8.t ], Channel.t) result
+  =
   (* We convert each channel independently by mapping them to
   some specialized type so we can extract the information of
   what the first channel with an incorrect value was.
@@ -231,27 +237,31 @@ let make_rgb (red : int) (green : int) (blue : int) : (t, Channel.t) result =
   |> Triplet.map Channel.red Channel.green Channel.blue
   |> Triplet.map_uniform ~func:Channel.to_int8
   |> Triplet.all_ok
-  |> Result.map (fun (r, g, b) -> Rgb (r, g, b))
+  |> Result.map (fun (r, g, b) -> `Rgb (r, g, b))
 ;;
 
 (** [make_rgb_opt red green blue] creates an RGB color.
     If any of [red], [green] or [blue] is not a valid channel
     value, it returns [None].
-    
+
     A valid channel value is an integer i where 0 <= i < 256.
-    
+
     For the version that returns a result with the invalid
     channel data, see [make_rgb]. *)
-let make_rgb_opt (red : int) (green : int) (blue : int) : t option =
+let make_rgb_opt (red : int) (green : int) (blue : int)
+  : [ `Rgb of Int8.t * Int8.t * Int8.t ] option
+  =
   Result.to_option (make_rgb red green blue)
 ;;
 
 (** [make_rgb_exn red green blue] creates an RGB color.
     If any of [red], [green] or [blue] is not a valid channel
     value, it raises a [Failure] exception.
-    
+
     A valid channel value is an integer i where 0 <= i < 256. *)
-let make_rgb_exn (red : int) (green : int) (blue : int) : t =
+let make_rgb_exn (red : int) (green : int) (blue : int)
+  : [ `Rgb of Int8.t * Int8.t * Int8.t ]
+  =
   match make_rgb red green blue with
   | Ok color -> color
   | Error channel ->
@@ -265,14 +275,44 @@ let make_rgb_exn (red : int) (green : int) (blue : int) : t =
 (** [to_ansi color] produces an SGR escape portion that can be
     embedded in a string based on the [color]. *)
 let to_ansi ~(ground : Ground.t) : t -> string = function
-  | Minimal { color; bright } ->
+  | `Minimal { color; bright } ->
     Printf.sprintf "%d%d" (Ground.to_int ~bright ground) (Minimal.to_int color)
-  | Advanced color -> Printf.sprintf "%d8;5;%d" (Ground.to_int ground) (Int8.to_int color)
-  | Rgb (r, g, b) ->
+  | `Advanced color ->
+    Printf.sprintf "%d8;5;%d" (Ground.to_int ground) (Int8.to_int color)
+  | `Rgb (r, g, b) ->
     Printf.sprintf
       "%d8;2;%d;%d;%d"
       (Ground.to_int ground)
       (Int8.to_int r)
       (Int8.to_int g)
       (Int8.to_int b)
 ;;
+
+(** This function returns luminance of an RGB color in range between 0 and 255.
+
+See {!best_for_contrast} for a usage example. *)
+let luminance : [ `Rgb of Int8.t * Int8.t * Int8.t ] -> int = function
+  | `Rgb (r, g, b) ->
+    let r = Int8.to_int r in
+    let g = Int8.to_int g in
+    let b = Int8.to_int b in
+    ((2126 * r) + (7152 * g) + (722 * b)) / 10000
+;;
+
+(** [best_for_contrast ~threshold rgb] takes a color [rgb], [threshold] between
+0 and 255 (both inclusive) representing luminescence tolerance, and returns the
+suggested color theme for the opposite color to achieve the best contrast.
+
+For example, if [rgb] is a background colour, and [best_for_contrast] return
+[`Light], you should select a light foreground colour for the best readability.
+
+- {b NOTE}: Default [threshold] value is 128.
+- {b NOTE}: Higher [threshold] will suggest [`Light] more often and on brighter
+  colours. Lower [threshold] will suggest [`Light] for darker colours. The
+  opposite is true for [`Dark].
+*)
+let best_for_contrast ?(threshold = 128)
+  : [ `Rgb of Int8.t * Int8.t * Int8.t ] -> [ `Light | `Dark ]
+  =
+  fun rgb -> if luminance rgb < threshold then `Light else `Dark
+;;

lib/Styling.ml

@@ -20,15 +20,17 @@ let none : t =
 ;;
 
 let create
-      ?(foreground : Color.t option)
-      ?(background : Color.t option)
+      ?(foreground : [< Color.t ] option)
+      ?(background : [< Color.t ] option)
       ?(bold : bool = false)
       ?(dim : bool = false)
       ?(italic : bool = false)
       ?(underlined : bool = false)
       ()
   : t
   =
+  let foreground = (foreground :> Color.t option) in
+  let background = (background :> Color.t option) in
   { foreground; background; bold; dim; italic; underlined }
 ;;
 
@@ -53,8 +55,8 @@ let to_ansi : t -> string = function
     if dim then Buffer.add_string buffer (make_sgr_sequence "2");
     if italic then Buffer.add_string buffer (make_sgr_sequence "3");
     if underlined then Buffer.add_string buffer (make_sgr_sequence "4");
-    add_color_to_buffer buffer foreground ~ground:Color.foreground;
-    add_color_to_buffer buffer background ~ground:Color.background;
+    add_color_to_buffer buffer foreground ~ground:`Foreground;
+    add_color_to_buffer buffer background ~ground:`Background;
     Buffer.contents buffer
 ;;
 

lib/Styling.mli

@@ -13,8 +13,8 @@ val none : t
 (** [create ?foreground ?background ?bold ?dim ?italic ?underlined ()]
     creates a new style object given the provided configuration. *)
 val create
-  :  ?foreground:Color.t
-  -> ?background:Color.t
+  :  ?foreground:[< Color.t ]
+  -> ?background:[< Color.t ]
   -> ?bold:bool
   -> ?dim:bool
   -> ?italic:bool