Color conversion in ReasonML/Bucklescript

color.re

open Belt;

[@bs.val]
external unsafeParseInt: (string, int) => Js.Null.t(float) = "parseInt";

[@bs.val] [@bs.scope "Math"] external floor: float => int = "floor";

type result('a, 'b) =
  | Ok('a)
  | Error('b);

let explode = input => input |> Js.String.split("") |> List.fromArray;

let stringToIntSafe = (~radix=10, string) =>
  switch (Js.Null.toOption(unsafeParseInt(string, radix))) {
  | None => None
  | Some(x) =>
    switch (x->Js.Float.isNaN) {
    | false => Some(x->int_of_float)
    | _ => None
    }
  };

module Color = {
  type t = {
    red: int,
    green: int,
    blue: int,
    alpha: float,
  };

  let toRgb = ({red, green, blue}: t) => (red, green, blue);

  let toRgba = ({red, green, blue, alpha}: t) => (red, green, blue, alpha);

  let toRgbString = ({red, green, blue}: t) => {j|rgb($red, $green, $blue)|j};

  let toRgbaString = ({red, green, blue, alpha}: t) => {j|rgba($red, $green, $blue, $alpha)|j};

  let toHexString = ({red, green, blue}: t) => {
    let r = Js.Int.toStringWithRadix(~radix=16, red);
    let r = r->Js.String.length == 1 ? "0" ++ r : r;
    let g = Js.Int.toStringWithRadix(~radix=16, green);
    let g = g->Js.String.length == 1 ? "0" ++ g : g;
    let b = Js.Int.toStringWithRadix(~radix=16, blue);
    let b = b->Js.String.length == 1 ? "0" ++ b : b;
    "#" ++ r ++ g ++ b;
  };

  let toHexAlphaString = color => {
    let hex = toHexString(color);
    let alpha = (color.alpha *. 255.0)->floor;
    let a = Js.Int.toStringWithRadix(~radix=16, alpha);
    hex ++ a;
  };

  let fromRgb = ((red, green, blue)) => {red, green, blue, alpha: 1.0};

  let fromRgba = ((red, green, blue, alpha)) => {red, green, blue, alpha};

  let fromHexString = string =>
    switch (explode(string)) {
    | ["#", r, g, b] =>
      switch (
        stringToIntSafe(~radix=16, r ++ r),
        stringToIntSafe(~radix=16, g ++ g),
        stringToIntSafe(~radix=16, b ++ b),
      ) {
      | (Some(red), Some(green), Some(blue)) =>
        Ok({red, green, blue, alpha: 1.0})
      | _ => Error("Invalid string provided.")
      }
    | ["#", r, g, b, a] =>
      switch (
        stringToIntSafe(~radix=16, r ++ r),
        stringToIntSafe(~radix=16, g ++ g),
        stringToIntSafe(~radix=16, b ++ b),
        stringToIntSafe(~radix=16, a ++ a),
      ) {
      | (Some(red), Some(green), Some(blue), Some(alpha)) =>
        Ok({red, green, blue, alpha: alpha->float_of_int /. 255.0})
      | _ => Error("Invalid string provided.")
      }
    | ["#", r1, r2, g1, g2, b1, b2] =>
      switch (
        stringToIntSafe(~radix=16, r1 ++ r2),
        stringToIntSafe(~radix=16, g1 ++ g2),
        stringToIntSafe(~radix=16, b1 ++ b2),
      ) {
      | (Some(red), Some(green), Some(blue)) =>
        Ok({red, green, blue, alpha: 1.0})
      | _ => Error("Invalid string provided.")
      }
    | ["#", r1, r2, g1, g2, b1, b2, a1, a2] =>
      switch (
        stringToIntSafe(~radix=16, r1 ++ r2),
        stringToIntSafe(~radix=16, g1 ++ g2),
        stringToIntSafe(~radix=16, b1 ++ b2),
        stringToIntSafe(~radix=16, a1 ++ a2),
      ) {
      | (Some(red), Some(green), Some(blue), Some(alpha)) =>
        Ok({red, green, blue, alpha: alpha->float_of_int /. 255.0})
      | _ => Error("Invalid string provided.")
      }
    | _ => Error("Invalid string provided.")
    };
};