Add fromHexString, toHexString, closes #1

Author: sharkdp

bower.json

@@ -12,7 +12,8 @@
   "dependencies": {
     "purescript-integers": "^0.2.1",
     "purescript-orders": "^0.1.1",
-    "purescript-arrays": "^0.4.4"
+    "purescript-arrays": "^0.4.4",
+    "purescript-strings": "^0.7.1"
   },
   "devDependencies": {
     "purescript-test-unit": "^4.1.0",

docs/Color.md

@@ -57,15 +57,19 @@ Create a `Color` from RGB values between 0.0 and 1.0.
 hsla :: Number -> Number -> Number -> Number -> Color
 ```
 
-Create a `Color` from hue, saturation, lightness and alpha values.
+Create a `Color` from hue, saturation, lightness and alpha values. The
+hue is given in degrees, as a `Number` between 0.0 and 360.0. Saturation,
+lightness and alpha are numbers between 0.0 and 1.0.
 
 #### `hsl`
 
 ``` purescript
 hsl :: Number -> Number -> Number -> Color
 ```
 
-Create a `Color` from hue, saturation and lightness values.
+Create a `Color` from hue, saturation and lightness values. The hue is
+given in degrees, as a `Number` between 0.0 and 360.0. Both saturation and
+lightness are numbers between 0.0 and 1.0.
 
 #### `black`
 
@@ -117,6 +121,27 @@ toRGBA' :: Color -> { r :: Number, g :: Number, b :: Number, a :: Number }
 Convert a `Color` to its red, green, blue and alpha values. All values
 are numbers in the range from 0.0 to 1.0.
 
+#### `fromHexString`
+
+``` purescript
+fromHexString :: String -> Maybe Color
+```
+
+Parse a HEX code of the form `#ddd` or `#dddddd`, where `d` is a single
+hexadecimal digit ([0-9a-f], case insensitive). Returns `Nothing` if the
+string is in a wrong format.
+
+#### `toHexString`
+
+``` purescript
+toHexString :: Color -> String
+```
+
+Return a hexadecimal representation of the color in the form `#rrggbb`,
+where `rr`, `gg` and `bb` refer to hexadecimal digits corresponding to
+the RGB channel values between `00` and `ff`. The alpha channel is not
+represented.
+
 #### `cssStringHSLA`
 
 ``` purescript

docs/Color/Gradient.md

@@ -0,0 +1,11 @@
+## Module Color.Gradient
+
+#### `hslGradient`
+
+``` purescript
+hslGradient :: Int -> Color -> Color -> Array Color
+```
+
+A range of colors that linearly interpolates between the two boundaries.
+
+

html/purescript-colors.json

@@ -0,0 +1,18 @@
+// module Color
+// jshint node: true
+
+"use strict";
+
+// Parse a string which guaranteed to be of the form `[0-9a-f]{1,2}`.
+exports.parseHex = function(str) {
+  return parseInt(str, 16);
+};
+
+// Convert a number between 0 and 255 to a hex value between 00 and ff.
+exports.toHex = function(n) {
+  var str = n.toString(16);
+  if (str.length == 1) {
+    return "0" + str;
+  }
+  return str;
+};

src/Color.js

@@ -14,6 +14,8 @@ module Color
   , toHSLA
   , toRGBA
   , toRGBA'
+  , fromHexString
+  , toHexString
   , cssStringHSLA
   , complementary
   , lighten
@@ -25,9 +27,14 @@ module Color
   ) where
 
 import Prelude
+import Control.Bind (join)
+import Data.Array ((!!))
 import Data.Int (toNumber, round)
-import Math (abs, (%))
+import Data.Maybe (Maybe(..))
 import Data.Ord (min, max, clamp)
+import Data.String (length)
+import Data.String.Regex (regex, parseFlags, match)
+import Math (abs, (%))
 
 -- | The representation of a color.
 data Color = HSLA Number Number Number Number
@@ -157,6 +164,42 @@ toRGBA' (HSLA h s l a) = { r: rgb'.r + m, g: rgb'.g + m, b: rgb'.b + m, a }
          | 4.0 <= h' && h' < 5.0 = { r: x  , g: 0.0, b: chr }
          | otherwise             = { r: chr, g: 0.0, b: x   }
 
+foreign import parseHex :: String -> Int
+
+-- | Parse a hexadecimal RGB code of the form `#rgb` or `#rrggbb`, where the
+-- | hexadecimal digits are of the format [0-9a-f] (case insensitive). Returns
+-- | `Nothing` if the string is in a wrong format.
+fromHexString :: String -> Maybe Color
+fromHexString str = do
+  groups <- match pattern str
+  r <- parseHex <$> join (groups !! 1)
+  g <- parseHex <$> join (groups !! 2)
+  b <- parseHex <$> join (groups !! 3)
+  if isShort
+    then
+      pure $ rgb (16 * r + r) (16 * g + g) (16 * b + b)
+    else
+      pure (rgb r g b)
+  where
+    isShort = length str == 4
+    digit = "[0-9a-f]"
+    single = "(" <> digit <> ")"
+    pair = "(" <> digit <> digit <> ")"
+    variant = if isShort
+                then single <> single <> single
+                else pair <> pair <> pair
+    pattern = regex ("^#(?:" <> variant <> ")$") (parseFlags "i")
+
+foreign import toHex :: Int -> String
+
+-- | Return a hexadecimal representation of the color in the form `#rrggbb`,
+-- | where `rr`, `gg` and `bb` refer to hexadecimal digits corresponding to
+-- | the RGB channel values between `00` and `ff`. The alpha channel is not
+-- | represented.
+toHexString :: Color -> String
+toHexString color = "#" <> toHex c.r <> toHex c.g <> toHex c.b
+  where c = toRGBA color
+
 -- | The CSS representation of the color in the form `hsl(..)` or `hsla(...)`.
 cssStringHSLA :: Color -> String
 cssStringHSLA (HSLA h s l a) =

src/Color.purs

@@ -79,6 +79,7 @@ main = do
     doc "hsl" (id :: TColor -> _)
     doc "rgb" $
       (\(Int255 r) (Int255 g) (Int255 b) -> TColor (rgb r g b))
+    doc "toHexString" (\(TColor c) -> toHexString c)
     doc "cssStringHSLA" (\(TColor c) -> cssStringHSLA c)
     doc "black" (TColor black)
     doc "white" (TColor white)

test/Interactive.purs

@@ -5,6 +5,7 @@ import Prelude
 import Data.Array ((..))
 import Data.Foldable (sequence_)
 import Data.Int (toNumber)
+import Data.Maybe (Maybe(..))
 
 import Test.Unit (test, runTest)
 import Test.Unit.Assert (assert, assertFalse, equal)
@@ -55,6 +56,33 @@ main = runTest do
       degree <- 0 .. 360
       return $ roundtrip (toNumber degree) 0.5 0.8
 
+  test "fromHexString" do
+    equal (Just black) (fromHexString "#000")
+    equal (Just black) (fromHexString "#000000")
+    equal (Just white) (fromHexString "#fff")
+    equal (Just white) (fromHexString "#fffFFF")
+    equal (Just white) (fromHexString "#ffffff")
+    equal (Just (rgb 87 166 206)) (fromHexString "#57A6CE")
+    equal Nothing (fromHexString "000")
+    equal Nothing (fromHexString "000000")
+    equal Nothing (fromHexString "#0")
+    equal Nothing (fromHexString "#00")
+    equal Nothing (fromHexString "#0000")
+    equal Nothing (fromHexString "#00000")
+    equal Nothing (fromHexString "#0000000")
+
+  test "toHexString" do
+    let hexRoundtrip h s l = equal (Just $ hsl h s l) (fromHexString (toHexString (hsl h s l)))
+    hexRoundtrip 0.0 0.0 1.0
+    hexRoundtrip 0.0 0.0 0.5
+    hexRoundtrip 0.0 0.0 0.0
+    hexRoundtrip 0.0 1.0 0.5
+    hexRoundtrip 60.0 1.0 0.375
+    hexRoundtrip 120.0 1.0 0.25
+    hexRoundtrip 240.0 1.0 0.75
+    hexRoundtrip 49.5 0.893 0.497
+    hexRoundtrip 162.4 0.779 0.447
+
   test "cssStringHSLA" do
     equal "hsla(120, 33%, 55%, 0.3)" (cssStringHSLA (hsla 120.1 0.33 0.55 0.3))
     equal "hsl(120, 33%, 55%)" (cssStringHSLA (hsla 120.1 0.332 0.549 1.0))