diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,14 @@
 # Changelog for Color
 
+## 0.4.0
+
+* Addition of `DIN99` color space.
+* Scale `L*a*b*` color space to `[0, 1]` range from the more common `[0, 100]` for
+  consistency.
+* Addition of: `toGrayscale`, `applyGrayscale` and `replaceGrayscale`.
+* Addition of: `ChannelCount`, `channelCount`, `channelNames` and `channelColors`
+* Remove `RealFloat` constraint from `ColorSpace` for `Y'`
+
 ## 0.3.3
 
 Addition of `SVG` colors
diff --git a/Color.cabal b/Color.cabal
--- a/Color.cabal
+++ b/Color.cabal
@@ -1,5 +1,5 @@
 name:                Color
-version:             0.3.3
+version:             0.4.0
 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
@@ -7,11 +7,11 @@
 license-file:        LICENSE
 author:              Alexey Kuleshevich
 maintainer:          alexey@kuleshevi.ch
-copyright:           2019-2021 Alexey Kuleshevich
+copyright:           2019-2025 Alexey Kuleshevich
 category:            Graphics
 extra-source-files:  README.md
-                   , CHANGELOG.md
-extra-doc-files:     files/*.svg
+extra-doc-files:     CHANGELOG.md
+                   , files/*.svg
                    , files/svg/*.png
 cabal-version:       1.18
 build-type:          Simple
@@ -19,7 +19,13 @@
                     , GHC == 8.6.5
                     , GHC == 8.8.6
                     , GHC == 8.10.7
-                    , GHC == 9.0.1
+                    , GHC == 9.0.2
+                    , GHC == 9.2.8
+                    , GHC == 9.4.8
+                    , GHC == 9.6.6
+                    , GHC == 9.8.4
+                    , GHC == 9.10.1
+                    , GHC == 9.12.1
 
 library
   hs-source-dirs:      src
@@ -44,6 +50,7 @@
                      , Graphics.Color.Space.CIE1976.LAB.LCH
                      , Graphics.Color.Space.CIE1976.LUV
                      , Graphics.Color.Space.CIE1976.LUV.LCH
+                     , Graphics.Color.Space.DIN99
                      , Graphics.Color.Space.RGB
                      , Graphics.Color.Space.RGB.CIERGB
                      , Graphics.Color.Space.RGB.AdobeRGB
@@ -96,7 +103,8 @@
   ghc-options:         -Wall
                        -Wincomplete-record-updates
                        -Wincomplete-uni-patterns
-                       -Wredundant-constraints
+  if impl(ghc < 9.0) || impl(ghc >= 9.6)
+    ghc-options:   -Wredundant-constraints
 
 test-suite tests
   type:               exitcode-stdio-1.0
@@ -159,25 +167,6 @@
                       -threaded
                       -freduction-depth=0
 
-test-suite doctests
-  type:             exitcode-stdio-1.0
-  hs-source-dirs:   tests
-  main-is:          doctests.hs
-  build-depends: base
-  if impl(ghc >= 8.2) && impl(ghc < 8.10)
-    build-depends: doctest >=0.16
-                 , QuickCheck
-                 , Color
-                 , JuicyPixels
-  default-language:    Haskell2010
-  ghc-options:        -Wall
-                      -Wincomplete-record-updates
-                      -Wincomplete-uni-patterns
-                      -Wredundant-constraints
-                      -fno-warn-orphans
-                      -threaded
-
-
 benchmark conversion
   type:                exitcode-stdio-1.0
   hs-source-dirs:      bench
@@ -191,6 +180,19 @@
                      , colour
                      , deepseq
                      , random
+  default-language:    Haskell2010
+
+benchmark ycbcr
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      bench
+  main-is:             YCbCr.hs
+  ghc-options:         -Wall
+                       -threaded
+                       -O2
+  build-depends:       base
+                     , criterion
+                     , Color
+                     , deepseq
   default-language:    Haskell2010
 
 source-repository head
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright Alexey Kuleshevich (c) 2019-2020
+Copyright Alexey Kuleshevich (c) 2019-2025
 
 All rights reserved.
 
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -38,6 +38,7 @@
   * `Y'` - luma
   * `CIE XYZ`
   * `CIE L*a*b*`
+  * `DIN99`
   * `RGB`:
 
     * `sRGB` - both standardized and derived
@@ -72,6 +73,73 @@
   * RAL
   * SVG
 
+## Example
+
+Here is a short example how this library can be used. Here we assume a GHCi session that
+can be started like so:
+
+```shell
+$ stack ghci --package Color
+```
+
+### Perceived lightness
+
+Let's say we need find the perceived lightness as described in [this StackOverflow
+answer](https://stackoverflow.com/questions/596216/formula-to-determine-perceived-brightness-of-rgb-color/56678483#56678483)
+for an RGB triple `(128, 255, 65) :: (Word8, Word8, Word8)`.
+
+Before we can attempt getting the lightness we need to do these two things:
+
+1. Figure out what is the color space of the `RGB` triplet? In particular the `Illuminant`
+   and the `Linearity` of the `RGB` color space.
+2. Convert your `RGB` color to [`CIE
+   L*a*b*`](https://en.wikipedia.org/wiki/CIELAB_color_space) and then we can get the `L*`
+   out, which is the perceived lightness.
+
+More often than not an RGB image will be encoded in non-linear sRGB color space with 8 bits
+per channel, so we'll use that for this example:
+
+```haskell
+ghci> :set -XDataKinds
+ghci> import Graphics.Color.Space
+ghci> let rgb8 = ColorSRGB 128 255 65 :: Color (SRGB 'NonLinear) Word8
+ghci> print rgb8
+<SRGB 'NonLinear:(128,255, 65)>
+```
+
+Before we convert `sRGB` to `CIE L*a*b*` color space we need to increase the precision to
+`Double`, because for now `Word8` is not supported by the `LAB` color space implementation:
+
+```haskell
+ghci> let rgb = toDouble <$> rgb8
+ghci> print rgb
+<SRGB 'NonLinear:( 0.5019607843137255, 1.0000000000000000, 0.2549019607843137)>
+```
+
+In order to convert to another color space without changing the `Illuminant` we can use
+`convertColor` function. So here is how we convert to CIELAB and extract the perceived
+lightness `L*`:
+
+```haskell
+ghci> let lab@(ColorLAB l _ _) = convertColor rgb :: Color (LAB D65) Double
+ghci> lab
+<LAB * D65:(90.0867507593648500,-65.7999116680496000,74.4643898323530600)>
+ghci> l
+90.08675075936485
+```
+
+### Color adaptation
+
+When a change of `Illuminant` is also needed during color space conversion we can use
+`convert` function
+
+```haskell
+ghci> import Graphics.Color.Adaptation (convert)
+ghci> import qualified Graphics.Color.Illuminant.CIE1964 as CIE1964
+ghci> let lab@(ColorLAB l _ _) = convert rgb :: Color (LAB 'CIE1964.D50) Double
+ghci> lab
+<LAB CIE1964 'D50:(90.2287735564601500,-59.3846969983265500,72.9304679742930800)>
+```
 
 ## External resources
 
diff --git a/bench/YCbCr.hs b/bench/YCbCr.hs
new file mode 100644
--- /dev/null
+++ b/bench/YCbCr.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Main where
+
+import Criterion.Main
+import Control.DeepSeq
+import qualified Graphics.Color.Model as CM
+import Graphics.Color.Space
+import Graphics.Color.Space.RGB.ITU.Rec601
+import Graphics.Color.Space.RGB.ITU.Rec709
+import Data.Coerce
+
+main :: IO ()
+main = do
+  defaultMain
+    [ bgroup
+        "toYCbCr"
+        [ toYCbCrBench (CM.ColorRGB 0.1 0.2 0.3 :: Color CM.RGB Float) "Float"
+        , toYCbCrBench (CM.ColorRGB 0.1 0.2 0.3 :: Color CM.RGB Double) "Double"
+        ]
+    , bgroup
+        "fromYCbCr"
+        [ fromYCbCrBench (CM.ColorYCbCr 0.1 0.2 0.3 :: Color CM.YCbCr Float) "Float"
+        , fromYCbCrBench (CM.ColorYCbCr 0.1 0.2 0.3 :: Color CM.YCbCr Double) "Double"
+        ]
+    ]
+
+
+toYCbCrBench ::
+     forall e. (Elevator e, NFData e)
+  => Color CM.RGB e
+  -> String
+  -> Benchmark
+toYCbCrBench rgb tyName =
+  bgroup
+    tyName
+    [ bgroup
+        "Standard"
+        [ bench "SRGB" $
+          nf (fromBaseSpace :: Color (SRGB 'NonLinear) e -> Color (Y'CbCr SRGB) e) (mkColorRGB rgb)
+        , bench "Rec601" $
+          nf
+            (fromBaseSpace :: Color (BT601_625 'NonLinear) e -> Color (Y'CbCr BT601_625) e)
+            (mkColorRGB rgb)
+        , bench "Rec709" $
+          nf (fromBaseSpace :: Color (BT709 'NonLinear) e -> Color (Y'CbCr BT709) e) (mkColorRGB rgb)
+        ]
+    ]
+
+fromYCbCrBench ::
+     forall e. (Elevator e, NFData e)
+  => Color CM.YCbCr e
+  -> String
+  -> Benchmark
+fromYCbCrBench ycbcr tyName =
+  bgroup
+    tyName
+    [ bgroup
+        "Standard"
+        [ bench "SRGB" $
+          nf (toBaseSpace :: Color (Y'CbCr SRGB) e -> Color (SRGB 'NonLinear) e) (coerce ycbcr)
+        , bench "Rec601" $
+          nf
+            (toBaseSpace :: Color (Y'CbCr BT601_625) e -> Color (BT601_625 'NonLinear) e)
+            (coerce ycbcr)
+        , bench "Rec709" $
+          nf (toBaseSpace :: Color (Y'CbCr BT709) e -> Color (BT709 'NonLinear) e) (coerce ycbcr)
+        ]
+    ]
diff --git a/src/Graphics/Color/Adaptation.hs b/src/Graphics/Color/Adaptation.hs
--- a/src/Graphics/Color/Adaptation.hs
+++ b/src/Graphics/Color/Adaptation.hs
@@ -1,6 +1,6 @@
 -- |
 -- Module      : Graphics.Color.Adaptation
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Adaptation/Internal.hs b/src/Graphics/Color/Adaptation/Internal.hs
--- a/src/Graphics/Color/Adaptation/Internal.hs
+++ b/src/Graphics/Color/Adaptation/Internal.hs
@@ -4,9 +4,10 @@
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 -- |
 -- Module      : Graphics.Color.Adaptation.Internal
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Adaptation/VonKries.hs b/src/Graphics/Color/Adaptation/VonKries.hs
--- a/src/Graphics/Color/Adaptation/VonKries.hs
+++ b/src/Graphics/Color/Adaptation/VonKries.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -5,10 +6,15 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+#if __GLASGOW_HASKELL__ >= 906
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+#else
 {-# LANGUAGE TypeInType #-}
+#endif
 -- |
 -- Module      : Graphics.Color.Adaptation.VonKries
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Algebra.hs b/src/Graphics/Color/Algebra.hs
--- a/src/Graphics/Color/Algebra.hs
+++ b/src/Graphics/Color/Algebra.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 -- |
 -- Module      : Graphics.Color.Algebra
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -33,9 +33,11 @@
 
 import Data.Typeable
 import Foreign.Ptr
-import Control.Applicative
 import Foreign.Storable
 import Graphics.Color.Algebra.Elevator
+#if MIN_VERSION_base(4,10,0) && !MIN_VERSION_base(4,18,0)
+import Control.Applicative (liftA2)
+#endif
 
 
 --------
diff --git a/src/Graphics/Color/Algebra/Binary.hs b/src/Graphics/Color/Algebra/Binary.hs
--- a/src/Graphics/Color/Algebra/Binary.hs
+++ b/src/Graphics/Color/Algebra/Binary.hs
@@ -8,7 +8,7 @@
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Algebra.Binary
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -31,7 +31,7 @@
 import Foreign.Storable
 import Graphics.Color.Algebra.Elevator
 import Prelude hiding (map)
-
+import Data.Coerce
 
 -- | Under the hood, binary pixels are backed by `Word8`, but can only take
 -- values of @0@ or @1@. Use `zero`\/`one` to construct a bit and `on`\/`off` to
@@ -43,35 +43,32 @@
   show (Bit 0) = "0"
   show _       = "1"
 
+cf :: (Word8 -> Word8) -> Bit -> Bit
+cf = coerce
 
+cf2 :: (Word8 -> Word8 -> Word8) -> Bit -> Bit -> Bit
+cf2 = coerce
+
 instance Bits Bit where
-  (Bit 0) .&. _       = Bit 0
-  (Bit 1) .&. (Bit 1) = Bit 1
-  _       .&. (Bit 0) = Bit 0
-  _       .&. _       = Bit 1
+  (.&.) = cf2 (.&.)
   {-# INLINE (.&.) #-}
-  (Bit 1) .|. _       = Bit 1
-  (Bit 0) .|. (Bit 0) = Bit 0
-  _       .|. _       = Bit 1
+  (.|.) = cf2 (.|.)
   {-# INLINE (.|.) #-}
-  (Bit 0) `xor` (Bit 0) = Bit 0
-  (Bit 1) `xor` (Bit 1) = Bit 0
-  _       `xor` _       = Bit 1
+  xor = cf2 xor
   {-# INLINE xor #-}
-  complement (Bit 0) = Bit 1
-  complement       _ = Bit 0
+  complement = cf complement
   {-# INLINE complement #-}
   shift !b 0 = b
   shift  _ _ = Bit 0
   {-# INLINE shift #-}
   rotate !b _ = b
   {-# INLINE rotate #-}
-  zeroBits = Bit 0
+  zeroBits = zero
   {-# INLINE zeroBits #-}
-  bit 0 = Bit 1
-  bit _ = Bit 0
+  bit 0 = one
+  bit _ = zero
   {-# INLINE bit #-}
-  testBit (Bit 1) 0 = True
+  testBit (Bit b) 0 = b /= 0
   testBit _       _ = False
   {-# INLINE testBit #-}
   bitSizeMaybe _ = Just 1
@@ -119,24 +116,23 @@
 
 
 zero :: Bit
-zero = Bit 0
+zero = coerce (0x00 :: Word8)
 {-# INLINE zero #-}
 
 one :: Bit
-one = Bit 1
+one = coerce (0xff :: Word8)
 {-# INLINE one #-}
 
 
 -- | Values: @0@ and @1@
 instance Elevator Bit where
-  minValue = Bit 0
+  minValue = Bit 0x00
   {-# INLINE minValue #-}
-  maxValue = Bit 1
+  maxValue = Bit 0xff
   {-# INLINE maxValue #-}
   toShowS (Bit 0) = ('0':)
   toShowS _       = ('1':)
-  toWord8 (Bit 0) = 0
-  toWord8 _       = maxBound
+  toWord8 = coerce
   {-# INLINE toWord8 #-}
   toWord16 (Bit 0) = 0
   toWord16 _       = maxBound
@@ -153,10 +149,10 @@
   toRealFloat (Bit 0) = 0
   toRealFloat _       = 1
   {-# INLINE toRealFloat #-}
-  fromRealFloat 0 = Bit 0
-  fromRealFloat _ = Bit 1
+  fromRealFloat 0 = zero
+  fromRealFloat _ = one
   {-# INLINE fromRealFloat #-}
-  (//) (Bit x) (Bit y) = Bit (x `div` y)
+  (//) = cf2 div
   {-# INLINE (//) #-}
 
 
@@ -167,9 +163,9 @@
   -- 0 - 1 = 0
   -- 1 - 0 = 1
   -- 1 - 1 = 0
-  (Bit 0) - (Bit 0) = Bit 0
-  _       - (Bit 0) = Bit 1
-  _       - _       = Bit 0
+  (Bit 0) - (Bit 0) = zero
+  _       - (Bit 0) = one
+  _       - _       = zero
   {-# INLINE (-) #-}
   (*) = (.&.)
   {-# INLINE (*) #-}
@@ -177,8 +173,8 @@
   {-# INLINE abs #-}
   signum      = id
   {-# INLINE signum #-}
-  fromInteger 0 = Bit 0
-  fromInteger _ = Bit 1
+  fromInteger 0 = zero
+  fromInteger _ = one
   {-# INLINE fromInteger #-}
 
 -- | Unboxing of a `Bit`.
diff --git a/src/Graphics/Color/Algebra/Elevator.hs b/src/Graphics/Color/Algebra/Elevator.hs
--- a/src/Graphics/Color/Algebra/Elevator.hs
+++ b/src/Graphics/Color/Algebra/Elevator.hs
@@ -5,7 +5,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 -- |
 -- Module      : Graphics.Color.Algebra.Elevator
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -135,7 +135,9 @@
 
 -- | Differs from `fromIntegral` due to: [GHC #17782](https://gitlab.haskell.org/ghc/ghc/issues/17782)
 --
--- >>> fromIntegral (maxBound :: Word64) :: Double
+-- This is the value for ghc < 9.2
+--
+-- > fromIntegral (maxBound :: Word64) :: Double
 -- 1.844674407370955e19
 --
 maxWord64 :: Double
diff --git a/src/Graphics/Color/Illuminant/CIE1931.hs b/src/Graphics/Color/Illuminant/CIE1931.hs
--- a/src/Graphics/Color/Illuminant/CIE1931.hs
+++ b/src/Graphics/Color/Illuminant/CIE1931.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE DataKinds #-}
 -- |
 -- Module      : Graphics.Color.Illuminant.CIE1931
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Illuminant/CIE1964.hs b/src/Graphics/Color/Illuminant/CIE1964.hs
--- a/src/Graphics/Color/Illuminant/CIE1964.hs
+++ b/src/Graphics/Color/Illuminant/CIE1964.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Illuminant.CIE1964
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Illuminant/ICC/PCS.hs b/src/Graphics/Color/Illuminant/ICC/PCS.hs
--- a/src/Graphics/Color/Illuminant/ICC/PCS.hs
+++ b/src/Graphics/Color/Illuminant/ICC/PCS.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE DataKinds #-}
 -- |
 -- Module      : Graphics.Color.Illuminant.ICC.PCS
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Illuminant/ITU/Rec470.hs b/src/Graphics/Color/Illuminant/ITU/Rec470.hs
--- a/src/Graphics/Color/Illuminant/ITU/Rec470.hs
+++ b/src/Graphics/Color/Illuminant/ITU/Rec470.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE DataKinds #-}
 -- |
 -- Module      : Graphics.Color.Illuminant.ITU.Rec470
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Illuminant/ITU/Rec601.hs b/src/Graphics/Color/Illuminant/ITU/Rec601.hs
--- a/src/Graphics/Color/Illuminant/ITU/Rec601.hs
+++ b/src/Graphics/Color/Illuminant/ITU/Rec601.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE DataKinds #-}
 -- |
 -- Module      : Graphics.Color.Illuminant.ITU.Rec601
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Illuminant/Wikipedia.hs b/src/Graphics/Color/Illuminant/Wikipedia.hs
--- a/src/Graphics/Color/Illuminant/Wikipedia.hs
+++ b/src/Graphics/Color/Illuminant/Wikipedia.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE DataKinds #-}
 -- |
 -- Module      : Graphics.Color.Illuminant.Wikipedia
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Model.hs b/src/Graphics/Color/Model.hs
--- a/src/Graphics/Color/Model.hs
+++ b/src/Graphics/Color/Model.hs
@@ -1,6 +1,6 @@
 -- |
 -- Module      : Graphics.Color.Model
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -8,6 +8,7 @@
 --
 module Graphics.Color.Model
   ( ColorModel(..)
+  , channelRgbColors
   -- * Alpha
   , Alpha
   , Opaque
@@ -50,3 +51,13 @@
 import Graphics.Color.Model.RGB
 import Graphics.Color.Model.X
 import Graphics.Color.Model.YCbCr
+import Data.Coerce
+import Data.Proxy
+import Data.List.NonEmpty
+
+-- | Uses `channelColors` to produce actual `RGB` colors for each
+-- channel. Useful for plotting.
+--
+-- @0.4.0
+channelRgbColors :: ColorModel cs e => Proxy (Color cs e) -> NonEmpty (Color RGB Word8)
+channelRgbColors = coerce . channelColors
diff --git a/src/Graphics/Color/Model/CMYK.hs b/src/Graphics/Color/Model/CMYK.hs
--- a/src/Graphics/Color/Model/CMYK.hs
+++ b/src/Graphics/Color/Model/CMYK.hs
@@ -1,14 +1,15 @@
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Model.CMYK
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -25,6 +26,7 @@
   , rgb2cmyk
   ) where
 
+import Data.List.NonEmpty
 import Foreign.Storable
 import Graphics.Color.Model.Internal
 import Graphics.Color.Model.RGB
@@ -55,6 +57,14 @@
 -- | `CMYK` color model
 instance Elevator e => ColorModel CMYK e where
   type Components CMYK e = (e, e, e, e)
+  type ChannelCount CMYK = 4
+  channelCount _ = 4
+  {-# INLINE channelCount #-}
+  channelNames _ = "Cyan" :| ["Magenta", "Yellow", "Key"]
+  channelColors _ = V3 0x00 0xff 0xff :|
+                  [ V3 0xff 0x00 0xff
+                  , V3 0xff 0xff 0x00
+                  , V3 0xff 0xff 0xff ]
   toComponents (ColorCMYK c m y k) = (c, m, y, k)
   {-# INLINE toComponents #-}
   fromComponents (c, m, y, k) = ColorCMYK c m y k
@@ -69,7 +79,7 @@
 instance Applicative (Color CMYK) where
   pure !e = ColorCMYK e e e e
   {-# INLINE pure #-}
-  (ColorCMYK fc fm fy fk) <*> (ColorCMYK c m y k) = ColorCMYK (fc c) (fm m) (fy y) (fk k)
+  ColorCMYK fc fm fy fk <*> ColorCMYK c m y k = ColorCMYK (fc c) (fm m) (fy y) (fk k)
   {-# INLINE (<*>) #-}
 
 -- | `CMYK` color model
diff --git a/src/Graphics/Color/Model/HSI.hs b/src/Graphics/Color/Model/HSI.hs
--- a/src/Graphics/Color/Model/HSI.hs
+++ b/src/Graphics/Color/Model/HSI.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -11,7 +12,7 @@
 {-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Color.Model.HSI
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -23,12 +24,13 @@
   , pattern ColorHSI
   , pattern ColorHSIA
   , pattern ColorH360SI
-  , Color
+  , Color(..)
   , ColorModel(..)
   , hsi2rgb
   , rgb2hsi
   ) where
 
+import Data.List.NonEmpty
 import Foreign.Storable
 import Graphics.Color.Model.Internal
 import Graphics.Color.Model.RGB
@@ -85,6 +87,11 @@
 -- | `HSI` color model
 instance Elevator e => ColorModel HSI e where
   type Components HSI e = (e, e, e)
+  type ChannelCount HSI = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = "Hue" :| ["Saturation", "Intensity"]
+  channelColors _ = V3 0x94 0x00 0xd3 :| [V3 0xff 0x8c 0x00, V3 0x00 0xce 0xd1]
   toComponents (ColorHSI h s i) = (h, s, i)
   {-# INLINE toComponents #-}
   fromComponents (h, s, i) = ColorHSI h s i
diff --git a/src/Graphics/Color/Model/HSL.hs b/src/Graphics/Color/Model/HSL.hs
--- a/src/Graphics/Color/Model/HSL.hs
+++ b/src/Graphics/Color/Model/HSL.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -11,7 +12,7 @@
 {-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Color.Model.HSL
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -23,13 +24,14 @@
   , pattern ColorHSL
   , pattern ColorHSLA
   , pattern ColorH360SL
-  , Color
+  , Color(..)
   , ColorModel(..)
   , hc2rgb
   , hsl2rgb
   , rgb2hsl
   ) where
 
+import Data.List.NonEmpty
 import Foreign.Storable
 import Graphics.Color.Model.HSV (hc2rgb)
 import Graphics.Color.Model.Internal
@@ -86,6 +88,11 @@
 -- | `HSL` color model
 instance Elevator e => ColorModel HSL e where
   type Components HSL e = (e, e, e)
+  type ChannelCount HSL = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = "Hue" :| ["Saturation", "Lightness"]
+  channelColors _ = V3 0x94 0x00 0xd3 :| [V3 0xff 0x8c 0x00, V3 0xaf 0xee 0xee]
   toComponents (ColorHSL h s l) = (h, s, l)
   {-# INLINE toComponents #-}
   fromComponents (h, s, l) = ColorHSL h s l
@@ -104,9 +111,11 @@
   where
     !max' = max r (max g b)
     !min' = min r (min g b)
-    !h' | max' == r = (    (g - b) / (max' - min')) / 6
-        | max' == g = (2 + (b - r) / (max' - min')) / 6
-        | max' == b = (4 + (r - g) / (max' - min')) / 6
+    !c' = max' - min'
+    !h' | c'   == 0 = 0
+        | max' == r = (    (g - b) / c') / 6
+        | max' == g = (2 + (b - r) / c') / 6
+        | max' == b = (4 + (r - g) / c') / 6
         | otherwise = 0
     !h
       | h' < 0 = h' + 1
diff --git a/src/Graphics/Color/Model/HSV.hs b/src/Graphics/Color/Model/HSV.hs
--- a/src/Graphics/Color/Model/HSV.hs
+++ b/src/Graphics/Color/Model/HSV.hs
@@ -1,8 +1,9 @@
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -11,7 +12,7 @@
 {-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Color.Model.HSV
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -23,13 +24,14 @@
   , pattern ColorHSV
   , pattern ColorHSVA
   , pattern ColorH360SV
-  , Color
+  , Color(..)
   , ColorModel(..)
   , hc2rgb
   , hsv2rgb
   , rgb2hsv
   ) where
 
+import Data.List.NonEmpty
 import Foreign.Storable
 import Graphics.Color.Model.Internal
 import Graphics.Color.Model.RGB
@@ -85,6 +87,11 @@
 -- | `HSV` color model
 instance Elevator e => ColorModel HSV e where
   type Components HSV e = (e, e, e)
+  type ChannelCount HSV = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = "Hue" :| ["Saturation", "Value"]
+  channelColors _ = V3 0x94 0x00 0xd3 :| [V3 0xff 0x8c 0x00, V3 0x5f 0x9e 0x90]
   toComponents (ColorHSV h s v) = (h, s, v)
   {-# INLINE toComponents #-}
   fromComponents (h, s, v) = ColorHSV h s v
@@ -120,15 +127,17 @@
   where
     !max' = max r (max g b)
     !min' = min r (min g b)
-    !h' | max' == r = (    (g - b) / (max' - min')) / 6
-        | max' == g = (2 + (b - r) / (max' - min')) / 6
-        | max' == b = (4 + (r - g) / (max' - min')) / 6
+    !c' = max' - min'
+    !h' | c'   == 0 = 0
+        | max' == r = (    (g - b) / c') / 6
+        | max' == g = (2 + (b - r) / c') / 6
+        | max' == b = (4 + (r - g) / c') / 6
         | otherwise = 0
     !h
       | h' < 0 = h' + 1
       | otherwise = h'
     !s
       | max' == 0 = 0
-      | otherwise = (max' - min') / max'
+      | otherwise = c' / max'
     !v = max'
 {-# INLINE rgb2hsv #-}
diff --git a/src/Graphics/Color/Model/Internal.hs b/src/Graphics/Color/Model/Internal.hs
--- a/src/Graphics/Color/Model/Internal.hs
+++ b/src/Graphics/Color/Model/Internal.hs
@@ -4,10 +4,11 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 -- |
 -- Module      : Graphics.Color.Model.Internal
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -43,10 +44,11 @@
   , VU.Vector(V_Color)
   ) where
 
-import Control.Applicative
+import qualified Control.Applicative as A
+import Data.List.NonEmpty as NE
 import Control.DeepSeq (NFData(rnf), deepseq)
 import Data.Default.Class (Default(..))
-import Data.Foldable
+import Data.Foldable as F
 import Data.Kind
 import Data.Typeable
 import qualified Data.Vector.Generic as V
@@ -75,12 +77,30 @@
       ) =>
       ColorModel cs e where
   type Components cs e :: Type
+  type ChannelCount cs :: Nat
   -- | Convert a Color to a representation suitable for storage as an unboxed
   -- element, usually a tuple of channels.
   toComponents :: Color cs e -> Components cs e
   -- | Convert from an elemnt representation back to a Color.
   fromComponents :: Components cs e -> Color cs e
 
+  -- | Number of channels in the color model (eg. RGB has three).
+  --
+  -- @since 0.4.0
+  channelCount :: Proxy (Color cs e) -> Word8
+
+  -- | Textual name for each of the channels
+  --
+  -- @since 0.4.0
+  channelNames :: Proxy (Color cs e) -> NonEmpty String
+
+  -- | Some non-white 8bit sRGB values for each of the channels that might or
+  -- might not have some meaningful visual relation to the actual channel
+  -- names. This is useful for plotting values.
+  --
+  -- @since 0.4.0
+  channelColors :: Proxy (Color cs e) -> NonEmpty (V3 Word8)
+
   -- | Display the @cs@ portion of the pixel. Color itself will not be evaluated.
   --
   -- @since 0.1.0
@@ -94,11 +114,11 @@
 
 
 instance ColorModel cs e => Num (Color cs e) where
-  (+)         = liftA2 (+)
+  (+)         = A.liftA2 (+)
   {-# INLINE (+) #-}
-  (-)         = liftA2 (-)
+  (-)         = A.liftA2 (-)
   {-# INLINE (-) #-}
-  (*)         = liftA2 (*)
+  (*)         = A.liftA2 (*)
   {-# INLINE (*) #-}
   abs         = fmap abs
   {-# INLINE abs #-}
@@ -109,7 +129,7 @@
 
 
 instance (ColorModel cs e, Fractional e) => Fractional (Color cs e) where
-  (/)          = liftA2 (/)
+  (/)          = A.liftA2 (/)
   {-# INLINE (/) #-}
   recip        = fmap recip
   {-# INLINE recip #-}
@@ -219,7 +239,7 @@
   where
     t = asProxy px showsColorModelName
     channels =
-      case toList px of
+      case F.toList px of
         [] -> id
         (x:xs) -> foldl' (\facc y -> facc . (channelSeparator :) . toShowS y) (toShowS x) xs
 
@@ -357,6 +377,12 @@
 instance (ColorModel cs e, cs ~ Opaque (Alpha cs)) =>
          ColorModel (Alpha cs) e where
   type Components (Alpha cs) e = (Components cs e, e)
+  type ChannelCount (Alpha cs) = 1 + ChannelCount cs
+  channelCount _ = 1 + channelCount (Proxy :: Proxy (Color cs e))
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color cs e)) <> ("Alpha" :| [])
+  channelColors _ =
+    channelColors (Proxy :: Proxy (Color cs e)) <> (V3 0xe6 0xe6 0xfa :| []) -- <- lavander
   toComponents (Alpha px a) = (toComponents px, a)
   {-# INLINE toComponents #-}
   fromComponents (pxc, a) = Alpha (fromComponents pxc) a
diff --git a/src/Graphics/Color/Model/LCH.hs b/src/Graphics/Color/Model/LCH.hs
--- a/src/Graphics/Color/Model/LCH.hs
+++ b/src/Graphics/Color/Model/LCH.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -13,14 +14,15 @@
   -- * Constructors for an LCH color model.
   , pattern ColorLCH
   , pattern ColorLCHA
-  , Color
+  , Color(..)
   , ColorModel(..)
   , lch2lxy
   , lxy2lch
   ) where
 
-import Data.Complex ( Complex(..), polar, mkPolar )
-import Data.Fixed ( mod' )
+import Data.Complex (Complex(..), polar, mkPolar)
+import Data.Fixed (mod')
+import Data.List.NonEmpty
 import Foreign.Storable
 import Graphics.Color.Model.Internal
 
@@ -68,6 +70,14 @@
 -- | `LCH` color model
 instance Elevator e => ColorModel LCH e where
   type Components LCH e = (e, e, e)
+  type ChannelCount LCH = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = "Luminance" :| ["Chroma", "Hue"]
+  channelColors _ = V3 0x80 0x80 0x80 :|
+                  [ V3 0xff 0x00 0xff
+                  , V3 0xcc 0xff 0x33
+                  ]
   toComponents (ColorLCH l c h) = (l, c, h)
   {-# INLINE toComponents #-}
   fromComponents (l, c, h) = ColorLCH l c h
diff --git a/src/Graphics/Color/Model/RGB.hs b/src/Graphics/Color/Model/RGB.hs
--- a/src/Graphics/Color/Model/RGB.hs
+++ b/src/Graphics/Color/Model/RGB.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -10,7 +11,7 @@
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Model.RGB
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -26,6 +27,7 @@
   , ColorModel(..)
   ) where
 
+import Data.List.NonEmpty
 import Foreign.Storable
 import Graphics.Color.Algebra
 import Graphics.Color.Model.Internal
@@ -58,6 +60,14 @@
 -- | `RGB` color model
 instance Elevator e => ColorModel RGB e where
   type Components RGB e = (e, e, e)
+  type ChannelCount RGB = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = "Red" :| ["Green", "Blue"]
+  channelColors _ = V3 0xff 0x00 0x00 :|
+                  [ V3 0x00 0xff 0x00
+                  , V3 0x00 0x00 0xff
+                  ]
   toComponents (ColorRGB r g b) = (r, g, b)
   {-# INLINE toComponents #-}
   fromComponents (r, g, b) = ColorRGB r g b
diff --git a/src/Graphics/Color/Model/X.hs b/src/Graphics/Color/Model/X.hs
--- a/src/Graphics/Color/Model/X.hs
+++ b/src/Graphics/Color/Model/X.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -9,7 +10,7 @@
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Model.X
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -25,6 +26,7 @@
   , rgb2y
   ) where
 
+import Data.List.NonEmpty
 import Data.Coerce
 import Foreign.Storable
 import Graphics.Color.Model.Internal
@@ -65,6 +67,11 @@
 -- | `X` color model
 instance Elevator e => ColorModel X e where
   type Components X e = e
+  type ChannelCount X = 1
+  channelCount _ = 1
+  {-# INLINE channelCount #-}
+  channelNames _ = "Gray" :| []
+  channelColors _ = V3 0x80 0x80 0x80 :| []
   toComponents (X y) = y
   {-# INLINE toComponents #-}
   fromComponents = X
diff --git a/src/Graphics/Color/Model/YCbCr.hs b/src/Graphics/Color/Model/YCbCr.hs
--- a/src/Graphics/Color/Model/YCbCr.hs
+++ b/src/Graphics/Color/Model/YCbCr.hs
@@ -13,7 +13,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 -- |
 -- Module      : Graphics.Color.Model.YCbCr
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -28,6 +28,7 @@
   , ycbcr2rgb
   ) where
 
+import Data.List.NonEmpty
 import Foreign.Storable
 import Graphics.Color.Model.Internal
 import Graphics.Color.Model.RGB
@@ -72,6 +73,11 @@
 -- | `YCbCr` color model
 instance Elevator e => ColorModel YCbCr e where
   type Components YCbCr e = (e, e, e)
+  type ChannelCount YCbCr = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = "Luma" :| ["Blue Chroma Diff", "Red Chroma Diff"]
+  channelColors _ = V3 0x80 0x80 0x80 :| [V3 0x00 0x00 0x80, V3 0x8b 0x00 0x00]
   toComponents (ColorYCbCr y cb cr) = (y, cb, cr)
   {-# INLINE toComponents #-}
   fromComponents (y, cb, cr) = ColorYCbCr y cb cr
diff --git a/src/Graphics/Color/Space.hs b/src/Graphics/Color/Space.hs
--- a/src/Graphics/Color/Space.hs
+++ b/src/Graphics/Color/Space.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 -- |
 -- Module      : Graphics.Color.Space
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Space/CIE1931/RGB.hs b/src/Graphics/Color/Space/CIE1931/RGB.hs
--- a/src/Graphics/Color/Space/CIE1931/RGB.hs
+++ b/src/Graphics/Color/Space/CIE1931/RGB.hs
@@ -11,7 +11,7 @@
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Space.CIE1931.RGB
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -60,6 +60,11 @@
 -- | `CIERGB` color space
 instance (Typeable l, Elevator e) => ColorModel (CIERGB l) e where
   type Components (CIERGB l) e = (e, e, e)
+  type ChannelCount (CIERGB l) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.RGB e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.RGB e))
   toComponents = toComponents . unColorRGB
   {-# INLINE toComponents #-}
   fromComponents = mkColorRGB . fromComponents
@@ -74,6 +79,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLinearLuminance . castLinearity . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = toBaseModel . fmap fromDouble . luminance
+  {-# INLINE grayscale #-}
+  applyGrayscale c f = castLinearity (rgbLinearApplyGrayscale (castLinearity c) f)
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgbLinear2xyz . fmap toRealFloat . castLinearity
   {-# INLINE toColorXYZ #-}
   fromColorXYZ xyz = castLinearity (fromRealFloat <$> xyz2rgbLinear @CIERGB xyz)
@@ -94,4 +103,4 @@
 -- @since 0.2.0
 castLinearity :: Color (CIERGB l') e -> Color (CIERGB l) e
 castLinearity = coerce
-
+{-# INLINE castLinearity #-}
diff --git a/src/Graphics/Color/Space/CIE1931/XYZ.hs b/src/Graphics/Color/Space/CIE1931/XYZ.hs
--- a/src/Graphics/Color/Space/CIE1931/XYZ.hs
+++ b/src/Graphics/Color/Space/CIE1931/XYZ.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE PatternSynonyms #-}
 -- |
 -- Module      : Graphics.Color.Space.CIE1931.XYZ
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Space/CIE1976/LAB.hs b/src/Graphics/Color/Space/CIE1976/LAB.hs
--- a/src/Graphics/Color/Space/CIE1976/LAB.hs
+++ b/src/Graphics/Color/Space/CIE1976/LAB.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -11,7 +12,7 @@
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Space.CIE1976.LAB
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -23,8 +24,16 @@
   , pattern ColorLAB
   , pattern ColorLABA
   , LAB
+    -- * Helpers
+    -- ** XYZ to L*a*b*
+  , xyz2lab
+  , ft
+    -- ** L*a*b* to XYZ
+  , lab2xyz
+  , ift
   ) where
 
+import Data.List.NonEmpty
 import Foreign.Storable
 import Graphics.Color.Model.Internal
 import Graphics.Color.Space.Internal
@@ -34,6 +43,52 @@
 --------------
 
 -- | [CIE L*a*b*](https://en.wikipedia.org/wiki/CIELAB_color_space) color space
+--
+-- It is customary to have CIELAB color channels to be in range of [0, 100], however in
+-- this library all values for consistency are kept in a [0, 1] range for floating point
+-- precision.
+--
+-- Conversion from `XYZ` (`xyz2lab`):
+--
+-- \[
+-- \begin{align}
+--   L^\star &= 1.16 \  f\!\left(\frac{Y}{Y_{\mathrm{n}}}\right) - 0.16\\
+--   a^\star &= 5.0 \left(f\!\left(\frac{X}{X_{\mathrm{n}}}\right) - f\!\left(\frac{Y}{Y_{\mathrm{n}}}\right)\right)\\
+--   b^\star &= 2.0 \left(f\!\left(\frac{Y}{Y_{\mathrm{n}}}\right) - f\!\left(\frac{Z}{Z_{\mathrm{n}}}\right)\right)
+-- \end{align}
+-- \]
+--
+-- Where `ft` is defined as:
+--
+-- \[
+-- \begin{align}
+--   f(t) &= \begin{cases}
+--     \sqrt[3]{t} & \text{if } t > \delta^3 \\
+--     \dfrac{t}{3 \delta^2} + \frac{4}{29} & \text{otherwise}
+--   \end{cases} \\
+--   \delta &= \tfrac{6}{29}
+-- \end{align}
+-- \]
+--
+-- Conversion to `XYZ` (`lab2xyz`):
+--
+-- \[
+-- \begin{align}
+--   X &= X_{\mathrm{n}} f^{-1}\left(\frac{L^\star+0.16}{1.16} + \frac{a^\star}{5.0}\right)\\
+--   Y &= Y_{\mathrm{n}} f^{-1}\left(\frac{L^\star+0.16}{1.16}\right)\\
+--   Z &= Z_{\mathrm{n}} f^{-1}\left(\frac{L^\star+0.16}{1.16} - \frac{b^\star}{2.0}\right)\\
+-- \end{align}
+-- \]
+--
+-- Where `ift` is defined as:
+--
+-- \[
+-- f^{-1}(t) = \begin{cases}
+--   t^3 & \text{if } t > \delta \\
+--   3\delta^2\left(t - \tfrac{4}{29}\right) & \text{otherwise}
+-- \end{cases}
+-- \]
+--
 data LAB (i :: k)
 
 -- | Color in CIE L*a*b* color space
@@ -77,6 +132,14 @@
 -- | CIE1976 `LAB` color space
 instance (Illuminant i, Elevator e) => ColorModel (LAB i) e where
   type Components (LAB i) e = (e, e, e)
+  type ChannelCount (LAB i) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = "L*" :| ["a*", "b*"]
+  channelColors _ = V3 0x80 0x80 0x80 :| -- gray
+                  [ V3 0x00 0x64 0x00    -- dark green
+                  , V3 0x00 0x00 0x8b    -- dark blue
+                  ]
   toComponents (ColorLAB l' a' b') = (l', a', b')
   {-# INLINE toComponents #-}
   fromComponents (l', a', b') = ColorLAB l' a' b'
@@ -91,6 +154,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance (ColorLAB l' _ _) = Y (ift (scaleLightness l'))
   {-# INLINE luminance #-}
+  grayscale (ColorLAB l' _ _) = X l'
+  {-# INLINE grayscale #-}
+  replaceGrayscale (ColorLAB _ a' b') (X l') = ColorLAB l' a' b'
+  {-# INLINE replaceGrayscale #-}
   toColorXYZ = lab2xyz
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = xyz2lab
@@ -102,22 +169,22 @@
   -> Color (XYZ i) a
 lab2xyz (ColorLAB l' a' b') = ColorXYZ x y z
   where
-    !(ColorXYZ wx _ wz) = whitePointTristimulus :: Color (XYZ i) a
+    ColorXYZ wx _ wz = whitePointTristimulus :: Color (XYZ i) a
     !l = scaleLightness l'
-    !x = wx * ift (l + toRealFloat a' / 500)
+    !x = wx * ift (l + toRealFloat a' / 5)
     !y = ift l
-    !z = wz * ift (l - toRealFloat b' / 200)
+    !z = wz * ift (l - toRealFloat b' / 2)
 {-# INLINE lab2xyz #-}
 
 scaleLightness :: (Elevator e, Elevator a, RealFloat a) => e -> a
-scaleLightness l' = (toRealFloat l' + 16) / 116
+scaleLightness l' = (toRealFloat l' + 0.16) / 1.16
 {-# INLINE scaleLightness #-}
 
 ift :: (Fractional a, Ord a) => a -> a
 ift t
   | t > 6 / 29 = t ^ (3 :: Int)
   | otherwise = (108 / 841) * (t - 4 / 29)
-
+{-# INLINE ift #-}
 
 
 xyz2lab ::
@@ -126,13 +193,13 @@
   -> Color (LAB i) e
 xyz2lab (ColorXYZ x y z) = ColorLAB l' a' b'
   where
-    !(ColorXYZ wx _ wz) = whitePointTristimulus :: Color (XYZ i) e
+    ColorXYZ wx _ wz = whitePointTristimulus :: Color (XYZ i) e
     !fx = ft (toRealFloat x / wx)
     !fy = ft (toRealFloat y)
     !fz = ft (toRealFloat z / wz)
-    !l' = 116 * fy - 16
-    !a' = 500 * (fx - fy)
-    !b' = 200 * (fy - fz)
+    !l' = 1.16 * fy - 0.16
+    !a' = 5 * (fx - fy)
+    !b' = 2 * (fy - fz)
 {-# INLINE xyz2lab #-}
 
 ft :: RealFloat a => a -> a
diff --git a/src/Graphics/Color/Space/CIE1976/LAB/LCH.hs b/src/Graphics/Color/Space/CIE1976/LAB/LCH.hs
--- a/src/Graphics/Color/Space/CIE1976/LAB/LCH.hs
+++ b/src/Graphics/Color/Space/CIE1976/LAB/LCH.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -5,10 +6,11 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- |
 -- Module: Graphics.Color.Space.CIE1976.LAB.LCH
@@ -20,6 +22,7 @@
   , Color(LCHab)
   ) where
 
+import Data.List.NonEmpty
 import Data.Coerce
 import Data.Proxy
 import Foreign.Storable
@@ -73,9 +76,17 @@
 -- | 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
+  type ChannelCount (LCHab i) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = "L" :| ["Cab", "Hab"]
+  channelColors _ = V3 0x80 0x80 0x80 :|
+                  [ V3 0x99 0xff 0x99
+                  , V3 0x66 0x66 0xff
+                  ]
+  toComponents (LCHab lch) = toComponents lch
   {-# INLINE toComponents #-}
-  fromComponents = coerce . fromComponents
+  fromComponents = LCHab . fromComponents
   {-# INLINE fromComponents #-}
   showsColorModelName _ =
     ("LCH-"++) . showsColorModelName (Proxy :: Proxy (Color (LAB i) e))
@@ -83,9 +94,13 @@
 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
+  toBaseSpace (LCHab lch) = fmap fromDouble . fromComponents . CM.lch2lxy . fmap toDouble $ lch
   {-# INLINE toBaseSpace #-}
-  fromBaseSpace = coerce . fmap fromDouble . CM.lxy2lch . toComponents . fmap toDouble
+  fromBaseSpace = LCHab . fmap fromDouble . CM.lxy2lch . toComponents . fmap toDouble
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale (coerce -> V3 l _ _) = X l
+  {-# INLINE grayscale #-}
+  replaceGrayscale (coerce -> V3 _ c h) (X l) = coerce (V3 l c h)
+  {-# INLINE replaceGrayscale #-}
diff --git a/src/Graphics/Color/Space/CIE1976/LUV.hs b/src/Graphics/Color/Space/CIE1976/LUV.hs
--- a/src/Graphics/Color/Space/CIE1976/LUV.hs
+++ b/src/Graphics/Color/Space/CIE1976/LUV.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -9,6 +10,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Color.Space.CIE1976.LUV
 --
@@ -20,6 +22,8 @@
   , LUV
   ) where
 
+import Data.Coerce
+import Data.List.NonEmpty
 import Foreign.Storable
 import Graphics.Color.Model.Internal
 import Graphics.Color.Space.Internal
@@ -72,6 +76,14 @@
 -- | CIE1976 `LUV` color space
 instance (Illuminant i, Elevator e) => ColorModel (LUV i) e where
   type Components (LUV i) e = (e, e, e)
+  type ChannelCount (LUV i) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = "L" :| ["U", "V"]
+  channelColors _ = V3 0x80 0x80 0x80 :|
+                  [ V3 0x00 0xff 0xff
+                  , V3 0x00 0x00 0x00
+                  ]
   toComponents (ColorLUV l' u' v') = (l', u', v')
   {-# INLINE toComponents #-}
   fromComponents (l', u', v') = ColorLUV l' u' v'
@@ -86,6 +98,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance (ColorLUV l' _ _) = Y (ift (scaleLightness l'))
   {-# INLINE luminance #-}
+  grayscale (coerce -> V3 l _ _) = X l
+  {-# INLINE grayscale #-}
+  replaceGrayscale (coerce -> V3 _ c h) (X l) = coerce (V3 l c h)
+  {-# INLINE replaceGrayscale #-}
   toColorXYZ = luv2xyz
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = xyz2luv
diff --git a/src/Graphics/Color/Space/CIE1976/LUV/LCH.hs b/src/Graphics/Color/Space/CIE1976/LUV/LCH.hs
--- a/src/Graphics/Color/Space/CIE1976/LUV/LCH.hs
+++ b/src/Graphics/Color/Space/CIE1976/LUV/LCH.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -9,6 +10,7 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- |
 -- Module: Graphics.Color.Space.CIE1976.LUV.LCH
@@ -20,6 +22,7 @@
   , Color(LCHuv)
   ) where
 
+import Data.List.NonEmpty
 import Data.Coerce
 import Data.Proxy
 import Foreign.Storable
@@ -73,9 +76,17 @@
 -- | 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
+  type ChannelCount (LCHuv i) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = "L" :| ["Cuv", "Huv"]
+  channelColors _ = V3 0x80 0x80 0x80 :|
+                  [ V3 0x99 0x00 0x99
+                  , V3 0x99 0xcc 0x00
+                  ]
+  toComponents (LCHuv lch) =  toComponents lch
   {-# INLINE toComponents #-}
-  fromComponents = coerce . fromComponents
+  fromComponents = LCHuv . fromComponents
   {-# INLINE fromComponents #-}
   showsColorModelName _ =
     ("LCH-"++) . showsColorModelName (Proxy :: Proxy (Color (LUV i) e))
@@ -83,9 +94,13 @@
 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
+  toBaseSpace (LCHuv lch) = fmap fromDouble . fromComponents . CM.lch2lxy . fmap toDouble $ lch
   {-# INLINE toBaseSpace #-}
-  fromBaseSpace = coerce . fmap fromDouble . CM.lxy2lch . toComponents . fmap toDouble
+  fromBaseSpace = LCHuv . fmap fromDouble . CM.lxy2lch . toComponents . fmap toDouble
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale (coerce -> V3 l _ _) = X l
+  {-# INLINE grayscale #-}
+  replaceGrayscale (coerce -> V3 _ c h) (X l) = coerce (V3 l c h)
+  {-# INLINE replaceGrayscale #-}
diff --git a/src/Graphics/Color/Space/DIN99.hs b/src/Graphics/Color/Space/DIN99.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/Color/Space/DIN99.hs
@@ -0,0 +1,192 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Strict #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Graphics.Color.Space.DIN99
+  ( pattern DIN99,
+    pattern ColorDIN99,
+    DIN99,
+    deltaE,
+  )
+where
+
+import Data.List.NonEmpty
+import Foreign.Storable
+import GHC.Generics (Generic)
+import Graphics.Color.Model.Internal
+import Graphics.Color.Space.Internal
+import Graphics.Color.Space.CIE1976.LAB
+
+data DIN99 (i :: k)
+
+-- | Color in DIN99 color space
+newtype instance Color (DIN99 i) e = DIN99 (V3 e)
+
+pattern ColorDIN99 :: e -> e -> e -> Color (DIN99 i) e
+pattern ColorDIN99 l' a' b' = DIN99 (V3 l' a' b')
+
+{-# COMPLETE ColorDIN99 #-}
+
+-- | `DIN99` color space
+deriving instance Eq e => Eq (Color (DIN99 i) e)
+
+-- | `DIN99` color space
+deriving instance Ord e => Ord (Color (DIN99 i) e)
+
+-- | `DIN99` color space
+deriving instance Functor (Color (DIN99 i))
+
+-- | `DIN99` color space
+deriving instance Applicative (Color (DIN99 i))
+
+-- | `DIN99` color space
+deriving instance Foldable (Color (DIN99 i))
+
+-- | `DIN99` color space
+deriving instance Traversable (Color (DIN99 i))
+
+-- | `DIN99` color space
+deriving instance Storable e => Storable (Color (DIN99 i) e)
+
+-- | `DIN99` color space
+instance (Illuminant i, Elevator e) => Show (Color (DIN99 i) e) where
+  showsPrec _ = showsColorModel
+
+instance (Illuminant i, Elevator e) => ColorModel (DIN99 i) e where
+  type Components (DIN99 i) e = (e, e, e)
+  type ChannelCount (DIN99 i) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = "L*" :| ["a*", "b*"] -- DIN99 is base on Lab color space
+  channelColors _ = V3 0x80 0x80 0x80 :| -- gray
+                  [ V3 0x00 0x64 0x00    -- dark green
+                  , V3 0x00 0x00 0x8b    -- dark blue
+                  ]
+  toComponents (ColorDIN99 l' a' b') = (l', a', b')
+  {-# INLINE toComponents #-}
+  fromComponents (l', a', b') = ColorDIN99 l' a' b'
+  {-# INLINE fromComponents #-}
+
+instance (Illuminant i, Elevator e, RealFloat e) => ColorSpace (DIN99 (i :: k)) i e where
+  type BaseModel (DIN99 i) = DIN99 i
+  type BaseSpace (DIN99 i) = DIN99 i
+  toBaseSpace = id
+  {-# INLINE toBaseSpace #-}
+  fromBaseSpace = id
+  {-# INLINE fromBaseSpace #-}
+  luminance = luminance . dinToLAB DIN99Method
+  {-# INLINE luminance #-}
+  grayscale (ColorDIN99 l' _ _) = X l'
+  {-# INLINE grayscale #-}
+  replaceGrayscale (ColorDIN99 _ a' b') (X l') = ColorDIN99 l' a' b'
+  {-# INLINE replaceGrayscale #-}
+  toColorXYZ = toColorXYZ . dinToLAB DIN99Method
+  {-# INLINE toColorXYZ #-}
+  fromColorXYZ = labToDIN DIN99Method . fromColorXYZ
+  {-# INLINE fromColorXYZ #-}
+
+kE :: RealFloat a => a
+kE = 1
+
+kCH :: RealFloat a => a
+kCH = 1
+
+data DINMethod
+  = ASTMD2244_07Method
+  | DIN99Method
+  | DIN99bMethod
+  | DIN99cMethod
+  | DIN99dMethod
+  deriving (Eq, Show, Read, Ord, Bounded, Enum, Generic)
+
+fromDINMethod ::
+  ( Fractional a,
+    Fractional b,
+    Fractional c,
+    Fractional d,
+    Fractional f,
+    Fractional g,
+    Fractional h,
+    Fractional e
+  ) =>
+  DINMethod ->
+  (a, b, c, d, e, f, g, h)
+fromDINMethod ASTMD2244_07Method =
+  (105.509, 0.0158, 16.0, 0.7, 1, 9 / 200, 0.0, 9 / 200)
+fromDINMethod DIN99Method = (105.509, 0.0158, 16.0, 0.7, 1, 9 / 200, 0.0, 9 / 200)
+fromDINMethod DIN99bMethod = (303.67, 0.0039, 26.0, 0.83, 23.0, 0.075, 26.0, 1)
+fromDINMethod DIN99cMethod = (317.65, 0.0037, 0.0, 0.94, 23.0, 0.066, 0.0, 1)
+fromDINMethod DIN99dMethod = (325.22, 0.0036, 50.0, 1.14, 22.5, 0.06, 50.0, 1)
+
+radians :: Floating a => a -> a
+radians x = pi / 180 * x
+
+-- | deltaE distance in DIN99 is the perceptually-uniform distance between
+-- two points in the space. Otherwise known as euclidean distance.
+deltaE ::
+  (Floating e, Illuminant i, Elevator e) =>
+  Color (LAB i) e ->
+  Color (LAB i) e ->
+  e
+deltaE a b = sqrt $ sum ((a - b) ** 2)
+
+-- | Bidirectional @DIN99@ @DIN99@ conversion as implemented in Python
+-- [colour](https://github.com/colour-science/colour/blob/c3735e5d0ad67443022ece0b42b575e040eb61d1/colour/models/din99.py#L79) package.
+--
+-- >>> import Graphics.Color.Illuminant.Wikipedia as W
+-- >>> labToDIN DIN99Method (ColorLAB 41.527874 52.638584 26.92318 :: Color (LAB 'W.D65) Float)
+-- <DIN99 Degree2 'D65:(53.22821400,28.41634600, 3.89839500)>
+-- >>> dinToLAB DIN99Method (ColorDIN99 53.228218 28.416348 3.8983955 :: Color (DIN99 'W.D65) Float)
+-- <LAB Degree2 'D65:(41.52787800,52.63859000,26.92318300)>
+labToDIN ::
+  (RealFloat e) =>
+  DINMethod ->
+  Color (LAB i) e ->
+  Color (DIN99 i) e
+labToDIN m (ColorLAB l a b) = ColorDIN99 l_99 a_99 b_99
+  where
+    cos_c = cos $ radians c_3
+    sin_c = sin $ radians c_3
+    e = cos_c * a + sin_c * b
+    f = c_4 * (- sin_c * a + cos_c * b)
+    g' = sqrt (e ** 2 + f ** 2)
+    h_ef = atan2 f e + radians c_7
+    c_99 = c_5 * log (1 + c_6 * g') / (c_8 * kCH * kE)
+    a_99 = c_99 * cos h_ef
+    b_99 = c_99 * sin h_ef
+    l_99 = c_1 * log (1 + c_2 * l) * kE
+    (c_1, c_2, c_3, c_4, c_5, c_6, c_7, c_8) = fromDINMethod m
+
+dinToLAB ::
+  RealFloat e =>
+  DINMethod ->
+  Color (DIN99 i) e ->
+  Color (LAB i) e
+dinToLAB m (ColorDIN99 l_99 a_99 b_99) = ColorLAB l a b
+  where
+    expm1 x = exp x - 1
+    cos' = cos (radians c_3)
+    sin' = sin (radians c_3)
+
+    h_99 = atan2 b_99 a_99 - radians c_7
+
+    c_99 = sqrt (a_99 ** 2 + b_99 ** 2)
+    g' = expm1 (c_8 / c_5 * c_99 * kCH * kE) / c_6
+
+    e = g' * cos h_99
+    f = g' * sin h_99
+
+    a = e * cos' - f / c_4 * sin'
+    b = e * sin' + f / c_4 * cos'
+    l = expm1 (l_99 * kE / c_1) / c_2
+    (c_1, c_2, c_3, c_4, c_5, c_6, c_7, c_8) = fromDINMethod m
diff --git a/src/Graphics/Color/Space/Internal.hs b/src/Graphics/Color/Space/Internal.hs
--- a/src/Graphics/Color/Space/Internal.hs
+++ b/src/Graphics/Color/Space/Internal.hs
@@ -11,11 +11,12 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Color.Space.Internal
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -50,6 +51,7 @@
   , whitePointTristimulus
   , CCT(..)
   , Y
+  , unY
   , pattern Y
   , pattern YA
   , XYZ
@@ -61,20 +63,23 @@
   , showsColorModel
   , module Graphics.Color.Algebra.Binary
   , module Graphics.Color.Algebra.Elevator
+  , module Graphics.Color.Model.X
   ) where
 
+import Data.Coerce
+import Data.Kind
+import Data.List.NonEmpty
+import Data.Typeable
 import Foreign.Storable
+import GHC.TypeNats
 import Graphics.Color.Algebra.Binary
 import Graphics.Color.Algebra.Elevator
 import Graphics.Color.Model.Internal
-import qualified Graphics.Color.Model.X as CM
-import Data.Typeable
-import Data.Coerce
-import GHC.TypeNats
-import Data.Kind
+import Graphics.Color.Model.X
 
 class (Illuminant i, ColorModel (BaseModel cs) e, ColorModel cs e) =>
   ColorSpace cs (i :: k) e | cs -> i where
+  {-# MINIMAL toBaseSpace, fromBaseSpace, luminance, grayscale, (replaceGrayscale|applyGrayscale) #-}
 
   type BaseModel cs :: Type
 
@@ -96,11 +101,50 @@
   toBaseSpace :: ColorSpace (BaseSpace cs) i e => Color cs e -> Color (BaseSpace cs) e
   fromBaseSpace :: ColorSpace (BaseSpace cs) i e => Color (BaseSpace cs) e -> Color cs e
 
-  -- | Get the relative luminance of a color
+  -- | Get the relative luminance of a color. This is different from `grayscale` in that
+  -- it will produce achromatic color that is no longer dependent on the source color
   --
   -- @since 0.1.0
   luminance :: (Elevator a, RealFloat a) => Color cs e -> Color (Y i) a
 
+  -- | Drop chromatic information and get only the grayscale information from
+  -- the color. Without knowledge of the source color the produced value is
+  -- inconsequential, becaus each class of color spaces has its own notion of
+  -- grayscale (luma, luminocity, in linear or non-linear form, etc.)
+  --
+  -- /Warning/ - This method is still experimental. Use at your own risk.
+  --
+  -- @since 0.4.0
+  grayscale :: Color cs e -> Color X e
+
+  -- | Replace the grayscale information, leaving the chromatic portion of the coloer
+  -- intact.
+  --
+  -- Property that this function must obide:
+  --
+  -- > replaceGrayscale c y = applyGrayscale c (const y)
+  --
+  -- /Warning/ - This method is still experimental. Use at your own risk.
+  --
+  -- @since 0.4.0
+  replaceGrayscale :: Color cs e -> Color X e -> Color cs e
+  replaceGrayscale c y = applyGrayscale c (const y)
+  {-# INLINE replaceGrayscale #-}
+
+  -- | Apply a function to the grayscale portion of the color leaving chromaticity
+  -- intact. The meaning of "grayscale" is very much specific to the color space it is being
+  -- applied to.
+  --
+  -- Property that this function must obide:
+  --
+  -- > applyGrayscale c f = replaceGrayscale c (f (grayscale c))
+  --
+  -- @since 0.4.0
+  applyGrayscale :: Color cs e -> (Color X e -> Color X e) -> Color cs e
+  applyGrayscale c f = replaceGrayscale c (f (grayscale c))
+  {-# INLINE applyGrayscale #-}
+
+
   toColorXYZ :: (Elevator a, RealFloat a) => Color cs e -> Color (XYZ i) a
   default toColorXYZ ::
     (ColorSpace (BaseSpace cs) i e, Elevator a, RealFloat a) => Color cs e -> Color (XYZ i) a
@@ -132,6 +176,10 @@
   {-# INLINE fromColorXYZ #-}
   luminance = luminance . dropAlpha
   {-# INLINE luminance #-}
+  grayscale = grayscale . dropAlpha
+  {-# INLINE grayscale #-}
+  replaceGrayscale c x = modifyOpaque (`replaceGrayscale` x) c
+  {-# INLINE replaceGrayscale #-}
   toBaseSpace = modifyOpaque toBaseSpace
   {-# INLINE toBaseSpace #-}
   fromBaseSpace = modifyOpaque fromBaseSpace
@@ -326,6 +374,11 @@
 -- | CIE1931 `XYZ` color space
 instance (Illuminant i, Elevator e) => ColorModel (XYZ (i :: k)) e where
   type Components (XYZ i) e = (e, e, e)
+  type ChannelCount (XYZ i) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = "X" :| ["Y", "Z"]
+  channelColors _ = V3 0xff 0xff 0xff :| [V3 0x80 0x80 0x80, V3 0x2f 0x4f 0x4f]
   toComponents (ColorXYZ x y z) = (x, y, z)
   {-# INLINE toComponents #-}
   fromComponents (x, y, z) = ColorXYZ x y z
@@ -340,6 +393,10 @@
   fromBaseSpace = id
   luminance (ColorXYZ _ y _) = Y (toRealFloat y)
   {-# INLINE luminance #-}
+  grayscale (ColorXYZ _ y _) = X y
+  {-# INLINE grayscale #-}
+  replaceGrayscale (ColorXYZ x _ z) (X y) = ColorXYZ x y z
+  {-# INLINE replaceGrayscale #-}
   toColorXYZ (ColorXYZ x y z) = ColorXYZ (toRealFloat x) (toRealFloat y) (toRealFloat z)
   {-# INLINE toColorXYZ #-}
   fromColorXYZ (ColorXYZ x y z) = ColorXYZ (fromRealFloat x) (fromRealFloat y) (fromRealFloat z)
@@ -398,6 +455,11 @@
 -- | CIE xyY color space
 instance (Illuminant i, Elevator e) => ColorModel (CIExyY (i :: k)) e where
   type Components (CIExyY i) e = (e, e)
+  type ChannelCount (CIExyY i) = 2
+  channelCount _ = 2
+  {-# INLINE channelCount #-}
+  channelNames _ = "x" :| ["y"]
+  channelColors _ = V3 0xbd 0xb7 0x6b :| [V3 0xf0 0xe6 0x8c]
   toComponents (CIExyY (V2 x y)) = (x, y)
   {-# INLINE toComponents #-}
   fromComponents (x, y) = CIExyY (V2 x y)
@@ -405,7 +467,7 @@
   showsColorModelName _ = showsType (Proxy :: Proxy (CIExyY i))
 
 -- | CIE xyY color space
-instance (Illuminant i, Elevator e) => ColorSpace (CIExyY (i :: k)) i e where
+instance (Illuminant i, RealFloat e, Elevator e) => ColorSpace (CIExyY (i :: k)) i e where
   type BaseModel (CIExyY i) = CIExyY i
   toBaseModel = id
   fromBaseModel = id
@@ -413,6 +475,14 @@
   fromBaseSpace = id
   luminance _ = Y 1
   {-# INLINE luminance #-}
+  grayscale _ = X 1
+  {-# INLINE grayscale #-}
+  replaceGrayscale xy y =
+    fromColorXYZ (replaceGrayscale (toColorXYZ xy) y :: Color (XYZ i) e)
+  {-# INLINE replaceGrayscale #-}
+  applyGrayscale xy f =
+    fromColorXYZ (applyGrayscale (toColorXYZ xy) f :: Color (XYZ i) e)
+  {-# INLINE applyGrayscale #-}
   toColorXYZ xy = ColorXYZ (x / y) 1 ((1 - x - y) / y)
     where ColorCIExy x y = toRealFloat <$> xy
   {-# INLINE toColorXYZ #-}
@@ -423,7 +493,6 @@
   {-# INLINE fromColorXYZ #-}
 
 
-
 -------------
 --- Y ---
 -------------
@@ -432,16 +501,21 @@
 data Y (i :: k)
 
 -- | Luminance `Y`
-newtype instance Color (Y i) e = Luminance (CM.Color CM.X e)
+newtype instance Color (Y i) e = Luminance (Color X e)
 
+-- | Get the luminance value
+unY :: Color (Y i) e -> e
+unY = coerce
+{-# INLINE unY #-}
+
 -- | Constructor for @Y@ with alpha channel.
 pattern Y :: e -> Color (Y i) e
-pattern Y y = Luminance (CM.X y)
+pattern Y y = Luminance (X y)
 {-# COMPLETE Y #-}
 
 -- | Constructor for @Y@ with alpha channel.
 pattern YA :: e -> e -> Color (Alpha (Y i)) e
-pattern YA y a = Alpha (Luminance (CM.X y)) a
+pattern YA y a = Alpha (Luminance (X y)) a
 {-# COMPLETE YA #-}
 
 -- | `Y` - relative luminance of a color space
@@ -467,6 +541,11 @@
 -- | `Y` - relative luminance of a color space
 instance (Illuminant i, Elevator e) => ColorModel (Y i) e where
   type Components (Y i) e = e
+  type ChannelCount (Y i) = 1
+  channelCount _ = 1
+  {-# INLINE channelCount #-}
+  channelNames _ = "Luminance" :| []
+  channelColors _ = V3 0x80 0x80 0x80 :| []
   toComponents = coerce
   {-# INLINE toComponents #-}
   fromComponents = coerce
@@ -475,16 +554,22 @@
 
 -- | CIE1931 `XYZ` color space
 instance (Illuminant i, Elevator e) => ColorSpace (Y i) i e where
-  type BaseModel (Y i) = CM.X
+  type BaseModel (Y i) = X
   toBaseSpace = id
   fromBaseSpace = id
   luminance = fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = coerce
+  {-# INLINE grayscale #-}
+  applyGrayscale c f = coerce (f (coerce c))
+  {-# INLINE applyGrayscale #-}
+  replaceGrayscale _ = coerce
+  {-# INLINE replaceGrayscale #-}
   toColorXYZ (Y y) = ColorXYZ 0 (toRealFloat y) 0
   {-# INLINE toColorXYZ #-}
   fromColorXYZ (ColorXYZ _ y _) = Y (fromRealFloat y)
   {-# INLINE fromColorXYZ #-}
 
 {-# RULES
-"luminance :: RealFloat a => Color Y a -> Color Y a" luminance = id
+"luminance :: RealFloat a => Color (Y i) a -> Color (Y i) a" luminance = id
  #-}
diff --git a/src/Graphics/Color/Space/RGB.hs b/src/Graphics/Color/Space/RGB.hs
--- a/src/Graphics/Color/Space/RGB.hs
+++ b/src/Graphics/Color/Space/RGB.hs
@@ -1,6 +1,6 @@
 -- |
 -- Module      : Graphics.Color.Space.RGB
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Space/RGB/AdobeRGB.hs b/src/Graphics/Color/Space/RGB/AdobeRGB.hs
--- a/src/Graphics/Color/Space/RGB/AdobeRGB.hs
+++ b/src/Graphics/Color/Space/RGB/AdobeRGB.hs
@@ -7,11 +7,12 @@
 {-# LANGUAGE NegativeLiterals #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.AdobeRGB
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -112,6 +113,11 @@
 -- | `AdobeRGB` color space
 instance (Typeable l, Elevator e) => ColorModel (AdobeRGB l) e where
   type Components (AdobeRGB l) e = (e, e, e)
+  type ChannelCount (AdobeRGB l) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.RGB e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.RGB e))
   toComponents = toComponents . unColorRGB
   {-# INLINE toComponents #-}
   fromComponents = mkColorRGB . fromComponents
@@ -126,6 +132,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLinearLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgbLinear2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear
@@ -140,6 +150,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbNonLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbNonLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgb2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgb
diff --git a/src/Graphics/Color/Space/RGB/Alternative.hs b/src/Graphics/Color/Space/RGB/Alternative.hs
--- a/src/Graphics/Color/Space/RGB/Alternative.hs
+++ b/src/Graphics/Color/Space/RGB/Alternative.hs
@@ -1,6 +1,6 @@
 -- |
 -- Module      : Graphics.Color.Space.RGB.Alternative
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Space/RGB/Alternative/CMYK.hs b/src/Graphics/Color/Space/RGB/Alternative/CMYK.hs
--- a/src/Graphics/Color/Space/RGB/Alternative/CMYK.hs
+++ b/src/Graphics/Color/Space/RGB/Alternative/CMYK.hs
@@ -12,7 +12,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.Alternative.CMYK
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -78,6 +78,11 @@
 -- | `CMYK` representation for some (@`RedGreenBlue` cs i@) color space
 instance ColorModel cs e => ColorModel (CMYK cs) e where
   type Components (CMYK cs) e = (e, e, e, e)
+  type ChannelCount (CMYK cs) = 4
+  channelCount _ = 4
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.CMYK e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.CMYK e))
   toComponents = toComponents . coerce
   {-# INLINE toComponents #-}
   fromComponents = coerce . fromComponents
@@ -96,6 +101,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale = grayscale . toBaseSpace
+  {-# INLINE grayscale #-}
+  applyGrayscale c f = fromBaseSpace (applyGrayscale (toBaseSpace c) f)
+  {-# INLINE applyGrayscale #-}
 
 
 
@@ -109,6 +118,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale = grayscale . toBaseSpace
+  {-# INLINE grayscale #-}
+  applyGrayscale c f = fromBaseSpace (applyGrayscale (toBaseSpace c) f)
+  {-# INLINE applyGrayscale #-}
 
 -- | `CMYK` representation for `AdobeRGB` color space
 instance ColorSpace (AdobeRGB l) D65 e => ColorSpace (CMYK (AdobeRGB l)) D65 e where
@@ -120,6 +133,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale = grayscale . toBaseSpace
+  {-# INLINE grayscale #-}
+  applyGrayscale c f = fromBaseSpace (applyGrayscale (toBaseSpace c) f)
+  {-# INLINE applyGrayscale #-}
 
 -- | `CMYK` representation for `Rec470.BT470_525` color space
 instance ColorSpace (Rec470.BT470_525 l) D65 e => ColorSpace (CMYK (Rec470.BT470_525 l)) D65 e where
@@ -131,6 +148,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale = grayscale . toBaseSpace
+  {-# INLINE grayscale #-}
+  applyGrayscale c f = fromBaseSpace (applyGrayscale (toBaseSpace c) f)
+  {-# INLINE applyGrayscale #-}
 
 -- | `CMYK` representation for `Rec470.BT470_625` color space
 instance ColorSpace (Rec470.BT470_625 l) D65 e => ColorSpace (CMYK (Rec470.BT470_625 l)) D65 e where
@@ -142,6 +163,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale = grayscale . toBaseSpace
+  {-# INLINE grayscale #-}
+  applyGrayscale c f = fromBaseSpace (applyGrayscale (toBaseSpace c) f)
+  {-# INLINE applyGrayscale #-}
 
 -- | `CMYK` representation for `BT601_525` color space
 instance ColorSpace (BT601_525 l) D65 e => ColorSpace (CMYK (BT601_525 l)) D65 e where
@@ -153,6 +178,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale = grayscale . toBaseSpace
+  {-# INLINE grayscale #-}
+  applyGrayscale c f = fromBaseSpace (applyGrayscale (toBaseSpace c) f)
+  {-# INLINE applyGrayscale #-}
 
 -- | `CMYK` representation for `BT601_625` color space
 instance ColorSpace (BT601_625 l) D65 e => ColorSpace (CMYK (BT601_625 l)) D65 e where
@@ -164,6 +193,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale = grayscale . toBaseSpace
+  {-# INLINE grayscale #-}
+  applyGrayscale c f = fromBaseSpace (applyGrayscale (toBaseSpace c) f)
+  {-# INLINE applyGrayscale #-}
 
 -- | `CMYK` representation for `BT709` color space
 instance ColorSpace (BT709 l) D65 e => ColorSpace (CMYK (BT709 l)) D65 e where
@@ -175,3 +208,7 @@
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale = grayscale . toBaseSpace
+  {-# INLINE grayscale #-}
+  applyGrayscale c f = fromBaseSpace (applyGrayscale (toBaseSpace c) f)
+  {-# INLINE applyGrayscale #-}
diff --git a/src/Graphics/Color/Space/RGB/Alternative/HSI.hs b/src/Graphics/Color/Space/RGB/Alternative/HSI.hs
--- a/src/Graphics/Color/Space/RGB/Alternative/HSI.hs
+++ b/src/Graphics/Color/Space/RGB/Alternative/HSI.hs
@@ -13,7 +13,7 @@
 {-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.Alternative.HSI
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -83,9 +83,14 @@
 -- | `HSI` representation for some (@`RedGreenBlue` cs i@) color space
 instance ColorModel cs e => ColorModel (HSI cs) e where
   type Components (HSI cs) e = (e, e, e)
-  toComponents = toComponents . coerce
+  type ChannelCount (HSI cs) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.HSI e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.HSI e))
+  toComponents = toComponents . (coerce :: Color (HSI cs) e -> Color CM.HSI e)
   {-# INLINE toComponents #-}
-  fromComponents = coerce . fromComponents
+  fromComponents = (coerce :: Color CM.HSI e -> Color (HSI cs) e) . fromComponents
   {-# INLINE fromComponents #-}
   showsColorModelName _ = ("HSI-" ++) . showsColorModelName (Proxy :: Proxy (Color cs e))
 
@@ -94,9 +99,13 @@
 instance (ColorSpace (cs l) i e, RedGreenBlue cs i) => ColorSpace (HSI (cs l)) i e where
   type BaseModel (HSI (cs l)) = CM.HSI
   type BaseSpace (HSI (cs l)) = cs l
-  toBaseSpace = mkColorRGB . fmap fromDouble . CM.hsi2rgb . fmap toDouble . coerce
+  toBaseSpace = mkColorRGB . fmap fromDouble . CM.hsi2rgb . fmap toDouble . toBaseModel
   {-# INLINE toBaseSpace #-}
-  fromBaseSpace = coerce . fmap fromDouble . CM.rgb2hsi . fmap toDouble . unColorRGB
+  fromBaseSpace = fromBaseModel . fmap fromDouble . CM.rgb2hsi . fmap toDouble . unColorRGB
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale (coerce -> V3 _ _ i) = X i
+  {-# INLINE grayscale #-}
+  replaceGrayscale (coerce -> V3 h s _) (X i) = coerce (V3 h s i)
+  {-# INLINE replaceGrayscale #-}
diff --git a/src/Graphics/Color/Space/RGB/Alternative/HSL.hs b/src/Graphics/Color/Space/RGB/Alternative/HSL.hs
--- a/src/Graphics/Color/Space/RGB/Alternative/HSL.hs
+++ b/src/Graphics/Color/Space/RGB/Alternative/HSL.hs
@@ -13,7 +13,7 @@
 {-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.Alternative.HSL
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -82,9 +82,14 @@
 -- | `HSL` representation for some (@`RedGreenBlue` cs i@) color space
 instance ColorModel cs e => ColorModel (HSL cs) e where
   type Components (HSL cs) e = (e, e, e)
-  toComponents = toComponents . coerce
+  type ChannelCount (HSL cs) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.HSL e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.HSL e))
+  toComponents = toComponents . (coerce :: Color (HSL cs) e -> Color CM.HSL e)
   {-# INLINE toComponents #-}
-  fromComponents = coerce . fromComponents
+  fromComponents = (coerce :: Color CM.HSL e -> Color (HSL cs) e) . fromComponents
   {-# INLINE fromComponents #-}
   showsColorModelName _ = ("HSL-" ++) . showsColorModelName (Proxy :: Proxy (Color cs e))
 
@@ -93,9 +98,13 @@
 instance (ColorSpace (cs l) i e, RedGreenBlue cs i) => ColorSpace (HSL (cs l)) i e where
   type BaseModel (HSL (cs l)) = CM.HSL
   type BaseSpace (HSL (cs l)) = cs l
-  toBaseSpace = mkColorRGB . fmap fromDouble . CM.hsl2rgb . fmap toDouble . coerce
+  toBaseSpace = mkColorRGB . fmap fromDouble . CM.hsl2rgb . fmap toDouble . toBaseModel
   {-# INLINE toBaseSpace #-}
-  fromBaseSpace = coerce . fmap fromDouble . CM.rgb2hsl . fmap toDouble . unColorRGB
+  fromBaseSpace = fromBaseModel . fmap fromDouble . CM.rgb2hsl . fmap toDouble . unColorRGB
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale (coerce -> V3 _ _ l) = X l
+  {-# INLINE grayscale #-}
+  replaceGrayscale (coerce -> V3 h s _) (X l) = coerce (V3 h s l)
+  {-# INLINE replaceGrayscale #-}
diff --git a/src/Graphics/Color/Space/RGB/Alternative/HSV.hs b/src/Graphics/Color/Space/RGB/Alternative/HSV.hs
--- a/src/Graphics/Color/Space/RGB/Alternative/HSV.hs
+++ b/src/Graphics/Color/Space/RGB/Alternative/HSV.hs
@@ -13,7 +13,7 @@
 {-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.Alternative.HSV
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -82,9 +82,14 @@
 -- | `HSV` representation for some (@`RedGreenBlue` cs i@) color space
 instance ColorModel cs e => ColorModel (HSV cs) e where
   type Components (HSV cs) e = (e, e, e)
-  toComponents = toComponents . coerce
+  type ChannelCount (HSV cs) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.HSV e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.HSV e))
+  toComponents = toComponents . (coerce :: Color (HSV cs) e -> Color CM.HSV e)
   {-# INLINE toComponents #-}
-  fromComponents = coerce . fromComponents
+  fromComponents = (coerce :: Color CM.HSV e -> Color (HSV cs) e) . fromComponents
   {-# INLINE fromComponents #-}
   showsColorModelName _ = ("HSV-" ++) . showsColorModelName (Proxy :: Proxy (Color cs e))
 
@@ -93,9 +98,13 @@
 instance (ColorSpace (cs l) i e, RedGreenBlue cs i) => ColorSpace (HSV (cs l)) i e where
   type BaseModel (HSV (cs l)) = CM.HSV
   type BaseSpace (HSV (cs l)) = cs l
-  toBaseSpace = mkColorRGB . fmap fromDouble . CM.hsv2rgb . fmap toDouble . coerce
+  toBaseSpace = mkColorRGB . fmap fromDouble . CM.hsv2rgb . fmap toDouble . toBaseModel
   {-# INLINE toBaseSpace #-}
-  fromBaseSpace = coerce . fmap fromDouble . CM.rgb2hsv . fmap toDouble . unColorRGB
+  fromBaseSpace = fromBaseModel . fmap fromDouble . CM.rgb2hsv . fmap toDouble . unColorRGB
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale (coerce -> V3 _ _ v) = X v
+  {-# INLINE grayscale #-}
+  replaceGrayscale (coerce -> V3 h s _) (X v) = coerce (V3 h s v)
+  {-# INLINE replaceGrayscale #-}
diff --git a/src/Graphics/Color/Space/RGB/Alternative/YCbCr.hs b/src/Graphics/Color/Space/RGB/Alternative/YCbCr.hs
--- a/src/Graphics/Color/Space/RGB/Alternative/YCbCr.hs
+++ b/src/Graphics/Color/Space/RGB/Alternative/YCbCr.hs
@@ -11,9 +11,10 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.Alternative.YCbCr
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -59,7 +60,7 @@
 deriving instance Traversable (Color (Y'CbCr cs))
 deriving instance Storable e => Storable (Color (Y'CbCr cs) e)
 
-instance (Typeable cs, ColorModel (cs 'NonLinear) e, Elevator e) => Show (Color (Y'CbCr cs) e) where
+instance (Typeable cs, ColorModel (cs 'NonLinear) e) => Show (Color (Y'CbCr cs) e) where
   showsPrec _ = showsColorModel
 
 -- | Constructor for an RGB color space in an alternative Y'CbCr color model
@@ -75,6 +76,11 @@
 
 instance (Typeable cs, ColorModel (cs 'NonLinear) e, Elevator e) => ColorModel (Y'CbCr cs) e where
   type Components (Y'CbCr cs) e = (e, e, e)
+  type ChannelCount (Y'CbCr cs) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.YCbCr e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.YCbCr e))
   toComponents (ColorY'CbCr y cb cr) = (y, cb, cr)
   {-# INLINE toComponents #-}
   fromComponents (y, cb, cr) = ColorY'CbCr y cb cr
@@ -91,6 +97,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale (coerce -> V3 y' _ _) = X y'
+  {-# INLINE grayscale #-}
+  replaceGrayscale (coerce -> V3 _ cb cr) (X y') = coerce (V3 y' cb cr)
+  {-# INLINE replaceGrayscale #-}
 
 instance Elevator e => ColorSpace (Y'CbCr BT601_525) D65 e where
   type BaseModel (Y'CbCr BT601_525) = CM.YCbCr
@@ -101,6 +111,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale (coerce -> V3 y' _ _) = X y'
+  {-# INLINE grayscale #-}
+  replaceGrayscale (coerce -> V3 _ cb cr) (X y') = coerce (V3 y' cb cr)
+  {-# INLINE replaceGrayscale #-}
 
 instance Elevator e => ColorSpace (Y'CbCr BT601_625) D65 e where
   type BaseModel (Y'CbCr BT601_625) = CM.YCbCr
@@ -111,6 +125,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale (coerce -> V3 y' _ _) = X y'
+  {-# INLINE grayscale #-}
+  replaceGrayscale (coerce -> V3 _ cb cr) (X y') = coerce (V3 y' cb cr)
+  {-# INLINE replaceGrayscale #-}
 
 instance Elevator e => ColorSpace (Y'CbCr BT709) D65 e where
   type BaseModel (Y'CbCr BT709) = CM.YCbCr
@@ -121,6 +139,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale (coerce -> V3 y' _ _) = X y'
+  {-# INLINE grayscale #-}
+  replaceGrayscale (coerce -> V3 _ cb cr) (X y') = coerce (V3 y' cb cr)
+  {-# INLINE replaceGrayscale #-}
 
 instance (Typeable cs, Luma (cs i), ColorSpace (cs i 'NonLinear) i e, RedGreenBlue (cs i) i) =>
          ColorSpace (Y'CbCr (cs i)) i e where
@@ -132,6 +154,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = luminance . toBaseSpace
   {-# INLINE luminance #-}
+  grayscale (coerce -> V3 y' _ _) = X y'
+  {-# INLINE grayscale #-}
+  replaceGrayscale (coerce -> V3 _ cb cr) (X y') = coerce (V3 y' cb cr)
+  {-# INLINE replaceGrayscale #-}
 
 
 -- | This conversion is only correct for sRGB and Rec601. Source: ITU-T Rec. T.871
@@ -139,13 +165,7 @@
 -- @since 0.1.3
 ycbcr2srgb ::
      (RedGreenBlue cs i, RealFloat e) => Color (Y'CbCr cs) e -> Color (cs 'NonLinear) e
-ycbcr2srgb (ColorY'CbCr y' cb cr) = ColorRGB r' g' b'
-  where
-    !cb05 = cb - 0.5
-    !cr05 = cr - 0.5
-    !r' = clamp01 (y'                   + 1.402    * cr05)
-    !g' = clamp01 (y' - 0.344136 * cb05 - 0.714136 * cr05)
-    !b' = clamp01 (y' + 1.772    * cb05)
+ycbcr2srgb = ycbcrToRec601 . coerce
 {-# INLINE ycbcr2srgb #-}
 
 -- | This conversion is only correct for sRGB and Rec601. Source: ITU-T Rec. T.871
@@ -153,11 +173,7 @@
 -- @since 0.1.3
 srgb2ycbcr ::
      (RedGreenBlue cs i, RealFloat e) => Color (cs 'NonLinear) e -> Color (Y'CbCr cs) e
-srgb2ycbcr (ColorRGB r' g' b') = ColorY'CbCr y' cb cr
-  where
-    !y' =          0.299 * r' +    0.587 * g' +    0.114 * b'
-    !cb = 0.5 - 0.168736 * r' - 0.331264 * g' +      0.5 * b'
-    !cr = 0.5 +      0.5 * r' - 0.418688 * g' - 0.081312 * b'
+srgb2ycbcr = coerce . rec601ToYcbcr
 {-# INLINE srgb2ycbcr #-}
 
 -- | Convert any RGB color space that has `Luma` specified to `Y'CbCr`
diff --git a/src/Graphics/Color/Space/RGB/CIERGB.hs b/src/Graphics/Color/Space/RGB/CIERGB.hs
--- a/src/Graphics/Color/Space/RGB/CIERGB.hs
+++ b/src/Graphics/Color/Space/RGB/CIERGB.hs
@@ -1,6 +1,6 @@
 -- |
 -- Module      : Graphics.Color.Space.RGB.Derived.CIERGB
--- Copyright   : (c) Alexey Kuleshevich 2020
+-- Copyright   : (c) Alexey Kuleshevich 2020-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Space/RGB/Derived/AdobeRGB.hs b/src/Graphics/Color/Space/RGB/Derived/AdobeRGB.hs
--- a/src/Graphics/Color/Space/RGB/Derived/AdobeRGB.hs
+++ b/src/Graphics/Color/Space/RGB/Derived/AdobeRGB.hs
@@ -11,7 +11,7 @@
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.Derived.AdobeRGB
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -58,6 +58,11 @@
 -- | `AdobeRGB` color space (derived)
 instance (Typeable l, Illuminant i, Elevator e) => ColorModel (AdobeRGB (i :: k) l) e where
   type Components (AdobeRGB i l) e = (e, e, e)
+  type ChannelCount (AdobeRGB i l) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.RGB e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.RGB e))
   toComponents = toComponents . unColorRGB
   {-# INLINE toComponents #-}
   fromComponents = mkColorRGB . fromComponents
@@ -72,6 +77,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLinearLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgbLinear2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear
@@ -86,6 +95,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbNonLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbNonLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgb2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgb
diff --git a/src/Graphics/Color/Space/RGB/Derived/CIERGB.hs b/src/Graphics/Color/Space/RGB/Derived/CIERGB.hs
--- a/src/Graphics/Color/Space/RGB/Derived/CIERGB.hs
+++ b/src/Graphics/Color/Space/RGB/Derived/CIERGB.hs
@@ -11,7 +11,7 @@
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.Derived.CIERGB
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -60,6 +60,11 @@
 -- | `CIERGB` color space (derived)
 instance (Typeable l, Illuminant i, Elevator e) => ColorModel (CIERGB (i :: k) l) e where
   type Components (CIERGB i l) e = (e, e, e)
+  type ChannelCount (CIERGB i l) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.RGB e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.RGB e))
   toComponents = toComponents . unColorRGB
   {-# INLINE toComponents #-}
   fromComponents = mkColorRGB . fromComponents
@@ -74,6 +79,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLinearLuminance . castLinearity . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = toBaseModel . fmap fromDouble . luminance
+  {-# INLINE grayscale #-}
+  applyGrayscale c f = castLinearity (rgbLinearApplyGrayscale (castLinearity c) f)
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgbLinear2xyz . fmap toRealFloat . castLinearity
   {-# INLINE toColorXYZ #-}
   fromColorXYZ xyz = castLinearity (fromRealFloat <$> xyz2rgbLinear @(CIERGB i) xyz)
diff --git a/src/Graphics/Color/Space/RGB/Derived/SRGB.hs b/src/Graphics/Color/Space/RGB/Derived/SRGB.hs
--- a/src/Graphics/Color/Space/RGB/Derived/SRGB.hs
+++ b/src/Graphics/Color/Space/RGB/Derived/SRGB.hs
@@ -11,7 +11,7 @@
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.Derived.SRGB
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -21,6 +21,7 @@
   ( SRGB
   ) where
 
+import Data.Coerce
 import Data.Typeable
 import Foreign.Storable
 import Graphics.Color.Model.Internal
@@ -29,7 +30,7 @@
 import Graphics.Color.Space.RGB.Internal
 import Graphics.Color.Space.RGB.Luma
 import qualified Graphics.Color.Space.RGB.SRGB as SRGB
-
+import Graphics.Color.Space.RGB.ITU.Rec601 (applyGrayscaleRec601)
 
 -- | The most common @sRGB@ color space with an arbitrary illuminant
 data SRGB (i :: k) (l :: Linearity)
@@ -59,6 +60,11 @@
 -- | `SRGB` color space (derived)
 instance (Typeable l, Illuminant i, Elevator e) => ColorModel (SRGB (i :: k) l) e where
   type Components (SRGB i l) e = (e, e, e)
+  type ChannelCount (SRGB i l) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.RGB e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.RGB e))
   toComponents = toComponents . unColorRGB
   {-# INLINE toComponents #-}
   fromComponents = mkColorRGB . fromComponents
@@ -73,6 +79,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLinearLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgbLinear2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear
@@ -88,6 +98,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = fmap fromDouble . coerce . rgbLuma @_ @_ @_ @Double
+  {-# INLINE grayscale #-}
+  applyGrayscale = applyGrayscaleRec601
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgb2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgb
diff --git a/src/Graphics/Color/Space/RGB/ITU/Rec470.hs b/src/Graphics/Color/Space/RGB/ITU/Rec470.hs
--- a/src/Graphics/Color/Space/RGB/ITU/Rec470.hs
+++ b/src/Graphics/Color/Space/RGB/ITU/Rec470.hs
@@ -6,11 +6,12 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.ITU.Rec470
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -63,6 +64,11 @@
 -- | ITU-R BT.470 (525) color space
 instance (Typeable l, Elevator e) => ColorModel (BT470_525 l) e where
   type Components (BT470_525 l) e = (e, e, e)
+  type ChannelCount (BT470_525 l) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.RGB e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.RGB e))
   toComponents = toComponents . unColorRGB
   {-# INLINE toComponents #-}
   fromComponents = mkColorRGB . fromComponents
@@ -77,6 +83,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLinearLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgbLinear2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear
@@ -91,6 +101,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbNonLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbNonLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgb2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgb
@@ -137,6 +151,11 @@
 -- | ITU-R BT.470 (625) color space
 instance (Typeable l, Elevator e) => ColorModel (BT470_625 l) e where
   type Components (BT470_625 l) e = (e, e, e)
+  type ChannelCount (BT470_625 l) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.RGB e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.RGB e))
   toComponents = toComponents . unColorRGB
   {-# INLINE toComponents #-}
   fromComponents = mkColorRGB . fromComponents
@@ -151,6 +170,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLinearLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgbLinear2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear
@@ -165,6 +188,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbNonLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbNonLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgb2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgb
diff --git a/src/Graphics/Color/Space/RGB/ITU/Rec601.hs b/src/Graphics/Color/Space/RGB/ITU/Rec601.hs
--- a/src/Graphics/Color/Space/RGB/ITU/Rec601.hs
+++ b/src/Graphics/Color/Space/RGB/ITU/Rec601.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -6,12 +7,13 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.ITU.Rec601
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -23,13 +25,18 @@
   , pattern BT601_625
   , BT601_625
   , D65
+  , ycbcrToRec601
+  , rec601ToYcbcr
+  , applyGrayscaleRec601
   ) where
 
+import Data.Coerce
 import Data.Typeable
 import Foreign.Storable
 import Graphics.Color.Illuminant.ITU.Rec601
 import Graphics.Color.Model.Internal
 import qualified Graphics.Color.Model.RGB as CM
+import qualified Graphics.Color.Model.YCbCr as CM
 import Graphics.Color.Space.Internal
 import Graphics.Color.Space.RGB.Internal
 import Graphics.Color.Space.RGB.ITU.Rec470 (BT470_625)
@@ -68,6 +75,11 @@
 -- | ITU-R BT.601 (525) color space
 instance  (Typeable l, Elevator e) => ColorModel (BT601_525 l) e where
   type Components (BT601_525 l) e = (e, e, e)
+  type ChannelCount (BT601_525 l) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.RGB e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.RGB e))
   toComponents = toComponents . unColorRGB
   {-# INLINE toComponents #-}
   fromComponents = mkColorRGB . fromComponents
@@ -82,6 +94,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLinearLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgbLinear2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear
@@ -97,6 +113,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = fmap fromDouble . coerce . rgbLuma @_ @_ @_ @Double
+  {-# INLINE grayscale #-}
+  applyGrayscale = applyGrayscaleRec601
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgb2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgb
@@ -143,6 +163,11 @@
 -- | ITU-R BT.601 (625) color space
 instance (Typeable l, Elevator e) => ColorModel (BT601_625 l) e where
   type Components (BT601_625 l) e = (e, e, e)
+  type ChannelCount (BT601_625 l) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.RGB e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.RGB e))
   toComponents = toComponents . unColorRGB
   {-# INLINE toComponents #-}
   fromComponents = mkColorRGB . fromComponents
@@ -157,6 +182,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLinearLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgbLinear2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear
@@ -171,6 +200,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = fmap fromDouble . coerce . rgbLuma @_ @_ @_ @Double
+  {-# INLINE grayscale #-}
+  applyGrayscale = applyGrayscaleRec601
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgb2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgb
@@ -231,3 +264,45 @@
 inv0018 :: (Ord a, Floating a) => a
 inv0018 = transferRec601 0.018 -- ~ 0.081
 
+
+
+-- | This conversion is correct only for sRGB and Rec601. Source: ITU-T Rec. T.871
+--
+-- @since 0.1.3
+ycbcrToRec601 ::
+     (RedGreenBlue cs i, RealFloat e)
+  => Color CM.YCbCr e
+  -> Color (cs 'NonLinear) e
+ycbcrToRec601 (CM.ColorYCbCr y' cb cr) = mkColorRGB (CM.ColorRGB r' g' b')
+  where
+    !cb05 = cb - 0.5
+    !cr05 = cr - 0.5
+    !r' = clamp01 (y'                   + 1.402    * cr05)
+    !g' = clamp01 (y' - 0.344136 * cb05 - 0.714136 * cr05)
+    !b' = clamp01 (y' + 1.772    * cb05)
+{-# INLINE ycbcrToRec601 #-}
+
+-- | This conversion is correct only for sRGB and Rec601. Source: ITU-T Rec. T.871
+--
+-- @since 0.1.3
+rec601ToYcbcr :: (RedGreenBlue cs i, RealFloat e) => Color (cs 'NonLinear) e -> Color CM.YCbCr e
+rec601ToYcbcr rgb = CM.ColorYCbCr y' cb cr
+  where
+    CM.ColorRGB r' g' b' = unColorRGB rgb
+    !y' =          0.299 * r' +    0.587 * g' +    0.114 * b'
+    !cb = 0.5 - 0.168736 * r' - 0.331264 * g' +      0.5 * b'
+    !cr = 0.5 +      0.5 * r' - 0.418688 * g' - 0.081312 * b'
+{-# INLINE rec601ToYcbcr #-}
+
+
+applyGrayscaleRec601 ::
+     forall cs i e. (RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e)
+  => Color (cs 'NonLinear) e
+  -> (Color X e -> Color X e)
+  -> Color (cs 'NonLinear) e
+applyGrayscaleRec601 rgb f =
+  case rec601ToYcbcr (toDouble <$> rgb) of
+    (CM.ColorYCbCr y' cb cr :: Color CM.YCbCr Double) ->
+      fromDouble <$>
+      ycbcrToRec601 (CM.ColorYCbCr (toDouble (coerce (f (X (fromDouble y'))) :: e)) cb cr)
+{-# INLINE applyGrayscaleRec601 #-}
diff --git a/src/Graphics/Color/Space/RGB/ITU/Rec709.hs b/src/Graphics/Color/Space/RGB/ITU/Rec709.hs
--- a/src/Graphics/Color/Space/RGB/ITU/Rec709.hs
+++ b/src/Graphics/Color/Space/RGB/ITU/Rec709.hs
@@ -6,12 +6,13 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.ITU.Rec709
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -59,6 +60,11 @@
 -- | ITU-R BT.709 color space
 instance (Typeable l, Elevator e) => ColorModel (BT709 l) e where
   type Components (BT709 l) e = (e, e, e)
+  type ChannelCount (BT709 l) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.RGB e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.RGB e))
   toComponents = toComponents . unColorRGB
   {-# INLINE toComponents #-}
   fromComponents = mkColorRGB . fromComponents
@@ -73,6 +79,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLinearLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgbLinear2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear
@@ -87,6 +97,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbNonLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbNonLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgb2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgb
diff --git a/src/Graphics/Color/Space/RGB/Internal.hs b/src/Graphics/Color/Space/RGB/Internal.hs
--- a/src/Graphics/Color/Space/RGB/Internal.hs
+++ b/src/Graphics/Color/Space/RGB/Internal.hs
@@ -18,7 +18,7 @@
 {-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.Internal
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -39,6 +39,10 @@
   , xyz2rgbLinear
   , rgbLuminance
   , rgbLinearLuminance
+  , rgbLinearGrayscale
+  , rgbLinearApplyGrayscale
+  , rgbNonLinearGrayscale
+  , rgbNonLinearApplyGrayscale
   , NPM(..)
   , npmApply
   , npmDerive
@@ -219,6 +223,44 @@
   Y (m3x3row1 (unNPM (npm :: NPM cs e)) `dotProduct` coerce (unColorRGB px))
 {-# INLINE rgbLinearLuminance #-}
 
+rgbLinearGrayscale ::
+     forall cs i e. (ColorSpace (cs 'Linear) i e)
+  => Color (cs 'Linear) e
+  -> Color X e
+rgbLinearGrayscale = ColorX . fromDouble . unY . luminance
+{-# INLINE rgbLinearGrayscale #-}
+
+
+rgbLinearApplyGrayscale ::
+     forall cs i e. (ColorSpace (cs 'Linear) i e)
+  => Color (cs 'Linear) e
+  -> (Color X e -> Color X e)
+  -> Color (cs 'Linear) e
+rgbLinearApplyGrayscale rgb f =
+  case toColorXYZ rgb of
+    ColorXYZ x y z ->
+      fromColorXYZ (ColorXYZ x (toDouble (coerce (f (X (fromDouble y))) :: e)) z)
+{-# INLINE rgbLinearApplyGrayscale #-}
+
+
+rgbNonLinearApplyGrayscale ::
+     forall cs i e. (RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e)
+  => Color (cs 'NonLinear) e
+  -> (Color X e -> Color X e)
+  -> Color (cs 'NonLinear) e
+rgbNonLinearApplyGrayscale rgb f =
+  case toColorXYZ rgb of
+    ColorXYZ x y z ->
+      let y' = itransfer @_ @cs (toDouble (coerce (f (X (fromDouble (transfer @_ @cs y)))) :: e))
+      in fromColorXYZ (ColorXYZ x y' z)
+{-# INLINE rgbNonLinearApplyGrayscale #-}
+
+rgbNonLinearGrayscale ::
+     forall cs i e. (RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e)
+  => Color (cs 'NonLinear) e
+  -> Color X e
+rgbNonLinearGrayscale = ColorX . fromDouble . (transfer @_ @cs) . unY . luminance
+{-# INLINE rgbNonLinearGrayscale #-}
 
 rgbLuminance ::
      (RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e)
diff --git a/src/Graphics/Color/Space/RGB/Luma.hs b/src/Graphics/Color/Space/RGB/Luma.hs
--- a/src/Graphics/Color/Space/RGB/Luma.hs
+++ b/src/Graphics/Color/Space/RGB/Luma.hs
@@ -14,7 +14,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.Luma
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -36,6 +36,7 @@
 
 import Data.Coerce
 import Data.Kind
+import Data.List.NonEmpty
 import Data.Typeable
 import Foreign.Storable
 import Graphics.Color.Model.Internal
@@ -92,6 +93,11 @@
 -- | `Y'` - as a color model
 instance (Typeable cs, Elevator e) => ColorModel (Y' cs) e where
   type Components (Y' cs) e = e
+  type ChannelCount (Y' cs) = 1
+  channelCount _ = 1
+  {-# INLINE channelCount #-}
+  channelNames _ = "Luma" :| []
+  channelColors _ = V3 0x80 0x80 0x80 :| []
   toComponents (Y' y) = y
   {-# INLINE toComponents #-}
   fromComponents = Y'
@@ -99,7 +105,6 @@
 
 
 instance ( Typeable cs
-         , Illuminant i
          , ColorSpace (cs 'Linear) i e
          , ColorSpace (cs 'NonLinear) i e
          , Luma cs
@@ -112,6 +117,12 @@
   {-# INLINE toBaseSpace #-}
   fromBaseSpace = fmap fromDouble . rgbLuma
   {-# INLINE fromBaseSpace #-}
+  grayscale = coerce
+  {-# INLINE grayscale #-}
+  applyGrayscale c f = coerce (f (coerce c))
+  {-# INLINE applyGrayscale #-}
+  replaceGrayscale _ = coerce
+  {-# INLINE replaceGrayscale #-}
   luminance = luminance . fmap (fromDouble :: Double -> e) . toBaseLinearSpace . fmap toDouble
   {-# INLINE luminance #-}
   toColorXYZ = toColorXYZ . fmap (fromDouble :: Double -> e) . toBaseLinearSpace . fmap toDouble
diff --git a/src/Graphics/Color/Space/RGB/SRGB.hs b/src/Graphics/Color/Space/RGB/SRGB.hs
--- a/src/Graphics/Color/Space/RGB/SRGB.hs
+++ b/src/Graphics/Color/Space/RGB/SRGB.hs
@@ -7,12 +7,13 @@
 {-# LANGUAGE NegativeLiterals #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Space.RGB.SRGB
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -36,6 +37,7 @@
 import qualified Graphics.Color.Model.RGB as CM
 import Graphics.Color.Space.Internal
 import Graphics.Color.Space.RGB.Internal
+import Graphics.Color.Space.RGB.ITU.Rec601 (applyGrayscaleRec601)
 import Graphics.Color.Space.RGB.ITU.Rec709 (BT709, D65)
 import Graphics.Color.Space.RGB.Luma
 
@@ -122,6 +124,11 @@
 -- | `SRGB` color space
 instance (Typeable l, Elevator e) => ColorModel (SRGB l) e where
   type Components (SRGB l) e = (e, e, e)
+  type ChannelCount (SRGB l) = 3
+  channelCount _ = 3
+  {-# INLINE channelCount #-}
+  channelNames _ = channelNames (Proxy :: Proxy (Color CM.RGB e))
+  channelColors _ = channelColors (Proxy :: Proxy (Color CM.RGB e))
   toComponents = toComponents . unColorRGB
   {-# INLINE toComponents #-}
   fromComponents = mkColorRGB . fromComponents
@@ -136,6 +143,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLinearLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = rgbLinearGrayscale
+  {-# INLINE grayscale #-}
+  applyGrayscale = rgbLinearApplyGrayscale
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgbLinear2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear
@@ -151,6 +162,10 @@
   {-# INLINE fromBaseSpace #-}
   luminance = rgbLuminance . fmap toRealFloat
   {-# INLINE luminance #-}
+  grayscale = fmap fromDouble . coerce . rgbLuma @_ @_ @_ @Double
+  {-# INLINE grayscale #-}
+  applyGrayscale = applyGrayscaleRec601
+  {-# INLINE applyGrayscale #-}
   toColorXYZ = rgb2xyz . fmap toRealFloat
   {-# INLINE toColorXYZ #-}
   fromColorXYZ = fmap fromRealFloat . xyz2rgb
diff --git a/src/Graphics/Color/Standard.hs b/src/Graphics/Color/Standard.hs
--- a/src/Graphics/Color/Standard.hs
+++ b/src/Graphics/Color/Standard.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 -- |
 -- Module      : Graphics.Color.Standard
--- Copyright   : (c) Alexey Kuleshevich 2021
+-- Copyright   : (c) Alexey Kuleshevich 2021-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Standard/Internal.hs b/src/Graphics/Color/Standard/Internal.hs
--- a/src/Graphics/Color/Standard/Internal.hs
+++ b/src/Graphics/Color/Standard/Internal.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 -- |
 -- Module      : Graphics.Color.Standard.Internal
--- Copyright   : (c) Alexey Kuleshevich 2019-2021
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Color/Standard/RAL.hs b/src/Graphics/Color/Standard/RAL.hs
--- a/src/Graphics/Color/Standard/RAL.hs
+++ b/src/Graphics/Color/Standard/RAL.hs
@@ -1,13 +1,19 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NegativeLiterals #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
+#if __GLASGOW_HASKELL__ >= 906
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+#else
 {-# LANGUAGE TypeInType #-}
+#endif
 -- |
 -- Module      : Graphics.Color.Standard.RAL
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -475,7 +481,7 @@
     :: ColorSpace cs i e => Color cs e
 
 ral :: ColorSpace cs i e => Float -> Float -> Float -> Color cs e
-ral l' a' b' = convert (ColorLAB l' a' b' :: Color (LAB D50) Float)
+ral l' a' b' = convert (ColorLAB (l' / 100) (a' / 100) (b' / 100) :: Color (LAB D50) Float)
 
 greenBeige = ral 76.022 -0.366 27.636
 beige = ral 73.595 5.518 26.95
diff --git a/src/Graphics/Color/Standard/SVG.hs b/src/Graphics/Color/Standard/SVG.hs
--- a/src/Graphics/Color/Standard/SVG.hs
+++ b/src/Graphics/Color/Standard/SVG.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 -- |
 -- Module      : Graphics.Color.Standard.SVG
--- Copyright   : (c) Alexey Kuleshevich 2021
+-- Copyright   : (c) Alexey Kuleshevich 2021-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -26,7 +26,7 @@
 -- >>> import Graphics.Color.Space.CIE1976.LAB
 -- >>> import Graphics.Color.Illuminant.CIE1931
 -- >>> color (SVG :: SVG "aqua") :: Color (LAB 'D65) Float
--- <LAB CIE1931 'D65:(91.11637000,-48.08154700,-14.12457300)>
+-- <LAB CIE1931 'D65:( 0.91116370,-0.48081547,-0.14124572)>
 --
 data SVG (n :: Symbol) = SVG
 
diff --git a/src/Graphics/Pixel.hs b/src/Graphics/Pixel.hs
--- a/src/Graphics/Pixel.hs
+++ b/src/Graphics/Pixel.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Pixel
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/src/Graphics/Pixel/ColorSpace.hs b/src/Graphics/Pixel/ColorSpace.hs
--- a/src/Graphics/Pixel/ColorSpace.hs
+++ b/src/Graphics/Pixel/ColorSpace.hs
@@ -4,18 +4,19 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Pixel.ColorSpace
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
 -- Portability : non-portable
 --
 module Graphics.Pixel.ColorSpace
-  ( Pixel(Pixel, PixelY, PixelXYZ, PixelLAB, PixelRGB, PixelHSI, PixelHSL, PixelHSV,
+  ( Pixel(Pixel, PixelX, PixelY, PixelXYZ, PixelLAB, PixelRGB, PixelHSI, PixelHSL, PixelHSV,
       PixelCMYK, PixelY'CbCr, PixelY', PixelYA, PixelXYZA, PixelLABA, PixelRGBA, PixelHSIA, PixelHSLA,
       PixelHSVA, PixelCMYKA, PixelY'CbCrA, PixelY'A)
   , liftPixel
@@ -28,6 +29,10 @@
   , fromPixelXYZ
   , toPixelBaseSpace
   , fromPixelBaseSpace
+  -- * Grayscale
+  , grayscalePixel
+  , applyGrayscalePixel
+  , replaceGrayscalePixel
   -- ** Color model
   , toPixelBaseModel
   , fromPixelBaseModel
@@ -56,13 +61,14 @@
 import Graphics.Color.Algebra.Binary
 import qualified Graphics.Color.Model.RGB as CM
 import Graphics.Color.Space
+import Graphics.Pixel (pattern PixelX)
 import Graphics.Pixel.Internal
 
 -- | Convert a pixel from one color space to any other.
 --
 -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
--- >>> px = PixelSRGB @Float 0.0 0.5 1.0
+-- >>> px = PixelSRGB @Float @'NonLinear 0.0 0.5 1.0
 -- >>> px
 -- <SRGB 'NonLinear:( 0.00000000, 0.50000000, 1.00000000)>
 -- >>> convertPixel @(AdobeRGB 'NonLinear) @_ @Word8 px
@@ -79,14 +85,14 @@
 -- | Constructor for a pixel in @sRGB@ color space
 --
 -- @since 0.1.0
-pattern PixelSRGB :: e -> e -> e -> Pixel (SRGB 'NonLinear) e
+pattern PixelSRGB :: forall e l. e -> e -> e -> Pixel (SRGB l) e
 pattern PixelSRGB r g b = Pixel (SRGB (CM.ColorRGB r g b))
 {-# COMPLETE PixelSRGB #-}
 
 -- | Constructor for a pixel in @sRGB@ color space with Alpha channel
 --
 -- @since 0.1.0
-pattern PixelSRGBA :: e -> e -> e -> e -> Pixel (Alpha (SRGB 'NonLinear)) e
+pattern PixelSRGBA :: e -> e -> e -> e -> Pixel (Alpha (SRGB l)) e
 pattern PixelSRGBA r g b a = Pixel (Alpha (SRGB (CM.ColorRGB r g b)) a)
 {-# COMPLETE PixelSRGBA #-}
 
@@ -319,13 +325,37 @@
 toPixelBaseSpace = liftPixel toBaseSpace
 {-# INLINE toPixelBaseSpace #-}
 
--- | Covert a color space of a pixel into it's alternative representation. Example AdobeRGB to HSI.
+-- | Covert a color space of a pixel into its alternative representation. Example AdobeRGB to HSI.
 --
 -- @since 0.1.0
 fromPixelBaseSpace ::
      (ColorSpace cs i e, bcs ~ BaseSpace cs, ColorSpace bcs i e) => Pixel bcs e -> Pixel cs e
 fromPixelBaseSpace = liftPixel fromBaseSpace
 {-# INLINE fromPixelBaseSpace #-}
+
+-- | Drop chroma information from a pixel. Same as `grayscale` for `Color`
+--
+-- @since 0.4.0
+grayscalePixel :: ColorSpace cs i e => Pixel cs e -> Pixel X e
+grayscalePixel = liftPixel grayscale
+{-# INLINE grayscalePixel #-}
+
+
+-- | Apply a function to grayscale information of a pixel leaving chroma untouched. Same
+-- as `applyGrayscale` for `Color`
+--
+-- @since 0.4.0
+applyGrayscalePixel :: ColorSpace cs i e => Pixel cs e -> (Pixel X e -> Pixel X e) -> Pixel cs e
+applyGrayscalePixel c f = coerce (applyGrayscale (coerce c) (coerce f))
+{-# INLINE applyGrayscalePixel #-}
+
+-- | Replace grayscale information in a pixel leaving chroma untouched. Same as
+-- `replaceGrayscale` for `Color`
+--
+-- @since 0.4.0
+replaceGrayscalePixel :: ColorSpace cs i e => Pixel cs e -> Pixel X e -> Pixel cs e
+replaceGrayscalePixel c e = coerce (replaceGrayscale (coerce c) (coerce e))
+{-# INLINE replaceGrayscalePixel #-}
 
 
 -- -- | Constructor for a pixel in @sRGB@ color space with 8-bits per channel
diff --git a/src/Graphics/Pixel/Internal.hs b/src/Graphics/Pixel/Internal.hs
--- a/src/Graphics/Pixel/Internal.hs
+++ b/src/Graphics/Pixel/Internal.hs
@@ -8,7 +8,7 @@
 {-# OPTIONS_HADDOCK hide, not-home #-}
 -- |
 -- Module      : Graphics.Pixel.Internal
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
diff --git a/tests/Graphics/Color/Model/Common.hs b/tests/Graphics/Color/Model/Common.hs
--- a/tests/Graphics/Color/Model/Common.hs
+++ b/tests/Graphics/Color/Model/Common.hs
@@ -46,6 +46,7 @@
 import Test.HUnit (assertBool)
 import Test.Massiv.Array.Mutable
 import Test.QuickCheck
+import GHC.TypeLits
 
 instance (Random e, ColorModel cs e, Arbitrary (Color cs e)) => Arbitrary (Color (Alpha cs) e) where
   arbitrary = addAlpha <$> arbitrary <*> arbitraryElevator
@@ -68,7 +69,7 @@
   expectSameLength xs ys
   zipWithM_ f xs ys
 
-expectSameLength :: Foldable t => t a1 -> t a2 -> IO ()
+expectSameLength :: (HasCallStack, Foldable t) => t a1 -> t a2 -> IO ()
 expectSameLength xs ys =
   unless (length xs == length ys) $
   expectationFailure $ "List lengths mismatch: " ++ show (length xs) ++ "/=" ++ show (length ys)
@@ -154,7 +155,7 @@
 
 
 epsilonEq ::
-     (Show a, RealFloat a)
+     (HasCallStack, Show a, RealFloat a)
   => a -- ^ Epsilon, a maximum tolerated error. Sign is ignored.
   -> a -- ^ Expected result.
   -> a -- ^ Tested value.
@@ -162,7 +163,8 @@
 epsilonEq epsilon x y = property $ epsilonExpect epsilon x y
 
 epsilonEqDouble ::
-     Double -- ^ Expected result.
+     HasCallStack
+  => Double -- ^ Expected result.
   -> Double -- ^ Tested value.
   -> Property
 epsilonEqDouble = epsilonEq epsilon
@@ -178,22 +180,26 @@
     epsilon = 1e-6
 
 
-epsilonEqColor :: (ColorModel cs e, RealFloat e) => Color cs e -> Color cs e -> Property
+epsilonEqColor ::
+     (HasCallStack, ColorModel cs e, RealFloat e) => Color cs e -> Color cs e -> Property
 epsilonEqColor = epsilonEqColorTol epsilon
   where
     epsilon = 1e-11
 
-epsilonEqColorDouble :: ColorModel cs Double => Color cs Double -> Color cs Double -> Property
+epsilonEqColorDouble ::
+     (HasCallStack, ColorModel cs Double) => Color cs Double -> Color cs Double -> Property
 epsilonEqColorDouble = epsilonEqColorTol epsilon
   where
     epsilon = 1e-12
 
-epsilonEqColorFloat :: ColorModel cs Float => Color cs Float -> Color cs Float -> Property
+epsilonEqColorFloat ::
+     (HasCallStack, ColorModel cs Float) => Color cs Float -> Color cs Float -> Property
 epsilonEqColorFloat = epsilonEqColorTol epsilon
   where
     epsilon = 1e-6
 
-epsilonEqColorTol :: (ColorModel cs e, RealFloat e) => e -> Color cs e -> Color cs e -> Property
+epsilonEqColorTol ::
+     (HasCallStack, ColorModel cs e, RealFloat e) => e -> Color cs e -> Color cs e -> Property
 epsilonEqColorTol epsilon x y = property $ epsilonColorExpect epsilon x y
   --conjoin $ F.toList $ liftA2 (epsilonEq epsilon) x y
 
@@ -218,6 +224,7 @@
      , Function (Components cs e)
      , CoArbitrary (Components cs e)
      , Arbitrary (Color cs e)
+     , KnownNat (ChannelCount cs)
      )
   => String
   -> Spec
@@ -225,6 +232,12 @@
   describe "ColorModel" $ do
     toFromComponentsSpec @cs @e
     it "Model Name" $ showsColorModelName (Proxy :: Proxy (Color cs e)) "" `shouldStartWith` name
+    it "ChannelCount" $ do
+      let px = Proxy :: Proxy (Color cs e)
+          count = channelCount px
+      count `shouldBe` fromInteger (natVal (Proxy :: Proxy (ChannelCount cs)))
+      length (channelNames px)  `shouldBe` fromIntegral count
+      length (channelColors px)  `shouldBe` fromIntegral count
     modifyMaxSuccess (`div` 10) $ describe "Array" $ do
       describe "Storable" $
         mutableSpec @S @Ix1 @(Color cs e)
diff --git a/tests/Graphics/Color/Space/CIE1976/LABSpec.hs b/tests/Graphics/Color/Space/CIE1976/LABSpec.hs
--- a/tests/Graphics/Color/Space/CIE1976/LABSpec.hs
+++ b/tests/Graphics/Color/Space/CIE1976/LABSpec.hs
@@ -24,11 +24,12 @@
   colorSpaceLenientSpec @(LAB 'D65) @Double 1e-10
   describe "Same as colour package" $ do
     prop "lab2srgb" $ \lab@(ColorLAB l' a' b' :: Color (LAB 'W.D65) Double) ->
-      case Colour.toSRGB (Colour.cieLAB Colour.d65 l' a' b') of
+      case Colour.toSRGB (Colour.cieLAB Colour.d65 (l' * 100) (a' * 100) (b' * 100)) of
         Colour.RGB r g b ->
           (convertColor lab :: Color (D.SRGB 'W.D65 'NonLinear) Double)
           `epsilonEqColorDouble` ColorRGB r g b
     prop "srgb2xlab" $ \rgb@(ColorRGB r g b :: Color (D.SRGB 'W.D65 'NonLinear) Double) ->
       case Colour.cieLABView Colour.d65 (Colour.sRGB r g b) of
         (l', a', b') ->
-          convertColor rgb `epsilonEqColorDouble` (ColorLAB l' a' b' :: Color (LAB 'W.D65) Double)
+          convertColor rgb `epsilonEqColorDouble`
+          (ColorLAB (l' / 100) (a' / 100) (b' / 100) :: Color (LAB 'W.D65) Double)
diff --git a/tests/Graphics/Color/Space/Common.hs b/tests/Graphics/Color/Space/Common.hs
--- a/tests/Graphics/Color/Space/Common.hs
+++ b/tests/Graphics/Color/Space/Common.hs
@@ -16,11 +16,15 @@
   , prop_toFromBaseSpace
   ) where
 
+import Data.Coerce
 import Graphics.Color.Space
 import Graphics.Color.Model.Common
 
+instance (Elevator e, Random e) => Arbitrary (Color X e) where
+  arbitrary = coerce $ arbitraryElevator @e
+
 instance (Elevator e, Random e) => Arbitrary (Color (Y i) e) where
-  arbitrary = Y <$> arbitraryElevator
+  arbitrary = coerce $ arbitraryElevator @e
 
 instance (Elevator e, Random e) => Arbitrary (Color (XYZ i) e) where
   arbitrary = ColorXYZ <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator
@@ -67,6 +71,44 @@
   -> Property
 prop_toFromBaseModel c = c === fromBaseModel (toBaseModel c)
 
+prop_toApplyGrayscale ::
+     forall cs e i. (ColorSpace cs i e, RealFloat e)
+  => e
+  -> Color cs e
+  -> Property
+prop_toApplyGrayscale epsilon c = epsilonEqColorTol epsilon c $ applyGrayscale c id
+
+prop_toReplaceGrayscale ::
+     forall cs e i. (ColorSpace cs i e, RealFloat e)
+  => e
+  -> Color cs e
+  -> Property
+prop_toReplaceGrayscale epsilon c =
+  epsilonEqColorTol epsilon c (replaceGrayscale c (grayscale c))
+
+prop_toApplyGrayscaleAsReplace ::
+     forall cs e i. (ColorSpace cs i e, RealFloat e)
+  => e
+  -> Color cs e
+  -> Fun (Color X e) (Color X e)
+  -> Property
+prop_toApplyGrayscaleAsReplace epsilon c f =
+  epsilonEqColorTol
+    epsilon
+    (applyGrayscale c (applyFun f))
+    (replaceGrayscale c (applyFun f (grayscale c)))
+
+
+prop_toReplaceGrayscaleAsApply ::
+     forall cs e i. (ColorSpace cs i e, RealFloat e)
+  => e
+  -> Color cs e
+  -> Color X e
+  -> Property
+prop_toReplaceGrayscaleAsApply epsilon c y =
+  epsilonEqColorTol epsilon (replaceGrayscale c y) (applyGrayscale c (const y))
+
+
 colorSpaceCommonSpec ::
      forall cs e i.
      (Arbitrary (Color cs e), ColorSpace cs i e)
@@ -88,7 +130,14 @@
 
 colorSpaceLenientSpec ::
      forall cs e i.
-     (Arbitrary (Color cs e), ColorSpace (BaseSpace cs) i e, ColorSpace cs i e, RealFloat e)
+     ( Arbitrary (Color cs e)
+     , ColorSpace (BaseSpace cs) i e
+     , ColorSpace cs i e
+     , RealFloat e
+     , Function e
+     , Random e
+     , CoArbitrary e
+     )
   => e
   -> Spec
 colorSpaceLenientSpec tol =
@@ -96,3 +145,7 @@
   in colorSpaceCommonSpec @cs @e @i $ do
        prop ("toFromBaseSpace " ++ tolStr) $ prop_toFromBaseSpaceLenient @cs @e @i tol
        prop ("toFromColorXYZ " ++ tolStr) $ prop_toFromLenientColorXYZ @cs @e @i tol
+       prop ("toReplaceGrayscale " ++ tolStr) $ prop_toReplaceGrayscale @cs @e @i tol
+       prop ("toReplaceGrayscaleAsApply " ++ tolStr) $ prop_toReplaceGrayscaleAsApply @cs @e @i tol
+       prop ("toApplyGrayscale" ++ tolStr) $ prop_toApplyGrayscale @cs @e @i tol
+       prop ("toApplyGrayscaleAsReplace" ++ tolStr) $ prop_toApplyGrayscaleAsReplace @cs @e @i tol
diff --git a/tests/doctests.hs b/tests/doctests.hs
deleted file mode 100644
--- a/tests/doctests.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-{-# LANGUAGE CPP #-}
-module Main where
-
-#if __GLASGOW_HASKELL__ >= 802 && __GLASGOW_HASKELL__ < 810
-
-import Test.DocTest (doctest)
-
-main :: IO ()
-main = doctest ["src"]
-
-#else
-
-main :: IO ()
-main = putStrLn "\nDoctests are not supported for older ghc version\n"
-
-#endif