packages feed

hsluv-haskell (empty) → 0.1.0.0

raw patch · 9 files changed

+619/−0 lines, 9 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, colour, containers, hsluv-haskell

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright modal/duality (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,5 @@+# hsluv-haskell++Haskell port of the perceptually-uniform [HSLuv colorspace model](http://www.hsluv.org/).++Includes conversion to and from `Data.Colour.Colour`.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hsluv-haskell.cabal view
@@ -0,0 +1,53 @@+-- This file has been generated from package.yaml by hpack version 0.21.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 13f3d18694ca6f3a601ffeb64f180ad6a83a7cee4e9f071a1ecac3273fc1cccc++name:           hsluv-haskell+version:        0.1.0.0+synopsis:       HSLuv conversion utility.+description:    Haskell port of the perceptually-uniform HSLuv colorspace model (http://www.hsluv.org/).+category:       Conversion+author:         modal/duality+maintainer:     surya@modalduality.org+copyright:      2018 modal/duality+license:        GPL-3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    README.md++library+  exposed-modules:+      Constants+      Geometry+      HSLuv+      Util+  other-modules:+      Paths_hsluv_haskell+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , colour+  default-language: Haskell2010++test-suite hsluv-haskell-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_hsluv_haskell+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson+    , base >=4.7 && <5+    , bytestring+    , colour+    , containers+    , hsluv-haskell+  default-language: Haskell2010
+ src/Constants.hs view
@@ -0,0 +1,32 @@+module Constants where++m :: [(Double, Double, Double)]+m =+  [ (3.240969941904521, -1.537383177570093, -0.498610760293)+  , (-0.96924363628087, 1.87596750150772, 0.041555057407175)+  , (0.055630079696993, -0.20397695888897, 1.056971514242878)+  ]++minv :: [(Double, Double, Double)]+minv =+  [ (0.41239079926595, 0.35758433938387, 0.18048078840183)+  , (0.21263900587151, 0.71516867876775, 0.072192315360733)+  , (0.019330818715591, 0.11919477979462, 0.95053215224966)+  ]++refY :: Double+refY = 1.0++refU :: Double+refU = 0.19783000664283++refV :: Double+refV = 0.46831999493879++-- | CIELUV constant+kappa :: Double+kappa = 903.2962962++-- | CIELUV constant+epsilon :: Double+epsilon = 0.0088564516
+ src/Geometry.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE NamedFieldPuns #-}++-- | Geometric utility functions.+module Geometry+  ( Point(..)+  , Line(..)+  , Angle(..)+  , intersectLineLine+  , distanceFromOrigin+  , distanceLineFromOrigin+  , perpendicularThroughPoint+  , angleFromOrigin+  , normalizeAngle+  , lengthOfRayUntilIntersect+  ) where++import           Data.Fixed (mod')++data Point =+  Point Double+        Double++data Line = Line+  { slope     :: Double+  , intercept :: Double+  }++newtype Angle =+  Radians Double++intersectLineLine :: Line -> Line -> Point+intersectLineLine a b =+  let x = (intercept a - intercept b) / (slope b - slope a)+      y = slope a * x + intercept a+  in Point x y++distanceFromOrigin :: Point -> Double+distanceFromOrigin (Point x y) = sqrt (x * x + y * y)++distanceLineFromOrigin :: Line -> Double+distanceLineFromOrigin Line {slope, intercept} =+  abs intercept / sqrt (slope * slope + 1)++perpendicularThroughPoint :: Line -> Point -> Line+perpendicularThroughPoint Line {slope} (Point x y) =+  let slope' = -1 / slope+      intercept' = y - slope' * x+  in Line {slope = slope', intercept = intercept'}++angleFromOrigin :: Point -> Angle+angleFromOrigin (Point x y) = Radians $ atan2 y x++normalizeAngle :: Angle -> Angle+normalizeAngle (Radians theta) = Radians $ mod' theta (2 * pi)++lengthOfRayUntilIntersect :: Angle -> Line -> Double+lengthOfRayUntilIntersect (Radians theta) Line {slope, intercept} =+  intercept / (sin theta - slope * cos theta)
+ src/HSLuv.hs view
@@ -0,0 +1,330 @@+-- | Haskell port of the perceptually-uniform HSLuv colorspace model (http://www.hsluv.org/).+module HSLuv where++import           Constants           (epsilon, kappa, m, minv, refU, refV, refY)+import           Control.Applicative (liftA2)+import           Data.Colour.CIE     (Colour, cieXYZ, cieXYZView)+import           Data.Fixed          (mod')+import qualified Geometry            as G+import           Numeric             (readHex, showHex)+import           Util                (fromLinear, toLinear, tripleDotProduct)++-- | Value in [0, 1].+newtype RGBRed =+  RGBRed Double+  deriving (Eq, Show)++-- | Value in [0, 1].+newtype RGBGreen =+  RGBGreen Double+  deriving (Eq, Show)++-- | Value in [0, 1].+newtype RGBBlue =+  RGBBlue Double+  deriving (Eq, Show)++-- | Values in [0, 1].+data RGB =+  RGB RGBRed+      RGBGreen+      RGBBlue+  deriving (Eq, Show)++-- | Value in [0, 1].+newtype XYZX =+  XYZX Double+  deriving (Eq, Show)++-- | Value in [0, 1].+newtype XYZY =+  XYZY Double+  deriving (Eq, Show)++-- | Value in [0, 1].+newtype XYZZ =+  XYZZ Double+  deriving (Eq, Show)++-- | Values in [0, 1].+data XYZ =+  XYZ XYZX+      XYZY+      XYZZ+  deriving (Eq, Show)++newtype LUVLightness =+  LUVLightness Double+  deriving (Eq, Show)++newtype LUVU =+  LUVU Double+  deriving (Eq, Show)++newtype LUVV =+  LUVV Double+  deriving (Eq, Show)++data LUV =+  LUV LUVLightness+      LUVU+      LUVV+  deriving (Eq, Show)++newtype LCHLightness =+  LCHLightness Double+  deriving (Eq, Show)++newtype LCHChroma =+  LCHChroma Double+  deriving (Eq, Show)++newtype LCHHue =+  LCHHue Double+  deriving (Eq, Show)++data LCH =+  LCH LCHLightness+      LCHChroma+      LCHHue+  deriving (Eq, Show)++-- | Value in [0, 360].+newtype HSLuvHue =+  HSLuvHue Double+  deriving (Eq, Show)++-- | Value in [0, 100].+newtype HSLuvSaturation =+  HSLuvSaturation Double+  deriving (Eq, Show)++-- | Value in [0, 100].+newtype HSLuvLightness =+  HSLuvLightness Double+  deriving (Eq, Show)++-- | Values in [0, 360]; [0, 100]; [0, 100].+data HSLuv =+  HSLuv HSLuvHue+        HSLuvSaturation+        HSLuvLightness+  deriving (Eq, Show)++-- | Value in [0, 360].+newtype HPLuvHue =+  HPLuvHue Double+  deriving (Eq, Show)++-- | Value in [0, 100].+newtype HPLuvPastel =+  HPLuvPastel Double+  deriving (Eq, Show)++-- | Value in [0, 100].+newtype HPLuvLightness =+  HPLuvLightness Double+  deriving (Eq, Show)++-- | Values in [0, 360]; [0, 100]; [0, 100].+data HPLuv =+  HPLuv HPLuvHue+        HPLuvPastel+        HPLuvLightness+  deriving (Eq, Show)++-- | For a given lightness, return a list of 6 lines in slope-intercept+-- form that represent the bounds in CIELUV, stepping over which will+-- push a value out of the RGB gamut.+getBounds :: HSLuvLightness -> [G.Line]+getBounds (HSLuvLightness l) =+  let sub1 = ((l + 16) ** 3) / 1560896+      sub2 =+        if sub1 > epsilon+          then sub1+          else l / kappa+  in liftA2 (bounds sub2) m [0, 1]+  where+    bounds sub2 (m1, m2, m3) t =+      let top1 = (284517 * m1 - 94839 * m3) * sub2+          top2 =+            (838422 * m3 + 769860 * m2 + 731718 * m1) * l * sub2 -+            769860 * t * l+          bottom = (632260 * m3 - 126452 * m2) * sub2 + 126452 * t+      in G.Line {G.slope = top1 / bottom, G.intercept = top2 / bottom}++-- | For given lightness, returns the maximum chroma. Keeping the chroma value+-- below this number will ensure that for any hue, the color is within the RGB+-- gamut.+maxSafeChromaForL :: HSLuvLightness -> LCHChroma+maxSafeChromaForL l' =+  LCHChroma $ minimum $ map G.distanceLineFromOrigin $ getBounds l'++maxChromaForLH :: HSLuvLightness -> HSLuvHue -> LCHChroma+maxChromaForLH l' (HSLuvHue h) =+  let hrad = G.Radians $ h / 360 * pi * 2+  in LCHChroma .+     minimum .+     (:) (1 / 0) . filter (>= 0) . map (G.lengthOfRayUntilIntersect hrad) $+     getBounds l'++xyzToRgb :: XYZ -> RGB+xyzToRgb (XYZ (XYZX x) (XYZY y) (XYZZ z)) =+  let [r, g, b] = map (fromLinear . tripleDotProduct (x, y, z)) m+  in RGB (RGBRed r) (RGBGreen g) (RGBBlue b)++rgbToXyz :: RGB -> XYZ+rgbToXyz (RGB (RGBRed r) (RGBGreen g) (RGBBlue b)) =+  let [x, y, z] =+        map (tripleDotProduct (toLinear r, toLinear g, toLinear b)) minv+  in XYZ (XYZX x) (XYZY y) (XYZZ z)++yToL :: XYZY -> LUVLightness+yToL (XYZY y) =+  if y <= epsilon+    then LUVLightness $ (y / refY) * kappa+    else LUVLightness $ 116 * ((y / refY) ** (1 / 3)) - 16++lToY :: LUVLightness -> XYZY+lToY (LUVLightness l) =+  if l <= 8+    then XYZY $ refY * l / kappa+    else XYZY $ refY * (((l + 16) / 116) ** 3)++xyzToLuv :: XYZ -> LUV+xyzToLuv (XYZ (XYZX x) y'@(XYZY y) (XYZZ z)) =+  let divider = (x + (15 * y) + (3 * z))+      varU = (4 * x) / divider+      varV = (9 * y) / divider+      l'@(LUVLightness l) = yToL y'+      u = 13 * l * (varU - refU)+      v = 13 * l * (varV - refV)+  in if l == 0+       then LUV (LUVLightness 0) (LUVU 0) (LUVV 0)+       else LUV l' (LUVU u) (LUVV v)++luvToXyz :: LUV -> XYZ+luvToXyz (LUV (LUVLightness 0) _ _) = XYZ (XYZX 0) (XYZY 0) (XYZZ 0)+luvToXyz (LUV l'@(LUVLightness l) (LUVU u) (LUVV v)) =+  let varU = u / (13 * l) + refU+      varV = v / (13 * l) + refV+      (XYZY y) = lToY l'+      x = -(9 * y * varU) / ((varU - 4) * varV - (varU * varV))+      z = (9 * y - (15 * varV * y) - (varV * x)) / (3 * varV)+  in XYZ (XYZX x) (XYZY y) (XYZZ z)++luvToLch :: LUV -> LCH+luvToLch (LUV (LUVLightness l) (LUVU u) (LUVV v)) =+  let c = sqrt $ u * u + v * v+      h =+        if c < 0.00000001+          then 0+          else (atan2 v u * 180 / pi) `mod'` 360+  in LCH (LCHLightness l) (LCHChroma c) (LCHHue h)++lchToLuv :: LCH -> LUV+lchToLuv (LCH (LCHLightness l) (LCHChroma c) (LCHHue h)) =+  let hrad = h / 360 * 2 * pi+  in LUV (LUVLightness l) (LUVU $ c * cos hrad) (LUVV $ c * sin hrad)++hsluvToLchWith :: (HSLuvLightness -> HSLuvHue -> LCHChroma) -> HSLuv -> LCH+hsluvToLchWith f (HSLuv h'@(HSLuvHue h) (HSLuvSaturation s) l'@(HSLuvLightness l))+  | l > 99.9999999 = LCH (LCHLightness 100) (LCHChroma 0) (LCHHue h)+  | l < 0.00000001 = LCH (LCHLightness 0) (LCHChroma 0) (LCHHue h)+  | otherwise =+    let (LCHChroma c) = f l' h'+    in LCH (LCHLightness l) (LCHChroma (c / 100 * s)) (LCHHue h)++lchToHsluvWith :: (HSLuvLightness -> HSLuvHue -> LCHChroma) -> LCH -> HSLuv+lchToHsluvWith f (LCH (LCHLightness l) (LCHChroma c) (LCHHue h))+  | l > 99.9999999 = HSLuv (HSLuvHue h) (HSLuvSaturation 0) (HSLuvLightness 100)+  | l < 0.00000001 = HSLuv (HSLuvHue h) (HSLuvSaturation 0) (HSLuvLightness 0)+  | otherwise =+    let (LCHChroma maxC) = f (HSLuvLightness l) (HSLuvHue h)+    in HSLuv (HSLuvHue h) (HSLuvSaturation (c / maxC * 100)) (HSLuvLightness l)++hsluvToLch :: HSLuv -> LCH+hsluvToLch = hsluvToLchWith maxChromaForLH++lchToHsluv :: LCH -> HSLuv+lchToHsluv = lchToHsluvWith maxChromaForLH++hpluvToLch :: HPLuv -> LCH+hpluvToLch (HPLuv (HPLuvHue h) (HPLuvPastel p) (HPLuvLightness l)) =+  hsluvToLchWith+    (\l' _ -> maxSafeChromaForL l')+    (HSLuv (HSLuvHue h) (HSLuvSaturation p) (HSLuvLightness l))++lchToHpluv :: LCH -> HPLuv+lchToHpluv lch =+  let (HSLuv (HSLuvHue h) (HSLuvSaturation s) (HSLuvLightness l)) =+        lchToHsluvWith (\l' _ -> maxSafeChromaForL l') lch+  in HPLuv (HPLuvHue h) (HPLuvPastel s) (HPLuvLightness l)++rgbToHex :: RGB -> String+rgbToHex (RGB (RGBRed r) (RGBGreen g) (RGBBlue b)) =+  "#" ++ toHex r ++ toHex g ++ toHex b+  where+    leftPad s n c = replicate (max 0 (n - length s)) c ++ s+    toHex c = leftPad (showHex (round $ c * 255 :: Integer) "") 2 '0'++hexToRgb :: String -> Maybe RGB+hexToRgb ['#', a, b, c, d, e, f] =+  case (readHex [a, b], readHex [c, d], readHex [e, f]) of+    ([(rr, rr')], [(rg, rg')], [(rb, rb')]) ->+      if any (/= "") [rr', rg', rb']+        then Nothing+        else Just $+             RGB (RGBRed (rr / 255)) (RGBGreen (rg / 255)) (RGBBlue (rb / 255))+    _ -> Nothing+hexToRgb _ = Nothing++lchToRgb :: LCH -> RGB+lchToRgb = xyzToRgb . luvToXyz . lchToLuv++rgbToLch :: RGB -> LCH+rgbToLch = luvToLch . xyzToLuv . rgbToXyz++hsluvToRgb :: HSLuv -> RGB+hsluvToRgb = lchToRgb . hsluvToLch++rgbToHsluv :: RGB -> HSLuv+rgbToHsluv = lchToHsluv . rgbToLch++hpluvToRgb :: HPLuv -> RGB+hpluvToRgb = lchToRgb . hpluvToLch++rgbToHpluv :: RGB -> HPLuv+rgbToHpluv = lchToHpluv . rgbToLch++hsluvToHex :: HSLuv -> String+hsluvToHex = rgbToHex . hsluvToRgb++hpluvToHex :: HPLuv -> String+hpluvToHex = rgbToHex . hpluvToRgb++hexToHsluv :: String -> Maybe HSLuv+hexToHsluv = fmap rgbToHsluv . hexToRgb++hexToHpluv :: String -> Maybe HPLuv+hexToHpluv = fmap rgbToHpluv . hexToRgb++hsluvToColour :: HSLuv -> Colour Double+hsluvToColour hsluv =+  let XYZ (XYZX x) (XYZY y) (XYZZ z) = luvToXyz . lchToLuv . hsluvToLch $ hsluv+  in cieXYZ x y z++colourToHsluv :: Colour Double -> HSLuv+colourToHsluv colour =+  let (x, y, z) = cieXYZView colour+  in lchToHsluv . luvToLch . xyzToLuv $ XYZ (XYZX x) (XYZY y) (XYZZ z)++hpluvToColour :: HPLuv -> Colour Double+hpluvToColour hsluv =+  let XYZ (XYZX x) (XYZY y) (XYZZ z) = luvToXyz . lchToLuv . hpluvToLch $ hsluv+  in cieXYZ x y z++colourToHpluv :: Colour Double -> HPLuv+colourToHpluv colour =+  let (x, y, z) = cieXYZView colour+  in lchToHpluv . luvToLch . xyzToLuv $ XYZ (XYZX x) (XYZY y) (XYZZ z)
+ src/Util.hs view
@@ -0,0 +1,17 @@+module Util where++tripleDotProduct ::+     (Double, Double, Double) -> (Double, Double, Double) -> Double+tripleDotProduct (a, b, c) (d, e, f) = a * d + b * e + c * f++fromLinear :: Double -> Double+fromLinear c =+  if c <= 0.0031308+    then 12.92 * c+    else 1.055 * (c ** (1 / 2.4)) - 0.055++toLinear :: Double -> Double+toLinear c =+  if c >= 0.04045+    then ((c + 0.055) / (1 + 0.055)) ** 2.4+    else c / 12.92
+ test/Spec.hs view
@@ -0,0 +1,92 @@+import           Control.Exception.Base (assert)+import           Control.Monad          (liftM3)+import           Data.Aeson+import           Data.ByteString.Lazy   (readFile)+import           Data.Map               (Map, lookup, toList)+import           Data.Maybe             (fromJust)+import           HSLuv++maxDiff :: Double+maxDiff = 0.0000000001++maxRelDiff :: Double+maxRelDiff = 0.000000001++approxEqual :: Double -> Double -> Bool+approxEqual a b =+  let diff = abs (b - a)+  in diff <= maxDiff || diff <= maxRelDiff * max (abs a) (abs b)++approxEqualTriple ::+     (Double, Double, Double) -> (Double, Double, Double) -> Bool+approxEqualTriple (a, b, c) (d, e, f) =+  approxEqual a d && approxEqual b e && approxEqual c f++checkTestCase :: String -> TestCase -> Bool+checkTestCase hex cases =+  let rgb = fromJust $ Data.Map.lookup "rgb" cases+      xyz = fromJust $ Data.Map.lookup "xyz" cases+      luv = fromJust $ Data.Map.lookup "luv" cases+      lch = fromJust $ Data.Map.lookup "lch" cases+      hsluv = fromJust $ Data.Map.lookup "hsluv" cases+      hpluv = fromJust $ Data.Map.lookup "hpluv" cases+      rgb'@(RGB (RGBRed rgbr') (RGBGreen rgbg') (RGBBlue rgbb')) =+        fromJust $ hexToRgb hex+      xyz'@(XYZ (XYZX xyzx') (XYZY xyzy') (XYZZ xyzz')) = rgbToXyz rgb'+      luv'@(LUV (LUVLightness luvl') (LUVU luvu') (LUVV luvv')) = xyzToLuv xyz'+      lch'@(LCH (LCHLightness lchl') (LCHChroma lchc') (LCHHue lchh')) =+        luvToLch luv'+      hsluvLch'@(HSLuv (HSLuvHue hsluvLchh') (HSLuvSaturation hsluvLchs') (HSLuvLightness hsluvLchl')) =+        lchToHsluv lch'+      hpluvLch'@(HPLuv (HPLuvHue hpluvLchh') (HPLuvPastel hpluvLchp') (HPLuvLightness hpluvLchl')) =+        lchToHpluv lch'+      hsluvHex'@(HSLuv (HSLuvHue hsluvHexh') (HSLuvSaturation hsluvHexs') (HSLuvLightness hsluvHexl')) =+        fromJust $ hexToHsluv hex+      hpluvHex'@(HPLuv (HPLuvHue hpluvHexh') (HPLuvPastel hpluvHexp') (HPLuvLightness hpluvHexl')) =+        fromJust $ hexToHpluv hex+      lchHsluv'@(LCH (LCHLightness lchHsluvl') (LCHChroma lchHsluvc') (LCHHue lchHsluvh')) =+        hsluvToLch hsluvHex'+      lchHpluv'@(LCH (LCHLightness lchHpluvl') (LCHChroma lchHpluvc') (LCHHue lchHpluvh')) =+        hpluvToLch hpluvHex'+      luvLch'@(LUV (LUVLightness luvLchl') (LUVU luvLchu') (LUVV luvLchv')) =+        lchToLuv lchHsluv'+      xyzLuv'@(XYZ (XYZX xyzLuvx') (XYZY xyzLuvy') (XYZZ xyzLuvz')) =+        luvToXyz luvLch'+      rgbXyz'@(RGB (RGBRed rgbXyzr') (RGBGreen rgbXyzg') (RGBBlue rgbXyzb')) =+        xyzToRgb xyzLuv'+  in approxEqualTriple rgb (rgbr', rgbg', rgbb') &&+     approxEqualTriple xyz (xyzx', xyzy', xyzz') &&+     approxEqualTriple luv (luvl', luvu', luvv') &&+     approxEqualTriple lch (lchl', lchc', lchh') &&+     approxEqualTriple hsluv (hsluvLchh', hsluvLchs', hsluvLchl') &&+     approxEqualTriple hsluv (hsluvHexh', hsluvHexs', hsluvHexl') &&+     approxEqualTriple hpluv (hpluvLchh', hpluvLchp', hpluvLchl') &&+     approxEqualTriple hpluv (hpluvHexh', hpluvHexp', hpluvHexl') &&+     approxEqualTriple lch (lchHsluvl', lchHsluvc', lchHsluvh') &&+     approxEqualTriple lch (lchHpluvl', lchHpluvc', lchHpluvh') &&+     approxEqualTriple luv (luvLchl', luvLchu', luvLchv') &&+     approxEqualTriple xyz (xyzLuvx', xyzLuvy', xyzLuvz') &&+     approxEqualTriple rgb (rgbXyzr', rgbXyzg', rgbXyzb') &&+     hex == rgbToHex rgb' &&+     hex == hsluvToHex hsluvLch' &&+     hex == hpluvToHex hpluvLch' &&+     hex == hsluvToHex hsluvHex' && hex == hpluvToHex hpluvHex'++checkRgbBounds :: Bool+checkRgbBounds = all checkRgbBound $ liftM3 (,,) [0, 1] [0, 1] [0, 1]+  where+    checkRgbBound (r, g, b) =+      let RGB (RGBRed r') (RGBGreen g') (RGBBlue b') =+            hsluvToRgb . rgbToHsluv $ RGB (RGBRed r) (RGBGreen g) (RGBBlue b)+      in approxEqualTriple (r, g, b) (r', g', b')++type TestCase = Map String (Double, Double, Double)++type TestVectors = Map String TestCase++main :: IO ()+main = do+  testVectorsString <- Data.ByteString.Lazy.readFile "test/snapshot-rev4.json"+  let testVectors = fromJust (decode testVectorsString :: Maybe TestVectors)+  let vectorsCheck = all (uncurry checkTestCase) (Data.Map.toList testVectors)+  print $ assert (vectorsCheck && checkRgbBounds) "All tests pass."