Safe Haskell | None |
---|---|
Language | GHC2021 |
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:
- Simple type-class-based API
- 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
} instanceIsWebColorAlpha
s =>IsLabel
s RGBA wherefromLabel
=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
} instanceIsWebColor
s =>IsLabel
s RGB wherefromLabel
=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
} instanceIsWebColorAlpha
s =>IsLabel
s RGBA wherefromLabel
=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 KnownNat
s.
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:
instanceIsWebColor
"gold" wherewebColor
k = k 255 215 0 instanceIsWebColorAlpha
"gold" wherewebColorAlpha
k = k 255 215 0 255
I'm not going to guarantee you anything. Enjoy!
Synopsis
- class IsWebColor (s :: Symbol) where
- class IsWebColorAlpha (s :: Symbol) where
- webColorAlpha :: ((Word8 & "red") -> (Word8 & "green") -> (Word8 & "blue") -> (Word8 & "alpha") -> r) -> r
- type WebColor = (Nat, Nat, Nat)
- type WebColorAlpha = (Nat, Nat, Nat, Nat)
- type family ParseWebColor (s :: Symbol) :: WebColor where ...
- type family ParseWebColorAlpha (s :: Symbol) :: WebColorAlpha where ...
- type WebColorParsed = (Nat, Nat, Nat, Maybe Nat)
- type family ParseWebColorMaybeAlpha (s :: Symbol) :: WebColorParsed where ...
- type family ParseHexadecimalColor (s :: Symbol) :: WebColorParsed where ...
- type family ParseHexadecimalChar (ch :: Char) :: Nat where ...
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
(ParseWebColor s ~ '(r, g, b), KnownNat r, KnownNat g, KnownNat b) => IsWebColor s Source # | Main instance where all the magic happens |
IsWebColor "red" Source # | Hacky instance to avoid a warning from GHC |
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
(ParseWebColorAlpha s ~ '(r, g, b, a), KnownNat r, KnownNat g, KnownNat b, KnownNat a) => IsWebColorAlpha s Source # | Main instance where all the magic happens |
Defined in WebColor.Labels | |
IsWebColorAlpha "red" Source # | Hacky instance to avoid a warning from GHC |
Defined in WebColor.Labels |
Advanced type-level API
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
is purely syntactical, and you have to tackle the difference yourselfJust
255 - 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
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
is purely syntactical, and you have to tackle the difference yourself:Just
255
>>>
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.
Equations
ParseHexadecimalChar '0' = 0 | |
ParseHexadecimalChar '1' = 1 | |
ParseHexadecimalChar '2' = 2 | |
ParseHexadecimalChar '3' = 3 | |
ParseHexadecimalChar '4' = 4 | |
ParseHexadecimalChar '5' = 5 | |
ParseHexadecimalChar '6' = 6 | |
ParseHexadecimalChar '7' = 7 | |
ParseHexadecimalChar '8' = 8 | |
ParseHexadecimalChar '9' = 9 | |
ParseHexadecimalChar 'a' = 10 | |
ParseHexadecimalChar 'b' = 11 | |
ParseHexadecimalChar 'c' = 12 | |
ParseHexadecimalChar 'd' = 13 | |
ParseHexadecimalChar 'e' = 14 | |
ParseHexadecimalChar 'f' = 15 | |
ParseHexadecimalChar 'A' = 10 | |
ParseHexadecimalChar 'B' = 11 | |
ParseHexadecimalChar 'C' = 12 | |
ParseHexadecimalChar 'D' = 13 | |
ParseHexadecimalChar 'E' = 14 | |
ParseHexadecimalChar 'F' = 15 | |
ParseHexadecimalChar ch = TypeError ('Text "Unable to recognize a character: " ':$$: 'ShowType ch) :: Nat |