Color 0.3.1 → 0.3.2

raw patch · 12 files changed

+527/−5 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• Color.cabal +9/−4
• src/Graphics/Color/Model.hs +3/−0
• src/Graphics/Color/Model/LCH.hs +88/−0
• src/Graphics/Color/Space/CIE1976/LAB/LCH.hs +91/−0
• src/Graphics/Color/Space/CIE1976/LUV.hs +150/−0
• src/Graphics/Color/Space/CIE1976/LUV/LCH.hs +91/−0
• src/Graphics/Color/Space/RGB/ITU/Rec601.hs +0/−1
• tests/Graphics/Color/Model/LCHSpec.hs +14/−0
• tests/Graphics/Color/Space/CIE1976/LAB/LCHSpec.hs +29/−0
• tests/Graphics/Color/Space/CIE1976/LUV/LCHSpec.hs +30/−0
• tests/Graphics/Color/Space/CIE1976/LUVSpec.hs +18/−0

@@ -1,5 +1,9 @@ # Changelog for Color +## 0.3.2++* Addition of `CIEL*u*v*` colorspace and `LCh` views of both `CIEL*a*b*` and `L*u*v*`.+ ## 0.3.1  * Remove `RealFloat` constraint from `ColorSpace` for `Y'`

@@ -1,5 +1,5 @@ name:                Color-version:             0.3.1+version:             0.3.2 synopsis:            Color spaces and conversions between them description:         Please see the README on GitHub at <https://github.com/lehins/Color#readme> homepage:            https://github.com/lehins/Color@@ -42,9 +42,9 @@                      , Graphics.Color.Space.CIE1931.RGB                      , Graphics.Color.Space.CIE1931.XYZ                      , Graphics.Color.Space.CIE1976.LAB-                     -- , Graphics.Color.Space.CIE1976.LAB.LCH-                     -- , Graphics.Color.Space.CIE1976.LAB.HLC-                     -- , Graphics.Color.Space.CIE1976.LUV+                     , Graphics.Color.Space.CIE1976.LAB.LCH+                     , Graphics.Color.Space.CIE1976.LUV+                     , Graphics.Color.Space.CIE1976.LUV.LCH                      , Graphics.Color.Space.RGB                      , Graphics.Color.Space.RGB.CIERGB                      , Graphics.Color.Space.RGB.AdobeRGB@@ -80,6 +80,7 @@                      , Graphics.Color.Model.HSI                      , Graphics.Color.Model.HSL                      , Graphics.Color.Model.HSV+                     , Graphics.Color.Model.LCH                      , Graphics.Color.Model.X                      , Graphics.Color.Model.YCbCr                      , Graphics.Color.Space.Internal@@ -109,11 +110,15 @@                     , Graphics.Color.Model.HSISpec                     , Graphics.Color.Model.HSLSpec                     , Graphics.Color.Model.HSVSpec+                    , Graphics.Color.Model.LCHSpec                     , Graphics.Color.Model.RGBSpec                     , Graphics.Color.Model.YCbCrSpec                     , Graphics.Color.Space.Common                     , Graphics.Color.Space.CIE1931.RGBSpec                     , Graphics.Color.Space.CIE1976.LABSpec+                    , Graphics.Color.Space.CIE1976.LAB.LCHSpec+                    , Graphics.Color.Space.CIE1976.LUVSpec+                    , Graphics.Color.Space.CIE1976.LUV.LCHSpec                     , Graphics.Color.Space.RGB.AdobeRGBSpec                     , Graphics.Color.Space.RGB.SRGBSpec                     , Graphics.Color.Space.RGB.Derived.AdobeRGBSpec

@@ -31,6 +31,8 @@   , module Graphics.Color.Model.YCbCr   -- * CMYK   , module Graphics.Color.Model.CMYK+  -- * LCH+  , module Graphics.Color.Model.LCH   -- * Color   , Color(..)   , module Graphics.Color.Algebra.Binary@@ -43,6 +45,7 @@ import Graphics.Color.Model.HSI import Graphics.Color.Model.HSL import Graphics.Color.Model.HSV+import Graphics.Color.Model.LCH import Graphics.Color.Model.Internal import Graphics.Color.Model.RGB import Graphics.Color.Model.X

@@ -0,0 +1,88 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module : Graphics.Color.Model.LCH+module Graphics.Color.Model.LCH+  ( LCH+  -- * Constructors for an LCH color model.+  , pattern ColorLCH+  , pattern ColorLCHA+  , Color+  , ColorModel(..)+  , lch2lxy+  , lxy2lch+  ) where++import Data.Complex ( Complex(..), polar, mkPolar )+import Data.Fixed ( mod' )+import Foreign.Storable+import Graphics.Color.Model.Internal++-----------+--- LCH ---+-----------++-- | CIEL*C*H color model, representing a cylindrical reparameterization+--   of CIEL*a*b* or CIEL*u*v*.+data LCH++-- | `LCH` color model+newtype instance Color LCH e = LCH (V3 e)++-- | Constructor for @LCH@.+pattern ColorLCH :: e -> e -> e -> Color LCH e+pattern ColorLCH l c h = LCH (V3 l c h)+{-# COMPLETE ColorLCH #-}+++-- | Constructor for @LCH@ with alpha channel.+pattern ColorLCHA :: e -> e -> e -> e -> Color (Alpha LCH) e+pattern ColorLCHA l c h a = Alpha (ColorLCH l c h) a+{-# COMPLETE ColorLCHA #-}++-- | `LCH` color model+deriving instance Eq e => Eq (Color LCH e)+-- | `LCH` color model+deriving instance Ord e => Ord (Color LCH e)+-- | `LCH` color model+deriving instance Functor (Color LCH)+-- | `LCH` color model+deriving instance Applicative (Color LCH)+-- | `LCH` color model+deriving instance Foldable (Color LCH)+-- | `LCH` color model+deriving instance Traversable (Color LCH)+-- | `LCH` color model+deriving instance Storable e => Storable (Color LCH e)++-- | `LCH` color model+instance Elevator e => Show (Color LCH e) where+  showsPrec _ = showsColorModel++-- | `LCH` color model+instance Elevator e => ColorModel LCH e where+  type Components LCH e = (e, e, e)+  toComponents (ColorLCH l c h) = (l, c, h)+  {-# INLINE toComponents #-}+  fromComponents (l, c, h) = ColorLCH l c h+  {-# INLINE fromComponents #-}++lch2lxy :: Color LCH Double -> Components LCH Double+lch2lxy (ColorLCH l c h) = (l, x, y)+ where+  !h' = h * pi / 180+  (x :+ y) = mkPolar c h'+{-# INLINE lch2lxy #-}++lxy2lch :: Components LCH Double -> Color LCH Double+lxy2lch (l, x, y) = ColorLCH l c h+ where+  (c,h') = polar (x :+ y)+  !h = (h' * 180 / pi) `mod'` 360+{-# INLINE lxy2lch #-}

@@ -0,0 +1,91 @@+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module: Graphics.Color.Space.CIE1976.LAB.LCH++module Graphics.Color.Space.CIE1976.LAB.LCH+  ( pattern ColorLCHab+  , pattern ColorLCHabA+  , LCHab+  , Color(LCHab)+  ) where++import Data.Coerce+import Data.Proxy+import Foreign.Storable+import qualified Graphics.Color.Model.LCH as CM+import Graphics.Color.Space.CIE1976.LAB+import Graphics.Color.Model.Internal+import Graphics.Color.Space.Internal++-- | [CIE L*C*Hab](https://en.wikipedia.org/wiki/CIELAB_color_space),+--   an LCH representation for the L*a*b* color space+data LCHab (i :: k)++-- | Color in CIE L*C*Hab color space+newtype instance Color (LCHab i) e = LCHab (Color CM.LCH e)++-- | CIE1976 `LCHab` color space+deriving instance Eq e => Eq (Color (LCHab i) e)++-- | CIE1976 `LCHab` color space+deriving instance Ord e => Ord (Color (LCHab i) e)++-- | CIE1976 `LCHab` color space+deriving instance Functor (Color (LCHab i))++-- | CIE1976 `LCHab` color space+deriving instance Applicative (Color (LCHab i))++-- | CIE1976 `LCHab` color space+deriving instance Foldable (Color (LCHab i))++-- | CIE1976 `LCHab` color space+deriving instance Traversable (Color (LCHab i))++-- | CIE1976 `LCHab` color space+deriving instance Storable e => Storable (Color (LCHab i) e)++-- | CIE1976 `LCHab` color space+instance (Illuminant i, Elevator e) => Show (Color (LCHab i) e) where+  showsPrec _ = showsColorModel++-- | Constructor for a CIEL*a*b* color space in a cylindrical L*C*h parameterization+pattern ColorLCHab :: e -> e -> e -> Color (LCHab i) e+pattern ColorLCHab l c h = LCHab (CM.ColorLCH l c h)+{-# COMPLETE ColorLCHab #-}++-- | Constructor for a @LCHab@ with alpha+pattern ColorLCHabA :: e -> e -> e -> e -> Color (Alpha (LCHab i)) e+pattern ColorLCHabA l c h a = Alpha (LCHab (CM.ColorLCH l c h)) a+{-# COMPLETE ColorLCHabA #-}++-- | CIE1976 `LCHab` color space+instance (Illuminant i, Elevator e, ColorModel (LAB i) e) => ColorModel (LCHab i) e where+  type Components (LCHab i) e = (e, e, e)+  toComponents = toComponents . coerce+  {-# INLINE toComponents #-}+  fromComponents = coerce . fromComponents+  {-# INLINE fromComponents #-}+  showsColorModelName _ =+    ("LCH-"++) . showsColorModelName (Proxy :: Proxy (Color (LAB i) e))++instance (Illuminant i, Elevator e, ColorSpace (LAB i) i e) => ColorSpace (LCHab i) i e where+  type BaseModel (LCHab i) = CM.LCH+  type BaseSpace (LCHab i) = LAB i+  toBaseSpace = fmap fromDouble . fromComponents . CM.lch2lxy . fmap toDouble . coerce+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = coerce . fmap fromDouble . CM.lxy2lch . toComponents . fmap toDouble+  {-# INLINE fromBaseSpace #-}+  luminance = luminance . toBaseSpace+  {-# INLINE luminance #-}

@@ -0,0 +1,150 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module      : Graphics.Color.Space.CIE1976.LUV+--+module Graphics.Color.Space.CIE1976.LUV+  ( -- * Constructors for an CIE L*u*v* color space.+    pattern LUV+  , pattern ColorLUV+  , pattern ColorLUVA+  , LUV+  ) where++import Foreign.Storable+import Graphics.Color.Model.Internal+import Graphics.Color.Space.Internal++--------------+--- CIELUV ---+--------------++-- | [CIE L*u*v*](https://en.wikipedia.org/wiki/CIELUV_color_space) color space+data LUV (i :: k)++-- | Color in CIE L*u*v* color space+newtype instance Color (LUV i) e = LUV (V3 e)+++pattern ColorLUV :: e -> e -> e -> Color (LUV i) e+pattern ColorLUV l' u' v' = LUV (V3 l' u' v')+{-# COMPLETE ColorLUV #-}++-- | Constructor for @LUV@ with alpha channel.+pattern ColorLUVA :: e -> e -> e -> e -> Color (Alpha (LUV i)) e+pattern ColorLUVA l' u' v' a = Alpha (LUV (V3 l' u' v')) a+{-# COMPLETE ColorLUVA #-}++-- | CIE1976 `LUV` color space+deriving instance Eq e => Eq (Color (LUV i) e)++-- | CIE1976 `LUV` color space+deriving instance Ord e => Ord (Color (LUV i) e)++-- | CIE1976 `LUV` color space+deriving instance Functor (Color (LUV i))++-- | CIE1976 `LUV` color space+deriving instance Applicative (Color (LUV i))++-- | CIE1976 `LUV` color space+deriving instance Foldable (Color (LUV i))++-- | CIE1976 `LUV` color space+deriving instance Traversable (Color (LUV i))++-- | CIE1976 `LUV` color space+deriving instance Storable e => Storable (Color (LUV i) e)++-- | CIE1976 `LUV` color space+instance (Illuminant i, Elevator e) => Show (Color (LUV i) e) where+  showsPrec _ = showsColorModel++-- | CIE1976 `LUV` color space+instance (Illuminant i, Elevator e) => ColorModel (LUV i) e where+  type Components (LUV i) e = (e, e, e)+  toComponents (ColorLUV l' u' v') = (l', u', v')+  {-# INLINE toComponents #-}+  fromComponents (l', u', v') = ColorLUV l' u' v'+  {-# INLINE fromComponents #-}++instance (Illuminant i, Elevator e, RealFloat e) => ColorSpace (LUV (i :: k)) i e where+  type BaseModel (LUV i) = LUV i+  type BaseSpace (LUV i) = LUV i+  toBaseSpace = id+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = id+  {-# INLINE fromBaseSpace #-}+  luminance (ColorLUV l' _ _) = Y (ift (scaleLightness l'))+  {-# INLINE luminance #-}+  toColorXYZ = luv2xyz+  {-# INLINE toColorXYZ #-}+  fromColorXYZ = xyz2luv+  {-# INLINE fromColorXYZ #-}++luv2xyz ::+     forall i a e. (Illuminant i, Elevator e, Elevator a, RealFloat a)+  => Color (LUV i) e+  -> Color (XYZ i) a+luv2xyz (ColorLUV l' u' v') = ColorXYZ x y z+  where+    !(ColorXYZ wx _ wz) = whitePointTristimulus :: Color (XYZ i) a+    !y = ift . scaleLightness $ l'+    !wxyz = wx + 15 + 3 * wz+    !l1 = 13 * toRealFloat l'+    !a = (1/3) * ((4 * l1 / (toRealFloat u' + l1 * 4 * (wx / wxyz))) - 1) :: a+    !b = -5 * y+    !c = -1 / 3+    !d = y * (3 * l1 / (toRealFloat v' + l1 * 9 * (1 / wxyz)) - 5) :: a+    !x = (d - b) / (a - c)+    !z = x * a + b+{-# INLINE luv2xyz #-}++scaleLightness :: (Elevator e, Elevator a, RealFloat a) => e -> a+scaleLightness l' = (toRealFloat l' + 16) / 116+{-# INLINE scaleLightness #-}++ift :: (Fractional a, Ord a) => a -> a+ift t+  | t > 6 / 29 = t ^ (3 :: Int)+  | otherwise = (108 / 841) * (t - 4 / 29)+++xyz2luv ::+     forall i a e. (Illuminant i, Elevator a, Elevator e, RealFloat e)+  => Color (XYZ i) a+  -> Color (LUV i) e+xyz2luv (ColorXYZ x y z) = ColorLUV l' u' v'+  where+    !l' = 116 * ft (toRealFloat y) - 16+    !(ColorXYZ wx _ wz) = whitePointTristimulus :: Color (XYZ i) e+    !xyz = toRealFloat $ x + 15 * y + 3 * z+    !wxyz = wx + 15 + 3 * wz+    !u' = 13 * l' * 4 * (toRealFloat x / xyz - wx / wxyz)+    !v' = 13 * l' * 9 * (toRealFloat y / xyz - 1 / wxyz)+{-# INLINE xyz2luv #-}++ft :: RealFloat a => a -> a+ft t+  | t > t0 = t ** (1 / 3)+  | otherwise = t * m + 4 / 29+{-# INLINE ft #-}++m :: RealFloat a => a+m = 841 / 108++t0 :: RealFloat a => a+t0 = 216 / 24389+  -- where+  --   m = 1/3 * δ^-2 = 841/108 =~ 7.787[037]+  --   t0 = δ^3 =~ 0.008856+  --   δ = 6/29 =~ 0.2069

@@ -0,0 +1,91 @@+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module: Graphics.Color.Space.CIE1976.LUV.LCH++module Graphics.Color.Space.CIE1976.LUV.LCH+  ( pattern ColorLCHuv+  , pattern ColorLCHuvA+  , LCHuv+  , Color(LCHuv)+  ) where++import Data.Coerce+import Data.Proxy+import Foreign.Storable+import qualified Graphics.Color.Model.LCH as CM+import Graphics.Color.Space.CIE1976.LUV+import Graphics.Color.Model.Internal+import Graphics.Color.Space.Internal++-- | [CIE L*C*Huv](https://en.wikipedia.org/wiki/CIELUV_color_space),+--   an LCH representation for the L*u*v* color space+data LCHuv (i :: k)++-- | Color in CIE L*C*Huv color space+newtype instance Color (LCHuv i) e = LCHuv (Color CM.LCH e)++-- | CIE1976 `LCHuv` color space+deriving instance Eq e => Eq (Color (LCHuv i) e)++-- | CIE1976 `LCHuv` color space+deriving instance Ord e => Ord (Color (LCHuv i) e)++-- | CIE1976 `LCHuv` color space+deriving instance Functor (Color (LCHuv i))++-- | CIE1976 `LCHuv` color space+deriving instance Applicative (Color (LCHuv i))++-- | CIE1976 `LCHuv` color space+deriving instance Foldable (Color (LCHuv i))++-- | CIE1976 `LCHuv` color space+deriving instance Traversable (Color (LCHuv i))++-- | CIE1976 `LCHuv` color space+deriving instance Storable e => Storable (Color (LCHuv i) e)++-- | CIE1976 `LCHuv` color space+instance (Illuminant i, Elevator e) => Show (Color (LCHuv i) e) where+  showsPrec _ = showsColorModel++-- | Constructor for a CIEL*u*v* color space in a cylindrical L*C*h parameterization+pattern ColorLCHuv :: e -> e -> e -> Color (LCHuv i) e+pattern ColorLCHuv l c h = LCHuv (CM.ColorLCH l c h)+{-# COMPLETE ColorLCHuv #-}++-- | Constructor for a @LCHuv@ with alpha+pattern ColorLCHuvA :: e -> e -> e -> e -> Color (Alpha (LCHuv i)) e+pattern ColorLCHuvA l c h a = Alpha (LCHuv (CM.ColorLCH l c h)) a+{-# COMPLETE ColorLCHuvA #-}++-- | CIE1976 `LCHuv` color space+instance (Illuminant i, Elevator e, ColorModel (LUV i) e) => ColorModel (LCHuv i) e where+  type Components (LCHuv i) e = (e, e, e)+  toComponents = toComponents . coerce+  {-# INLINE toComponents #-}+  fromComponents = coerce . fromComponents+  {-# INLINE fromComponents #-}+  showsColorModelName _ =+    ("LCH-"++) . showsColorModelName (Proxy :: Proxy (Color (LUV i) e))++instance (Illuminant i, Elevator e, ColorSpace (LUV i) i e) => ColorSpace (LCHuv i) i e where+  type BaseModel (LCHuv i) = CM.LCH+  type BaseSpace (LCHuv i) = LUV i+  toBaseSpace = fmap fromDouble . fromComponents . CM.lch2lxy . fmap toDouble . coerce+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = coerce . fmap fromDouble . CM.lxy2lch . toComponents . fmap toDouble+  {-# INLINE fromBaseSpace #-}+  luminance = luminance . toBaseSpace+  {-# INLINE luminance #-}

@@ -1,4 +1,3 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-}

@@ -0,0 +1,14 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeApplications #-}+module Graphics.Color.Model.LCHSpec (spec) where++import Graphics.Color.Model+import Graphics.Color.Model.Common++instance (Elevator e, Random e) => Arbitrary (Color LCH e) where+  arbitrary = ColorLCH <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator++spec :: Spec+spec =+  describe "LCH" $ do+    colorModelSpec @LCH @Word "LCH"

@@ -0,0 +1,29 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Graphics.Color.Space.CIE1976.LAB.LCHSpec (spec) where++import Data.Coerce ( coerce )+import Graphics.Color.Model ( lxy2lch, lch2lxy )+import Graphics.Color.Space.Common+import Graphics.Color.Space.CIE1976.LABSpec ()+import Graphics.Color.Space.CIE1976.LAB.LCH++instance (Elevator e, Random e) => Arbitrary (Color (LCHab i) e) where+  arbitrary = ColorLCHab <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator++spec :: Spec+spec =+  describe "LCHab" $ do+    colorModelSpec @(LCHab D65) @Word "LCH"+    colorSpaceSpec @(LCHab D65) @Double+    prop "lab2lch . lch2lab" $ \(lab :: Color (LAB D65) Double) ->+      lab `epsilonEqColor` lch2lab (lab2lch lab)+    prop "lch2lab . lab2lch" $ \(lch :: Color (LCHab D65) Double) ->+      lch `epsilonEqColor` lab2lch (lch2lab lch)++lab2lch :: Illuminant i => Color (LAB i) Double -> Color (LCHab i) Double+lab2lch = coerce . lxy2lch . toComponents++lch2lab :: Illuminant i => Color (LCHab i) Double -> Color (LAB i) Double+lch2lab = fromComponents . lch2lxy . coerce

@@ -0,0 +1,30 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Graphics.Color.Space.CIE1976.LUV.LCHSpec (spec) where++import Data.Coerce ( coerce )+import Graphics.Color.Model ( lxy2lch, lch2lxy )+import Graphics.Color.Space.Common+import Graphics.Color.Space.CIE1976.LUV+import Graphics.Color.Space.CIE1976.LUVSpec ()+import Graphics.Color.Space.CIE1976.LUV.LCH++instance (Elevator e, Random e) => Arbitrary (Color (LCHuv i) e) where+  arbitrary = ColorLCHuv <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator++spec :: Spec+spec =+  describe "LCHuv" $ do+    colorModelSpec @(LCHuv D65) @Word "LCH"+    colorSpaceSpec @(LCHuv D65) @Double+    prop "luv2lch . lch2luv" $ \(luv :: Color (LUV D65) Double) ->+      luv `epsilonEqColor` lch2luv (luv2lch luv)+    prop "lch2luv . luv2lch" $ \(lch :: Color (LCHuv D65) Double) ->+      lch `epsilonEqColor` luv2lch (lch2luv lch)++luv2lch :: Illuminant i => Color (LUV i) Double -> Color (LCHuv i) Double+luv2lch = coerce . lxy2lch . toComponents++lch2luv :: Illuminant i => Color (LCHuv i) Double -> Color (LUV i) Double+lch2luv = fromComponents . lch2lxy . coerce

@@ -0,0 +1,18 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeApplications #-}+module Graphics.Color.Space.CIE1976.LUVSpec (spec) where++import Graphics.Color.Illuminant.CIE1931 as I2+import Graphics.Color.Space.Common+import Graphics.Color.Space.CIE1976.LUV++instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (LUV (i :: k)) e) where+  arbitrary = ColorLUV <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator+++spec :: Spec+spec = describe "LUV" $ do+  colorModelSpec @(LUV 'D65) @Word "LUV"+  colorSpaceLenientSpec @(LUV 'D65) @Double 1e-10