webcolor-labels-0.1.0.0: Plug-n-play #hex-syntax for your colors
Safe HaskellNone
LanguageGHC2021

WebColor.Labels

Description

Introduction and intended usage

This library contains a small number of helpers that primarily aim to help users construct IsLabel instances to use -XOverloadedLabels syntax to construct their color types using widely known web color syntax.

There are two ways to use this API:

  1. Simple type-class-based API
  2. Advanced manual type-family-based API

You should always prefer the simple API.

Simple API

You should use the simple API to write an IsLabel instance for your own type representing a color.

Depending on whether your type supports representing the alpha channel, you should choose between IsWebColor and IsWebColorAlpha type classes.

Therefore, it's likely that you want to write an instance that looks like this:

data RGBA = MkRGBA { red :: Word8, green :: Word8, blue :: Word8, alpha :: Word8 }

instance IsWebColorAlpha s => IsLabel s RGBA where
  fromLabel = webColorAlpha @s r g b a ->
      MkRGBA { red = r, green = g, blue = b, alpha = a }

Or this in case your type doesn't have an alpha channel:

data RGB = MkRGB { red :: Word8, green :: Word8, blue :: Word8 }

instance IsWebColor s => IsLabel s RGB where
  fromLabel = webColor @s r g b ->
      MkRGB { red = r, green = g, blue = b }

Please do not try to use IsWebColor if your type can represent either RGB or RGBA colors; use IsWebColorAlpha and alternate data construction depending on the value of the alpha channel:

data Color
  = MkRGB { red :: Word8, green :: Word8, blue :: Word8 }
  | MkRGBA { red :: Word8, green :: Word8, blue :: Word8, alpha :: Word8 }

instance IsWebColorAlpha s => IsLabel s RGBA where
  fromLabel = webColorAlpha @s r g b a ->
      if a == 255
        then MkRGB { red = r, green = g, blue = b }
        else MkRGBA { red = r, green = g, blue = b, alpha = a }

Advanced API

It's always recommended to use the simple API unless you want to drop named colors for some reason or want to work with raw KnownNats.

There are four main type families:

The first two correspond to the output of IsWebColor and IsWebColorAlpha type classes listed in the previous section.

ParseWebColorMaybeAlpha allows you to alternate behavior between presence and absence of the alpha channel in the input. Please let me know if you have a use case for this and why you can't simply consider 255 alpha as an RGB color.

ParseHexadecimalColor converts hexadecimal strings of length 3, 4, 6, and 8 into correct color channels but doesn't accept named colors.

In general, you give a parsing function a symbol argument and match results using the equality operator:

f :: ParseWebColorAlpha s ~ '(r,g,b,a) => ...

After that, you can set various constraints on the results. For example, this is how you can convert given values into a 32-bit number without any runtime computations:

{-# LANGUAGE DataKinds, NoStarIsType, AllowAmbiguousTypes #-}

f ::  forall s r g b a w32.
      ParseWebColorAlpha s ~ '(r,g,b,a) =>
      ((r * 0x100 + g) * 0x100 + b) * 0x100 + a ~ w32 =>
      KnownNat w32 => Word32
f = fromInteger $ natVal (Proxy @w32)

To advanced end users

If you're an advanced Haskell user. If you think that rules are just "recommendations." If you're ready to face possible breakages just for slight usability improvements. Then I present you a footgun.

It is possible to write orphan instances for IsWebColor and IsWebColorAlpha type classes to extend #-syntax with custom named colors, just like this:

instance IsWebColor "gold" where
  webColor k = k 255 215 0

instance IsWebColorAlpha "gold" where
  webColorAlpha k = k 255 215 0 255

I'm not going to guarantee you anything. Enjoy!

Synopsis

Primary API

class IsWebColor (s :: Symbol) where Source #

Parse a type-level string containing a named color from a basic palette or a hexadecimal representation and convert it into three bytes representing red, green, and blue channels

  • For convenience, a 255 alpha channel is interpreted as a solid color without an alpha channel:
>>> webColor @"123" (,,)
(17,34,51)
>>> webColor @"123f" (,,)
(17,34,51)
  • Other alpha channel values result in a compile-time error:
>>> webColor @"123d" (,,)
Unexpected alpha channel! RGB color expected
  • Named colors are always considered RGB-only:
>>> webColor @"red" (,,)
(255,0,0)

Methods

webColor :: ((Word8 & "red") -> (Word8 & "green") -> (Word8 & "blue") -> r) -> r Source #

Parse a type-level string and give you bytes representing red, green, and blue colors.

NB: & is just a type alias that should help to keep with order.

Instances

Instances details
(ParseWebColor s ~ '(r, g, b), KnownNat r, KnownNat g, KnownNat b) => IsWebColor s Source #

Main instance where all the magic happens

Instance details

Defined in WebColor.Labels

Methods

webColor :: ((Word8 & "red") -> (Word8 & "green") -> (Word8 & "blue") -> r0) -> r0 Source #

IsWebColor "red" Source #

Hacky instance to avoid a warning from GHC

Instance details

Defined in WebColor.Labels

Methods

webColor :: ((Word8 & "red") -> (Word8 & "green") -> (Word8 & "blue") -> r) -> r Source #

class IsWebColorAlpha (s :: Symbol) where Source #

Parse a type-level string containing a named color from a basic palette or a hexadecimal representation and convert it into four bytes representing red, green, blue, and alpha channels

  • An absent alpha channel get converted into the 255 value:
>>> webColorAlpha @"123" (,,,)
(17,34,51,255)
>>> webColorAlpha @"123f" (,,,)
(17,34,51,255)
  • Named colors are always considered RGB-only:
>>> webColorAlpha @"red" (,,,)
(255,0,0,255)

Methods

webColorAlpha :: ((Word8 & "red") -> (Word8 & "green") -> (Word8 & "blue") -> (Word8 & "alpha") -> r) -> r Source #

Parse a type-level string and give you bytes representing red, green, blue, and alpha colors.

NB: & is just a type alias that should help to keep with order.

Instances

Instances details
(ParseWebColorAlpha s ~ '(r, g, b, a), KnownNat r, KnownNat g, KnownNat b, KnownNat a) => IsWebColorAlpha s Source #

Main instance where all the magic happens

Instance details

Defined in WebColor.Labels

Methods

webColorAlpha :: ((Word8 & "red") -> (Word8 & "green") -> (Word8 & "blue") -> (Word8 & "alpha") -> r0) -> r0 Source #

IsWebColorAlpha "red" Source #

Hacky instance to avoid a warning from GHC

Instance details

Defined in WebColor.Labels

Methods

webColorAlpha :: ((Word8 & "red") -> (Word8 & "green") -> (Word8 & "blue") -> (Word8 & "alpha") -> r) -> r Source #

Advanced type-level API

type WebColor = (Nat, Nat, Nat) Source #

Red, green, and blue color channels in range from 0 to 255

type WebColorAlpha = (Nat, Nat, Nat, Nat) Source #

Red, green, blue, and alpha color channels in range from 0 to 255

type family ParseWebColor (s :: Symbol) :: WebColor where ... Source #

Parse a string containing a named color from a basic palette or hexadecimal representation without an alpha channel.

  • For convenience, a 255 alpha channel is interpreted as a solid color without an alpha channel:
>>> showType @(`ParseWebColor` "123")
'(17, 34, 51)
>>> showType @(`ParseWebColor` "123f")
'(17, 34, 51)
  • Other alpha channel values result in a compile-time error:
>>> showType @(`ParseWebColor` "123d")
Unexpected alpha channel! RGB color expected

This family inherits many properties from ParseWebColorMaybeAlpha:

  • Named colors are always considered RGB-only:
>>> showType @(`ParseWebColor` "red")
'(255, 0, 0)
  • This family automatically handles shortened syntax.
  • This family throws a compile-time error when the wrong number of hex characters is supplied

Equations

ParseWebColor s = ParseRGBColorWorker (ParseWebColorMaybeAlpha s) 

type family ParseWebColorAlpha (s :: Symbol) :: WebColorAlpha where ... Source #

Parse a string containing a named color from a basic palette or a hexadecimal representation with an optional alpha channel.

  • This family converts an absence of an alpha channel into the 255 value.
>>> showType @(`ParseWebColorAlpha` "123")
'(17, 34, 51, 255)

This family inherits many properties from ParseWebColorMaybeAlpha:

  • Named colors are always considered RGB-only and are handled the same way:
>>> showType @(`ParseWebColorAlpha` "red")
'(255, 0, 0, 255)
  • This family automatically handles shortened syntax.
  • This family throws a compile-time error when the wrong number of hex characters is supplied

Equations

ParseWebColorAlpha s = ParseRGBAColorWorker (ParseWebColorMaybeAlpha s) 

type WebColorParsed = (Nat, Nat, Nat, Maybe Nat) Source #

Red, green, blue, and optional alpha color channels in range from 0 to 255

type family ParseWebColorMaybeAlpha (s :: Symbol) :: WebColorParsed where ... Source #

Parse a string containing a named color from a basic palette or hexadecimal representation with an optional alpha channel.

  • Named colors are always considered RGB-only:
>>> showType @(`ParseWebColorMaybeAlpha` "red")
'(255, 0, 0, 'Nothing)
>>> showType @(`ParseWebColorMaybeAlpha` "silver")
'(192, 192, 192, 'Nothing)

ParseWebColorMaybeAlpha inherits many properties from ParseHexadecimalColor:

  • The difference between a Nothing alpha channel and Just 255 is purely syntactical, and you have to tackle the difference yourself
  • This family automatically handles shortened syntax
  • This family throws a compile-time error when the wrong number of hex characters is supplied

Please refer to ParseHexadecimalColor for the examples.

Equations

ParseWebColorMaybeAlpha "white" = '(255, 255, 255, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "silver" = '(192, 192, 192, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "gray" = '(128, 128, 128, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "black" = '(0, 0, 0, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "red" = '(255, 0, 0, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "maroon" = '(128, 0, 0, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "yellow" = '(255, 255, 0, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "olive" = '(128, 128, 0, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "lime" = '(0, 255, 0, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "green" = '(0, 128, 0, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "aqua" = '(0, 255, 255, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "teal" = '(0, 128, 128, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "blue" = '(0, 0, 255, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "navy" = '(0, 0, 128, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "fuchsia" = '(255, 0, 255, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha "purple" = '(128, 0, 128, 'Nothing :: Maybe Nat) 
ParseWebColorMaybeAlpha s = ParseHexadecimalColor s 

type family ParseHexadecimalColor (s :: Symbol) :: WebColorParsed where ... Source #

Parse a string containing hexadecimal representation of a color with an optional alpha channel.

  • This family doesn't handle named colors.
  • The difference between a Nothing alpha channel and Just 255 is purely syntactical, and you have to tackle the difference yourself:
>>> showType @(`ParseHexadecimalColor` "fafefb")
'(250, 254, 251, 'Nothing)
>>> showType @(`ParseHexadecimalColor` "fafefbff")
'(250, 254, 251, 'Just 255)
  • This family automatically handles shortened syntax:

E.g. #123 is the same as #112233:

>>> showType @(`ParseHexadecimalColor` "123")
'(17, 34, 51, 'Nothing)
>>> showType @(`ParseHexadecimalColor` "112233")
'(17, 34, 51, 'Nothing)

The same applies to #1234 and #11223344:

>>> showType @(`ParseHexadecimalColor` "1234")
'(17, 34, 51, 'Just 68)
>>> showType @(`ParseHexadecimalColor` "11223344")
'(17, 34, 51, 'Just 68)
  • This family throws a compile-time error when the wrong number of hex characters is supplied:
>>> showType @(`ParseHexadecimalColor` "1")
Unexpected number of hex codes
expected 3, 4, 6 or 8
>>> showType @(`ParseHexadecimalColor` "1122334455")
Unexpected number of hex codes
expected 3, 4, 6 or 8

Equations

ParseHexadecimalColor s = ParseColorRec ('[] :: [Nat]) (UnconsSymbol s) 

Utility type families

These type families aren't required to use the library, but may be useful for defining your own parse routing on top of web colors

type family ParseHexadecimalChar (ch :: Char) :: Nat where ... Source #

Convert a hexadecimal character (0 .. F) into a corresponging number. Case insensitive.