Color 0.2.0 → 0.3.0

raw patch · 53 files changed

+705/−751 lines, 53 filesdep ~vectorPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +22/−0
• Color.cabal +5/−5
• README.md +1/−1
• bench/Conversion.hs +1/−3
• src/Graphics/Color/Adaptation/Internal.hs +1/−2
• src/Graphics/Color/Adaptation/VonKries.hs +0/−3
• src/Graphics/Color/Algebra/Binary.hs +7/−8
• src/Graphics/Color/Model.hs +7/−6
• src/Graphics/Color/Model/Internal.hs +7/−11
• src/Graphics/Color/Model/RGB.hs +0/−1
• src/Graphics/Color/Model/X.hs +112/−0
• src/Graphics/Color/Model/Y.hs +0/−108
• src/Graphics/Color/Model/YCbCr.hs +2/−2
• src/Graphics/Color/Space.hs +7/−5
• src/Graphics/Color/Space/CIE1931/RGB.hs +10/−20
• src/Graphics/Color/Space/Internal.hs +22/−12
• src/Graphics/Color/Space/RGB.hs +11/−11
• src/Graphics/Color/Space/RGB/AdobeRGB.hs +48/−80
• src/Graphics/Color/Space/RGB/Alternative.hs +2/−1
• src/Graphics/Color/Space/RGB/Alternative/CMYK.hs +4/−4
• src/Graphics/Color/Space/RGB/Alternative/HSI.hs +2/−2
• src/Graphics/Color/Space/RGB/Alternative/HSL.hs +2/−2
• src/Graphics/Color/Space/RGB/Alternative/HSV.hs +2/−2
• src/Graphics/Color/Space/RGB/Alternative/YCbCr.hs +76/−86
• src/Graphics/Color/Space/RGB/Derived/AdobeRGB.hs +8/−12
• src/Graphics/Color/Space/RGB/Derived/CIERGB.hs +9/−11
• src/Graphics/Color/Space/RGB/Derived/SRGB.hs +8/−12
• src/Graphics/Color/Space/RGB/ITU/Rec470.hs +19/−39
• src/Graphics/Color/Space/RGB/ITU/Rec601.hs +24/−36
• src/Graphics/Color/Space/RGB/ITU/Rec709.hs +11/−22
• src/Graphics/Color/Space/RGB/Internal.hs +48/−11
• src/Graphics/Color/Space/RGB/Luma.hs +57/−21
• src/Graphics/Color/Space/RGB/SRGB.hs +58/−82
• src/Graphics/Color/Standard/RAL.hs +1/−5
• src/Graphics/Pixel.hs +8/−8
• src/Graphics/Pixel/ColorSpace.hs +31/−28
• src/Graphics/Pixel/Internal.hs +11/−11
• tests/Graphics/Color/Illuminant/CIE1931Spec.hs +1/−0
• tests/Graphics/Color/Illuminant/Common.hs +2/−0
• tests/Graphics/Color/Illuminant/WikipediaSpec.hs +4/−3
• tests/Graphics/Color/Space/CIE1931/RGBSpec.hs +0/−1
• tests/Graphics/Color/Space/CIE1976/LABSpec.hs +3/−5
• tests/Graphics/Color/Space/RGB/AdobeRGBSpec.hs +0/−1
• tests/Graphics/Color/Space/RGB/Alternative/CMYKSpec.hs +0/−2
• tests/Graphics/Color/Space/RGB/Alternative/HSISpec.hs +3/−5
• tests/Graphics/Color/Space/RGB/Alternative/HSLSpec.hs +3/−5
• tests/Graphics/Color/Space/RGB/Alternative/HSVSpec.hs +5/−7
• tests/Graphics/Color/Space/RGB/Alternative/YCbCrSpec.hs +17/−19
• tests/Graphics/Color/Space/RGB/Derived/AdobeRGBSpec.hs +6/−7
• tests/Graphics/Color/Space/RGB/Derived/CIERGBSpec.hs +6/−7
• tests/Graphics/Color/Space/RGB/Derived/SRGBSpec.hs +10/−11
• tests/Graphics/Color/Space/RGB/SRGBSpec.hs +0/−1
• tests/Graphics/Color/Standard/RALSpec.hs +1/−4

@@ -1,7 +1,29 @@ # Changelog for Color +## 0.3.0++* Rename `Y` color model into `X` to avoid the annoying name conflict.+* Add `ColorSpace` instance for `Y'` and enrich it with base space info+* Rename `YCbCr` -> `Y'CbCr` and remove explicit linearity from its base space+* Fix BT470 transfer function. `ecctf` and `dcctf` were mixed up.+* Move `transfer` and `itransfer` functions into the `RedGreenBlue` class+* Move out `ecctf` and `dcctf` functions outside of `RedGreenBlue` class+* Remove all customized functions from RGB modules in favor of their respective class+  implementations:++  * `primaries` (standalone) -> `gamut` (in class)+  * `transfer` (standalone) -> `transfer` (in class)+  * `itransfer` (standalone) -> `itransfer` (in class)+  * `npmStandard` (standalone) -> `npm` (in class)+  * `inpmStandard` (standalone) -> `inpm` (in class)++* Addition of `coerceGamut`+* Fix re-export of vector's `MVector`, `Vector` type families.+* Re-arrange how modules are exported a little bit.+ ## 0.2.0 +* Addition of `CIE1931 RGB` color space * Add `Linearity` kind to `RedGreenBlue` color spaces. * Add `Default` instance for `Pixel` * Addition of universal division `(//)` to `Elevator`

@@ -1,5 +1,5 @@ name:                Color-version:             0.2.0+version:             0.3.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@@ -12,7 +12,7 @@ extra-source-files:  README.md                    , CHANGELOG.md extra-doc-files:     files/*.svg-cabal-version:       >=1.18+cabal-version:       1.18 build-type:          Simple tested-with:          GHC == 8.4.3                     , GHC == 8.4.4@@ -68,6 +68,7 @@                      -- , Graphics.Color.Space.LMS                      , Graphics.Color.Standard.RAL                      , Graphics.Pixel+                     , Graphics.Pixel.Internal                      , Graphics.Pixel.ColorSpace    other-modules:       Graphics.Color.Adaptation.Internal@@ -78,15 +79,14 @@                      , Graphics.Color.Model.HSI                      , Graphics.Color.Model.HSL                      , Graphics.Color.Model.HSV-                     , Graphics.Color.Model.Y+                     , Graphics.Color.Model.X                      , Graphics.Color.Model.YCbCr                      , Graphics.Color.Space.Internal                      , Graphics.Color.Space.RGB.Internal-                     , Graphics.Pixel.Internal   build-depends:       base            >= 4.11 && < 5                      , deepseq                      , data-default-class-                     , vector          >= 0.10+                     , vector          >= 0.11    default-language:    Haskell2010   ghc-options:         -Wall

@@ -7,7 +7,7 @@  | Language | Travis | Azure | Coveralls |Gitter.im | |:--------:|:------:|:--------:|:---------:|:--------:|-| ![GitHub top language](https://img.shields.io/github/languages/top/lehins/Color.svg) | [![Travis](https://img.shields.io/travis/lehins/Color/master.svg?label=Linux%20%26%20OS%20X)](https://travis-ci.org/lehins/Color) | [![Build Status](https://dev.azure.com/kuleshevich/Color/_apis/build/status/lehins.Color?branchName=master)](https://dev.azure.com/kuleshevich/Color/_build/latest?definitionId=1?branchName=master) | [![Coverage Status](https://coveralls.io/repos/github/lehins/Color/badge.svg?branch=master)](https://coveralls.io/github/lehins/Color?branch=master) | [![Join the chat at https://gitter.im/haskell-massiv/Lobby](https://badges.gitter.im/haskell-massiv/Lobby.svg)](https://gitter.im/haskell-massiv/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)+| ![GitHub top language](https://img.shields.io/github/languages/top/lehins/Color.svg) | [![Travis](https://img.shields.io/travis/lehins/Color/master.svg?label=Linux%20%26%20OS%20X)](https://travis-ci.org/lehins/Color) | [![Build Status](https://dev.azure.com/kuleshevich/Color/_apis/build/status/lehins.Color?branchName=master)](https://dev.azure.com/kuleshevich/Color/_build?branchName=master) | [![Coverage Status](https://coveralls.io/repos/github/lehins/Color/badge.svg?branch=master)](https://coveralls.io/github/lehins/Color?branch=master) | [![Join the chat at https://gitter.im/haskell-massiv/Lobby](https://badges.gitter.im/haskell-massiv/Lobby.svg)](https://gitter.im/haskell-massiv/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)  |      Package       | Hackage | Nightly | LTS | |:-------------------|:-------:|:-------:|:---:|

@@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -10,11 +9,10 @@ import Control.DeepSeq import System.Random as R import qualified Graphics.Color.Model as CM+import Graphics.Color.Algebra import Graphics.Color.Model import Graphics.Color.Space-import Graphics.Color.Space.RGB import Graphics.Color.Illuminant.CIE1931-import Graphics.Color.Space.CIE1976.LAB import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived  import qualified Data.Colour as Colour

@@ -1,6 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -101,7 +100,7 @@ {-# RULES "convertElevatedWith (Float)"[~2] forall (a :: Adaptation t i i Float) . convertElevatedWith a = convertNoAdaptationFloat "convertElevatedWith (Double)"[~2] forall (a :: Adaptation t i i Double) . convertElevatedWith a = convertNoAdaptation-#-}+  #-}   -- toword8 <$> (fromColorXYZ (chromaticAdaptationXYZ (vonKriesAdaptationMatrix :: VonKriesAdaptationMatrix Bradford D50a D65 Double) (toColorXYZ (ColorLAB 76.022 (-0.366) 27.636 :: Color (LAB D50a) Double) :: Color XYZ Double)) :: Color SRGB Double)

@@ -1,10 +1,7 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NegativeLiterals #-}-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}

@@ -24,7 +24,6 @@   , fromNum   ) where -import Control.Monad import Data.Bits import qualified Data.Vector.Generic as V import qualified Data.Vector.Generic.Mutable as M@@ -194,11 +193,11 @@   {-# INLINE basicUnsafeSlice #-}   basicOverlaps (MV_Bit mvec) (MV_Bit mvec') = M.basicOverlaps mvec mvec'   {-# INLINE basicOverlaps #-}-  basicUnsafeNew len = MV_Bit `liftM` M.basicUnsafeNew len+  basicUnsafeNew len = MV_Bit <$> M.basicUnsafeNew len   {-# INLINE basicUnsafeNew #-}-  basicUnsafeReplicate len (Bit w) = MV_Bit `liftM` M.basicUnsafeReplicate len w+  basicUnsafeReplicate len (Bit w) = MV_Bit <$> M.basicUnsafeReplicate len w   {-# INLINE basicUnsafeReplicate #-}-  basicUnsafeRead (MV_Bit mvec) idx = Bit `liftM` M.basicUnsafeRead mvec idx+  basicUnsafeRead (MV_Bit mvec) idx = Bit <$> M.basicUnsafeRead mvec idx   {-# INLINE basicUnsafeRead #-}   basicUnsafeWrite (MV_Bit mvec) idx (Bit w) = M.basicUnsafeWrite mvec idx w   {-# INLINE basicUnsafeWrite #-}@@ -210,7 +209,7 @@   {-# INLINE basicUnsafeCopy #-}   basicUnsafeMove (MV_Bit mvec) (MV_Bit mvec') = M.basicUnsafeMove mvec mvec'   {-# INLINE basicUnsafeMove #-}-  basicUnsafeGrow (MV_Bit mvec) len = MV_Bit `liftM` M.basicUnsafeGrow mvec len+  basicUnsafeGrow (MV_Bit mvec) len = MV_Bit <$> M.basicUnsafeGrow mvec len   {-# INLINE basicUnsafeGrow #-} #if MIN_VERSION_vector(0,11,0)   basicInitialize (MV_Bit mvec) = M.basicInitialize mvec@@ -221,15 +220,15 @@ newtype instance U.Vector Bit = V_Bit (U.Vector Word8)  instance V.Vector U.Vector Bit where-  basicUnsafeFreeze (MV_Bit mvec) = V_Bit `liftM` V.basicUnsafeFreeze mvec+  basicUnsafeFreeze (MV_Bit mvec) = V_Bit <$> V.basicUnsafeFreeze mvec   {-# INLINE basicUnsafeFreeze #-}-  basicUnsafeThaw (V_Bit vec) = MV_Bit `liftM` V.basicUnsafeThaw vec+  basicUnsafeThaw (V_Bit vec) = MV_Bit <$> V.basicUnsafeThaw vec   {-# INLINE basicUnsafeThaw #-}   basicLength (V_Bit vec) = V.basicLength vec   {-# INLINE basicLength #-}   basicUnsafeSlice idx len (V_Bit vec) = V_Bit (V.basicUnsafeSlice idx len vec)   {-# INLINE basicUnsafeSlice #-}-  basicUnsafeIndexM (V_Bit vec) idx = Bit `liftM` V.basicUnsafeIndexM vec idx+  basicUnsafeIndexM (V_Bit vec) idx = Bit <$> V.basicUnsafeIndexM vec idx   {-# INLINE basicUnsafeIndexM #-}   basicUnsafeCopy (MV_Bit mvec) (V_Bit vec) = V.basicUnsafeCopy mvec vec   {-# INLINE basicUnsafeCopy #-}

@@ -15,9 +15,10 @@   , getAlpha   , setAlpha   , dropAlpha+  , modifyAlpha   , modifyOpaque-  -- * Y-  , module Graphics.Color.Model.Y+  -- * X+  , module Graphics.Color.Model.X   -- * RGB   , module Graphics.Color.Model.RGB   -- * HSI@@ -36,13 +37,13 @@   , module Graphics.Color.Algebra.Elevator   ) where +import Graphics.Color.Algebra.Binary+import Graphics.Color.Algebra.Elevator import Graphics.Color.Model.CMYK import Graphics.Color.Model.HSI import Graphics.Color.Model.HSL import Graphics.Color.Model.HSV-import Graphics.Color.Model.Internal hiding (MVector, Vector)+import Graphics.Color.Model.Internal import Graphics.Color.Model.RGB-import Graphics.Color.Model.Y+import Graphics.Color.Model.X import Graphics.Color.Model.YCbCr-import Graphics.Color.Algebra.Binary-import Graphics.Color.Algebra.Elevator

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -46,7 +45,6 @@  import Control.Applicative import Control.DeepSeq (NFData(rnf), deepseq)-import Control.Monad (liftM) import Data.Default.Class (Default(..)) import Data.Foldable import Data.Kind@@ -170,11 +168,11 @@   {-# INLINE basicUnsafeSlice #-}   basicOverlaps (MV_Color mvec) (MV_Color mvec') = VM.basicOverlaps mvec mvec'   {-# INLINE basicOverlaps #-}-  basicUnsafeNew len = MV_Color `liftM` VM.basicUnsafeNew len+  basicUnsafeNew len = MV_Color <$> VM.basicUnsafeNew len   {-# INLINE basicUnsafeNew #-}-  basicUnsafeReplicate len val = MV_Color `liftM` VM.basicUnsafeReplicate len (toComponents val)+  basicUnsafeReplicate len val = MV_Color <$> VM.basicUnsafeReplicate len (toComponents val)   {-# INLINE basicUnsafeReplicate #-}-  basicUnsafeRead (MV_Color mvec) idx = fromComponents `liftM` VM.basicUnsafeRead mvec idx+  basicUnsafeRead (MV_Color mvec) idx = fromComponents <$> VM.basicUnsafeRead mvec idx   {-# INLINE basicUnsafeRead #-}   basicUnsafeWrite (MV_Color mvec) idx val = VM.basicUnsafeWrite mvec idx (toComponents val)   {-# INLINE basicUnsafeWrite #-}@@ -186,26 +184,24 @@   {-# INLINE basicUnsafeCopy #-}   basicUnsafeMove (MV_Color mvec) (MV_Color mvec') = VM.basicUnsafeMove mvec mvec'   {-# INLINE basicUnsafeMove #-}-  basicUnsafeGrow (MV_Color mvec) len = MV_Color `liftM` VM.basicUnsafeGrow mvec len+  basicUnsafeGrow (MV_Color mvec) len = MV_Color <$> VM.basicUnsafeGrow mvec len   {-# INLINE basicUnsafeGrow #-}-#if MIN_VERSION_vector(0,11,0)   basicInitialize (MV_Color mvec) = VM.basicInitialize mvec   {-# INLINE basicInitialize #-}-#endif   newtype instance VU.Vector (Color cs e) = V_Color (VU.Vector (Components cs e))  instance (ColorModel cs e) => V.Vector VU.Vector (Color cs e) where-  basicUnsafeFreeze (MV_Color mvec) = V_Color `liftM` V.basicUnsafeFreeze mvec+  basicUnsafeFreeze (MV_Color mvec) = V_Color <$> V.basicUnsafeFreeze mvec   {-# INLINE basicUnsafeFreeze #-}-  basicUnsafeThaw (V_Color vec) = MV_Color `liftM` V.basicUnsafeThaw vec+  basicUnsafeThaw (V_Color vec) = MV_Color <$> V.basicUnsafeThaw vec   {-# INLINE basicUnsafeThaw #-}   basicLength (V_Color vec) = V.basicLength vec   {-# INLINE basicLength #-}   basicUnsafeSlice idx len (V_Color vec) = V_Color (V.basicUnsafeSlice idx len vec)   {-# INLINE basicUnsafeSlice #-}-  basicUnsafeIndexM (V_Color vec) idx = fromComponents `liftM` V.basicUnsafeIndexM vec idx+  basicUnsafeIndexM (V_Color vec) idx = fromComponents <$> V.basicUnsafeIndexM vec idx   {-# INLINE basicUnsafeIndexM #-}   basicUnsafeCopy (MV_Color mvec) (V_Color vec) = V.basicUnsafeCopy mvec vec   {-# INLINE basicUnsafeCopy #-}

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

@@ -0,0 +1,112 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module      : Graphics.Color.Model.X+-- Copyright   : (c) Alexey Kuleshevich 2018-2020+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+--+module Graphics.Color.Model.X+  ( X+  -- * Constructors for X color model.+  , pattern ColorX+  , pattern ColorXA+  , Color(X)+  , Weights(..)+  , rgb2y+  ) where++import Data.Coerce+import Foreign.Storable+import Graphics.Color.Model.Internal+import Graphics.Color.Model.RGB++-------------+--- X ---+-------------++-- | A color with a single channel, most likely luminance+data X++-- | A single channel color `X`+newtype instance Color X e = X e++-- | Constructor for @X@+pattern ColorX :: e -> Color X e+pattern ColorX y = X y+{-# COMPLETE ColorX #-}++-- | Constructor for @X@ with alpha channel.+pattern ColorXA :: e -> e -> Color (Alpha X) e+pattern ColorXA y a = Alpha (X y) a+{-# COMPLETE ColorXA #-}++-- | `X` color model+deriving instance Eq e => Eq (Color X e)+-- | `X` color model+deriving instance Ord e => Ord (Color X e)+-- | `X` color model+deriving instance Storable e => Storable (Color X e)+++-- | `X` color model+instance Elevator e => Show (Color X e) where+  showsPrec _ = showsColorModel++-- | `X` color model+instance Elevator e => ColorModel X e where+  type Components X e = e+  toComponents (X y) = y+  {-# INLINE toComponents #-}+  fromComponents = X+  {-# INLINE fromComponents #-}++-- | `X` color model+instance Functor (Color X) where+  fmap f (X y) = X (f y)+  {-# INLINE fmap #-}++-- | `X` color model+instance Applicative (Color X) where+  pure = X+  {-# INLINE pure #-}+  (X fy) <*> (X y) = X (fy y)+  {-# INLINE (<*>) #-}++-- | `X` color model+instance Foldable (Color X) where+  foldr f !z (X y) = f y z+  {-# INLINE foldr #-}++-- | `X` color model+instance Traversable (Color X) where+  traverse f (X y) = X <$> f y+  {-# INLINE traverse #-}++-- | Convert an RGB color model to a single channel by using the supplied weights+--+-- @since 0.1.0+rgb2y ::+     forall e e'. (Elevator e', Elevator e, RealFloat e)+  => Color RGB e'+  -> Weights e+  -> Color X e+rgb2y rgb weights =+  X (coerce (fmap toRealFloat rgb :: Color RGB e) `dotProduct` coerce weights)+{-# INLINE rgb2y #-}++-- | Weights imposed on individual channels of a 3-component color+--+-- @since 0.1.0+newtype Weights e = Weights+  { unWeights :: V3 e+  } deriving (Eq, Num, Show, Fractional, Floating, Functor)

@@ -1,108 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-}--- |--- Module      : Graphics.Color.Model.Y--- Copyright   : (c) Alexey Kuleshevich 2018-2020--- License     : BSD3--- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>--- Stability   : experimental--- Portability : non-portable----module Graphics.Color.Model.Y-  ( Y-  -- * Constructors for Y color model.-  , pattern ColorY-  , pattern ColorYA-  , Color(Y)-  , Weights(..)-  , rgb2y-  ) where--import Data.Coerce-import Foreign.Storable-import Graphics.Color.Model.Internal-import Graphics.Color.Model.RGB------------------- Y --------------------- | Luminance of a color-data Y---- | Luminance `Y`-newtype instance Color Y e = Y e---- | Constructor for @Y@-pattern ColorY :: e -> Color Y e-pattern ColorY y = Y y-{-# COMPLETE ColorY #-}---- | Constructor for @Y@ with alpha channel.-pattern ColorYA :: e -> e -> Color (Alpha Y) e-pattern ColorYA y a = Alpha (Y y) a-{-# COMPLETE ColorYA #-}---- | `Y` color model-deriving instance Eq e => Eq (Color Y e)--- | `Y` color model-deriving instance Ord e => Ord (Color Y e)--- | `Y` color model-deriving instance Storable e => Storable (Color Y e)----- | `Y` color model-instance Elevator e => Show (Color Y e) where-  showsPrec _ = showsColorModel---- | `Y` color model-instance Elevator e => ColorModel Y e where-  type Components Y e = e-  toComponents (Y y) = y-  {-# INLINE toComponents #-}-  fromComponents = Y-  {-# INLINE fromComponents #-}---- | `Y` color model-instance Functor (Color Y) where-  fmap f (Y y) = Y (f y)-  {-# INLINE fmap #-}---- | `Y` color model-instance Applicative (Color Y) where-  pure = Y-  {-# INLINE pure #-}-  (Y fy) <*> (Y y) = Y (fy y)-  {-# INLINE (<*>) #-}---- | `Y` color model-instance Foldable (Color Y) where-  foldr f !z (Y y) = f y z-  {-# INLINE foldr #-}---- | `Y` color model-instance Traversable (Color Y) where-  traverse f (Y y) = Y <$> f y-  {-# INLINE traverse #-}---rgb2y ::-     forall e e'. (Elevator e', Elevator e, RealFloat e)-  => Color RGB e'-  -> Weights e-  -> Color Y e-rgb2y rgb weights =-  Y (coerce (fmap toRealFloat rgb :: Color RGB e) `dotProduct` coerce weights)-{-# INLINE rgb2y #-}---newtype Weights e = Weights-  { unWeights :: V3 e-  } deriving (Eq, Num, Show, Fractional, Floating, Functor)

@@ -31,7 +31,7 @@ import Foreign.Storable import Graphics.Color.Model.Internal import Graphics.Color.Model.RGB-import Graphics.Color.Model.Y+import Graphics.Color.Model.X  -- | `YCbCr` color model data YCbCr@@ -83,7 +83,7 @@ rgb2ycbcr rgb' weights@(Weights (V3 kr _ kb)) = ColorYCbCr y' cb cr   where     rgb@(ColorRGB r' _ b') = toRealFloat <$> rgb'-    ColorY y' = rgb2y rgb weights+    ColorX y' = rgb2y rgb weights     !cb = 0.5 + 0.5 * (b' - y') / (1 - kb)     !cr = 0.5 + 0.5 * (r' - y') / (1 - kr) {-# INLINE rgb2ycbcr #-}

@@ -11,17 +11,19 @@ module Graphics.Color.Space   ( convertColor   , convertColorFloat-  , module X+  , module Graphics.Color.Space.RGB+  , module Graphics.Color.Space.Internal+  , module Graphics.Color.Space.CIE1976.LAB   ) where -import Graphics.Color.Model.Internal as X-import Graphics.Color.Space.Internal as X-import Graphics.Color.Space.RGB.Internal as X+import Graphics.Color.Space.CIE1976.LAB+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB   -- | Convert a color space through `XYZ` intermediary with `Double` precision. Illuminant is -- enforced to be the same, but in case that it is a limitation and chromatic adaptation is--- needed `Graphics.Color.Adaptation.convertWith` can be used instead.+-- needed `Graphics.Color.Adaptation.convert` can be used instead. -- -- @since 0.1.1 convertColor ::

@@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}@@ -20,18 +19,17 @@ -- module Graphics.Color.Space.CIE1931.RGB   ( CIERGB-  , primaries   , castLinearity-  , module Graphics.Color.Space   ) where  import Data.Coerce import Data.Typeable import Foreign.Storable+import Graphics.Color.Illuminant.CIE1931 import Graphics.Color.Model.Internal import qualified Graphics.Color.Model.RGB as CM-import Graphics.Color.Space-import Graphics.Color.Illuminant.CIE1931+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB.Internal   -- | The original @CIE1931 RGB@ color space with an arbitrary illuminant@@ -78,16 +76,17 @@   {-# INLINE luminance #-}   toColorXYZ = rgbLinear2xyz . fmap toRealFloat . castLinearity   {-# INLINE toColorXYZ #-}-  fromColorXYZ xyz = castLinearity (fromRealFloat <$> (xyz2rgbLinear @CIERGB xyz))+  fromColorXYZ xyz = castLinearity (fromRealFloat <$> xyz2rgbLinear @CIERGB xyz)   {-# INLINE fromColorXYZ #-}  -- | `CIERGB` color space instance RedGreenBlue CIERGB 'E where-  gamut = primaries-  ecctf = coerce-  {-# INLINE ecctf #-}-  dcctf = coerce-  {-# INLINE dcctf #-}+  -- | [Source](https://github.com/colour-science/colour/blob/60679360c3990bc549b5f947bfeb621383e18b5e/colour/models/rgb/datasets/cie_rgb.py#L44-L48)+  gamut = Gamut (Primary 0.734742840005998 0.265257159994002)+                (Primary 0.273779033824958 0.717477700256116)+                (Primary 0.166555629580280 0.008910726182545)+  transfer = id+  itransfer = id  -- | CIE RGB does not utilize any gamma function, therefore it is safe to cast the -- `Linearity` kind.@@ -96,12 +95,3 @@ castLinearity :: Color (CIERGB l') e -> Color (CIERGB l) e castLinearity = coerce ---- | Primaries for CIERGB------ @since 0.2.0-primaries :: RealFloat e => Gamut rgb i e-primaries = Gamut (Primary 0.734742840005998 0.265257159994002)-                  (Primary 0.273779033824958 0.717477700256116)-                  (Primary 0.166555629580280 0.008910726182545)--- Source ^: https://github.com/colour-science/colour/blob/60679360c3990bc549b5f947bfeb621383e18b5e/colour/models/rgb/datasets/cie_rgb.py#L44-L48

@@ -6,7 +6,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -23,7 +22,17 @@ -- Portability : non-portable -- module Graphics.Color.Space.Internal-  ( Color(Luminance, XYZ, CIExyY)+  ( ColorModel(..)+  -- * Alpha+  , Alpha+  , Opaque+  , addAlpha+  , getAlpha+  , setAlpha+  , dropAlpha+  , modifyAlpha+  , modifyOpaque+  , Color(Alpha, Luminance, XYZ, CIExyY)   , ColorSpace(..)   , Chromaticity(..)   , Primary(.., Primary)@@ -49,15 +58,16 @@   , CIExyY   , pattern ColorCIExy   , pattern ColorCIExyY-  , module GHC.TypeNats-  , module Graphics.Color.Algebra-  , module Graphics.Color.Model.Internal+  , showsColorModel+  , module Graphics.Color.Algebra.Binary+  , module Graphics.Color.Algebra.Elevator   ) where  import Foreign.Storable+import Graphics.Color.Algebra.Binary+import Graphics.Color.Algebra.Elevator import Graphics.Color.Model.Internal-import qualified Graphics.Color.Model.Y as CM-import Graphics.Color.Algebra+import qualified Graphics.Color.Model.X as CM import Data.Typeable import Data.Coerce import GHC.TypeNats@@ -422,16 +432,16 @@ data Y (i :: k)  -- | Luminance `Y`-newtype instance Color (Y i) e = Luminance (CM.Color CM.Y e)+newtype instance Color (Y i) e = Luminance (CM.Color CM.X e)  -- | Constructor for @Y@ with alpha channel. pattern Y :: e -> Color (Y i) e-pattern Y y = Luminance (CM.Y y)+pattern Y y = Luminance (CM.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.Y y)) a+pattern YA y a = Alpha (Luminance (CM.X y)) a {-# COMPLETE YA #-}  -- | `Y` - relative luminance of a color space@@ -465,7 +475,7 @@  -- | CIE1931 `XYZ` color space instance (Illuminant i, Elevator e) => ColorSpace (Y i) i e where-  type BaseModel (Y i) = CM.Y+  type BaseModel (Y i) = CM.X   toBaseSpace = id   fromBaseSpace = id   luminance = fmap toRealFloat@@ -476,5 +486,5 @@   {-# INLINE fromColorXYZ #-}  {-# RULES-"luminance   :: RealFloat a => Color Y a -> Color Y a" luminance = id+"luminance :: RealFloat a => Color Y a -> Color Y a" luminance = id  #-}

@@ -1,4 +1,3 @@-{-# LANGUAGE PatternSynonyms #-} -- | -- Module      : Graphics.Color.Space.RGB -- Copyright   : (c) Alexey Kuleshevich 2019-2020@@ -8,18 +7,19 @@ -- Portability : non-portable -- module Graphics.Color.Space.RGB-  ( -- * Default sRGB color space-    pattern ColorSRGB-  , pattern ColorSRGBA-  , SRGB-  , D65-  -- * Re-exports-  , module Graphics.Color.Space+  ( module Graphics.Color.Space.RGB.Luma+  , module Graphics.Color.Space.RGB.SRGB+  , module Graphics.Color.Space.RGB.AdobeRGB+  , module Graphics.Color.Space.RGB.CIERGB   , module Graphics.Color.Space.RGB.Alternative-  , module Graphics.Color.Space.RGB.Luma+  , module Graphics.Color.Space.RGB.Internal+  , module Graphics.Color.Space.Internal   ) where -import Graphics.Color.Space+import Graphics.Color.Space.Internal import Graphics.Color.Space.RGB.Alternative+import Graphics.Color.Space.RGB.Internal import Graphics.Color.Space.RGB.Luma-import Graphics.Color.Space.RGB.SRGB (pattern ColorSRGB, pattern ColorSRGBA, SRGB, D65)+import Graphics.Color.Space.RGB.AdobeRGB+import Graphics.Color.Space.RGB.SRGB+import Graphics.Color.Space.RGB.CIERGB

@@ -24,26 +24,52 @@   , pattern ColorAdobeRGBA   , AdobeRGB   , D65-  , primaries-  , npmStandard-  , inpmStandard-  , transfer-  , itransfer-  , module Graphics.Color.Space   ) where  import Data.Typeable-import Data.Coerce import Foreign.Storable import Graphics.Color.Model.Internal import qualified Graphics.Color.Model.RGB as CM-import Graphics.Color.Space+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB.Internal import Graphics.Color.Space.RGB.ITU.Rec601 (D65)   -- | A very common [AdobeRGB (1998)](https://en.wikipedia.org/wiki/Adobe_RGB_color_space)--- color space with the default `D65` illuminant+-- color space with: --+-- * `D65` illuminant+--+-- * Transfer function:+--+-- \[+-- \gamma(u) = u^{2.19921875} = u^\frac{563}{256}+-- \]+--+-- * Inverse transfer function:+--+-- \[+-- \gamma^{-1}(u) = u^\frac{1}{2.19921875} = u^\frac{256}{563}+-- \]+--+-- * Normalized primary matrix:+--+-- >>> :set -XDataKinds+-- >>> import Graphics.Color.Space.RGB.AdobeRGB+-- >>> npm :: NPM AdobeRGB Float+-- [ [ 0.57667000, 0.18556000, 0.18823000 ]+-- , [ 0.29734000, 0.62736000, 0.07529000 ]+-- , [ 0.02703000, 0.07069000, 0.99134000 ] ]+--+-- * Inverse normalized primary matrix:+--+-- >>> :set -XDataKinds+-- >>> import Graphics.Color.Space.RGB.AdobeRGB+-- >>> inpm :: INPM AdobeRGB Float+-- [ [ 2.04159000,-0.56501000,-0.34473000 ]+-- , [-0.96924000, 1.87597000, 0.04156000 ]+-- , [ 0.01344000,-0.11836000, 1.01517000 ] ]+-- -- @since 0.1.0 data AdobeRGB (l :: Linearity) @@ -121,74 +147,16 @@  -- | `AdobeRGB` color space instance RedGreenBlue AdobeRGB D65 where-  gamut = primaries-  npm = npmStandard-  inpm = inpmStandard-  ecctf = AdobeRGB . fmap transfer . coerce-  {-# INLINE ecctf #-}-  dcctf = AdobeRGB . fmap itransfer . coerce-  {-# INLINE dcctf #-}---- | AdobeRGB normalized primary matrix. This is a helper definition, use `npm` instead.------ >>> :set -XDataKinds--- >>> import Graphics.Color.Space.RGB.AdobeRGB--- >>> npmStandard :: NPM AdobeRGB Float--- [ [ 0.57667000, 0.18556000, 0.18823000 ]--- , [ 0.29734000, 0.62736000, 0.07529000 ]--- , [ 0.02703000, 0.07069000, 0.99134000 ] ]------ @since 0.1.0-npmStandard :: RealFloat e => NPM AdobeRGB e-npmStandard = NPM $ M3x3 (V3 0.57667 0.18556 0.18823)-                         (V3 0.29734 0.62736 0.07529)-                         (V3 0.02703 0.07069 0.99134)----- | AdobeRGB inverse normalized primary matrix. This is a helper definition, use `inpm` instead.------ >>> :set -XDataKinds--- >>> import Graphics.Color.Space.RGB.AdobeRGB--- >>> inpmStandard :: INPM AdobeRGB Float--- [ [ 2.04159000,-0.56501000,-0.34473000 ]--- , [-0.96924000, 1.87597000, 0.04156000 ]--- , [ 0.01344000,-0.11836000, 1.01517000 ] ]------ @since 0.1.0-inpmStandard :: RealFloat e => INPM AdobeRGB e-inpmStandard = INPM $ M3x3 (V3  2.04159 -0.56501 -0.34473)-                           (V3 -0.96924  1.87597  0.04156)-                           (V3  0.01344 -0.11836  1.01517)------ | AdobeRGB transfer function "gamma":------ \[--- \gamma(u) = u^{2.19921875} = u^\frac{563}{256}--- \]------ @since 0.1.0-transfer :: Floating a => a -> a-transfer u = u ** (256 / 563)-{-# INLINE transfer #-}----- | AdobeRGB inverse transfer function "gamma":------ \[--- \gamma^{-1}(u) = u^\frac{1}{2.19921875} = u^\frac{256}{563}--- \]------ @since 0.1.0-itransfer :: Floating a => a -> a-itransfer u = u ** 2.19921875 -- in rational form 563/256-{-# INLINE itransfer #-}---- | @AdobeRGB@ primaries------ @since 0.1.0-primaries :: RealFloat e => Gamut rgb i e-primaries = Gamut (Primary 0.64 0.33)-                  (Primary 0.21 0.71)-                  (Primary 0.15 0.06)+  gamut = Gamut (Primary 0.64 0.33)+                (Primary 0.21 0.71)+                (Primary 0.15 0.06)+  transfer u = u ** (256 / 563)+  {-# INLINE transfer #-}+  itransfer u = u ** 2.19921875 -- in rational form 563/256+  {-# INLINE itransfer #-}+  npm = NPM $ M3x3 (V3 0.57667 0.18556 0.18823)+                   (V3 0.29734 0.62736 0.07529)+                   (V3 0.02703 0.07069 0.99134)+  inpm = INPM $ M3x3 (V3  2.04159 -0.56501 -0.34473)+                     (V3 -0.96924  1.87597  0.04156)+                     (V3  0.01344 -0.11836  1.01517)

@@ -1,4 +1,3 @@-{-# LANGUAGE PatternSynonyms #-} -- | -- Module      : Graphics.Color.Space.RGB.Alternative -- Copyright   : (c) Alexey Kuleshevich 2019-2020@@ -12,6 +11,8 @@   ( module X   ) where +import Graphics.Color.Space.Internal as X+import Graphics.Color.Space.RGB.Internal as X import Graphics.Color.Space.RGB.Alternative.HSI as X import Graphics.Color.Space.RGB.Alternative.HSL as X import Graphics.Color.Space.RGB.Alternative.HSV as X

@@ -23,7 +23,6 @@   , pattern ColorCMYKA   , CMYK   , Color(CMYK)-  , module Graphics.Color.Space   ) where  import Data.Coerce@@ -32,12 +31,13 @@ import Foreign.Storable import qualified Graphics.Color.Model.CMYK as CM import Graphics.Color.Model.Internal-import Graphics.Color.Space-import Graphics.Color.Space.RGB.AdobeRGB as AdobeRGB+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB.Internal import qualified Graphics.Color.Space.RGB.ITU.Rec470 as Rec470+import Graphics.Color.Space.RGB.AdobeRGB+import Graphics.Color.Space.RGB.SRGB import Graphics.Color.Space.RGB.ITU.Rec601 import Graphics.Color.Space.RGB.ITU.Rec709-import Graphics.Color.Space.RGB.SRGB   -- | `CMYK` representation for some (@`RedGreenBlue` cs i@) color space

@@ -25,7 +25,6 @@   , pattern ColorH360SI   , HSI   , Color(HSI)-  , module Graphics.Color.Space   ) where  import Data.Coerce@@ -33,7 +32,8 @@ import Foreign.Storable import qualified Graphics.Color.Model.HSI as CM import Graphics.Color.Model.Internal-import Graphics.Color.Space+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB.Internal   -- | `HSI` representation for some (@`RedGreenBlue` cs i@) color space

@@ -25,7 +25,6 @@   , pattern ColorH360SL   , HSL   , Color(HSL)-  , module Graphics.Color.Space   ) where  import Data.Coerce@@ -33,7 +32,8 @@ import Foreign.Storable import qualified Graphics.Color.Model.HSL as CM import Graphics.Color.Model.Internal-import Graphics.Color.Space+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB.Internal  -- | `HSL` representation for some (@`RedGreenBlue` cs i@) color space data HSL cs

@@ -25,7 +25,6 @@   , pattern ColorH360SV   , HSV   , Color(HSV)-  , module Graphics.Color.Space   ) where  import Data.Coerce@@ -33,7 +32,8 @@ import Foreign.Storable import qualified Graphics.Color.Model.HSV as CM import Graphics.Color.Model.Internal-import Graphics.Color.Space+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB.Internal  -- | `HSV` representation for some (@`RedGreenBlue` cs i@) color space data HSV cs

@@ -20,77 +20,71 @@ -- Portability : non-portable -- module Graphics.Color.Space.RGB.Alternative.YCbCr-  ( pattern ColorYCbCr-  , pattern ColorYCbCrA-  , YCbCr-  , Color(YCbCr)+  ( pattern ColorY'CbCr+  , pattern ColorY'CbCrA+  , Y'CbCr+  , Color(Y'CbCr)   , ycbcr2srgb   , srgb2ycbcr-  , toColorYCbCr-  , fromColorYCbCr-  , module Graphics.Color.Space+  , toColorY'CbCr+  , fromColorY'CbCr+  , module Graphics.Color.Space.RGB.Luma   ) where  import Data.Coerce+import Data.Kind import Data.Proxy+import Data.Typeable import Foreign.Storable import Graphics.Color.Model.Internal import qualified Graphics.Color.Model.YCbCr as CM-import Graphics.Color.Space-import Graphics.Color.Space.RGB.SRGB+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB.Internal import Graphics.Color.Space.RGB.ITU.Rec601 import Graphics.Color.Space.RGB.ITU.Rec709 import Graphics.Color.Space.RGB.Luma+import Graphics.Color.Space.RGB.SRGB --- | `YCbCr` representation for some (@`RedGreenBlue` cs i@) color space-data YCbCr cs+-- | `Y'CbCr` representation for some non-linear (@`RedGreenBlue` cs i@) color space+data Y'CbCr (cs :: Linearity -> Type) --- | `YCbCr` representation for some (@`RedGreenBlue` cs i@) color space-newtype instance Color (YCbCr cs) e = YCbCr (Color CM.YCbCr e)+-- | Constructor  for `Y'CbCr` color space+newtype instance Color (Y'CbCr cs) e = Y'CbCr (Color CM.YCbCr e) --- | `YCbCr` representation for some (@`RedGreenBlue` cs i@) color space-deriving instance Eq e => Eq (Color (YCbCr cs) e)--- | `YCbCr` representation for some (@`RedGreenBlue` cs i@) color space-deriving instance Ord e => Ord (Color (YCbCr cs) e)--- | `YCbCr` representation for some (@`RedGreenBlue` cs i@) color space-deriving instance Functor (Color (YCbCr cs))--- | `YCbCr` representation for some (@`RedGreenBlue` cs i@) color space-deriving instance Applicative (Color (YCbCr cs))--- | `YCbCr` representation for some (@`RedGreenBlue` cs i@) color space-deriving instance Foldable (Color (YCbCr cs))--- | `YCbCr` representation for some (@`RedGreenBlue` cs i@) color space-deriving instance Traversable (Color (YCbCr cs))--- | `YCbCr` representation for some (@`RedGreenBlue` cs i@) color space-deriving instance Storable e => Storable (Color (YCbCr cs) e)+deriving instance Eq e => Eq (Color (Y'CbCr cs) e)+deriving instance Ord e => Ord (Color (Y'CbCr cs) e)+deriving instance Functor (Color (Y'CbCr cs))+deriving instance Applicative (Color (Y'CbCr cs))+deriving instance Foldable (Color (Y'CbCr cs))+deriving instance Traversable (Color (Y'CbCr cs))+deriving instance Storable e => Storable (Color (Y'CbCr cs) e) --- | `YCbCr` representation for some (@`RedGreenBlue` cs i@) color space-instance ColorModel cs e => Show (Color (YCbCr cs) e) where+instance (Typeable cs, ColorModel (cs 'NonLinear) e, Elevator e) => Show (Color (Y'CbCr cs) e) where   showsPrec _ = showsColorModel --- | Constructor for an RGB color space in an alternative YCbCr color model-pattern ColorYCbCr :: e -> e -> e -> Color (YCbCr cs) e-pattern ColorYCbCr y cb cr = YCbCr (CM.ColorYCbCr y cb cr)-{-# COMPLETE ColorYCbCr #-}+-- | Constructor for an RGB color space in an alternative Y'CbCr color model+pattern ColorY'CbCr :: e -> e -> e -> Color (Y'CbCr cs) e+pattern ColorY'CbCr y cb cr = Y'CbCr (CM.ColorYCbCr y cb cr)+{-# COMPLETE ColorY'CbCr #-} --- | Constructor for @YCbCr@ with alpha channel.-pattern ColorYCbCrA :: e -> e -> e -> e -> Color (Alpha (YCbCr cs)) e-pattern ColorYCbCrA y cb cr a = Alpha (YCbCr (CM.ColorYCbCr y cb cr)) a-{-# COMPLETE ColorYCbCrA #-}+-- | Constructor for @Y'CbCr@ with alpha channel.+pattern ColorY'CbCrA :: e -> e -> e -> e -> Color (Alpha (Y'CbCr cs)) e+pattern ColorY'CbCrA y cb cr a = Alpha (Y'CbCr (CM.ColorYCbCr y cb cr)) a+{-# COMPLETE ColorY'CbCrA #-}  --- | `YCbCr` color model-instance ColorModel cs e => ColorModel (YCbCr cs) e where-  type Components (YCbCr cs) e = (e, e, e)-  toComponents (ColorYCbCr y cb cr) = (y, cb, cr)+instance (Typeable cs, ColorModel (cs 'NonLinear) e, Elevator e) => ColorModel (Y'CbCr cs) e where+  type Components (Y'CbCr cs) e = (e, e, e)+  toComponents (ColorY'CbCr y cb cr) = (y, cb, cr)   {-# INLINE toComponents #-}-  fromComponents (y, cb, cr) = ColorYCbCr y cb cr+  fromComponents (y, cb, cr) = ColorY'CbCr y cb cr   {-# INLINE fromComponents #-}-  showsColorModelName _ = ("YCbCr-" ++) . showsColorModelName (Proxy :: Proxy (Color cs e))+  showsColorModelName _ =+    ("Y'CbCr-" ++) . showsColorModelName (Proxy :: Proxy (Color (cs 'NonLinear) e)) --- | `YCbCr` representation for `SRGB` color space-instance Elevator e => ColorSpace (YCbCr (SRGB 'NonLinear)) D65 e where-  type BaseModel (YCbCr (SRGB 'NonLinear)) = CM.YCbCr-  type BaseSpace (YCbCr (SRGB 'NonLinear)) = SRGB 'NonLinear+instance Elevator e => ColorSpace (Y'CbCr SRGB) D65 e where+  type BaseModel (Y'CbCr SRGB) = CM.YCbCr+  type BaseSpace (Y'CbCr SRGB) = SRGB 'NonLinear   toBaseSpace = fmap fromRealFloat . ycbcr2srgb . fmap toFloat   {-# INLINE toBaseSpace #-}   fromBaseSpace = fmap fromRealFloat . srgb2ycbcr . fmap toFloat@@ -98,47 +92,43 @@   luminance = luminance . toBaseSpace   {-# INLINE luminance #-} --- | `YCbCr` representation for `BT601_525` color space-instance Elevator e => ColorSpace (YCbCr (BT601_525 'NonLinear)) D65 e where-  type BaseModel (YCbCr (BT601_525 'NonLinear)) = CM.YCbCr-  type BaseSpace (YCbCr (BT601_525 'NonLinear)) = BT601_525 'NonLinear-  toBaseSpace = fmap fromDouble . fromColorYCbCr+instance Elevator e => ColorSpace (Y'CbCr BT601_525) D65 e where+  type BaseModel (Y'CbCr BT601_525) = CM.YCbCr+  type BaseSpace (Y'CbCr BT601_525) = BT601_525 'NonLinear+  toBaseSpace = fmap fromDouble . fromColorY'CbCr   {-# INLINE toBaseSpace #-}-  fromBaseSpace = fmap fromDouble . toColorYCbCr+  fromBaseSpace = fmap fromDouble . toColorY'CbCr   {-# INLINE fromBaseSpace #-}   luminance = luminance . toBaseSpace   {-# INLINE luminance #-} --- | `YCbCr` representation for `BT601_625` color space-instance Elevator e => ColorSpace (YCbCr (BT601_625 'NonLinear)) D65 e where-  type BaseModel (YCbCr (BT601_625 'NonLinear)) = CM.YCbCr-  type BaseSpace (YCbCr (BT601_625 'NonLinear)) = BT601_625 'NonLinear-  toBaseSpace = fmap fromDouble . fromColorYCbCr+instance Elevator e => ColorSpace (Y'CbCr BT601_625) D65 e where+  type BaseModel (Y'CbCr BT601_625) = CM.YCbCr+  type BaseSpace (Y'CbCr BT601_625) = BT601_625 'NonLinear+  toBaseSpace = fmap fromDouble . fromColorY'CbCr   {-# INLINE toBaseSpace #-}-  fromBaseSpace = fmap fromDouble . toColorYCbCr+  fromBaseSpace = fmap fromDouble . toColorY'CbCr   {-# INLINE fromBaseSpace #-}   luminance = luminance . toBaseSpace   {-# INLINE luminance #-} --- | `YCbCr` representation for `BT709` color space-instance Elevator e => ColorSpace (YCbCr (BT709 'NonLinear)) D65 e where-  type BaseModel (YCbCr (BT709 'NonLinear)) = CM.YCbCr-  type BaseSpace (YCbCr (BT709 'NonLinear)) = BT709 'NonLinear-  toBaseSpace = fmap fromDouble . fromColorYCbCr+instance Elevator e => ColorSpace (Y'CbCr BT709) D65 e where+  type BaseModel (Y'CbCr BT709) = CM.YCbCr+  type BaseSpace (Y'CbCr BT709) = BT709 'NonLinear+  toBaseSpace = fmap fromDouble . fromColorY'CbCr   {-# INLINE toBaseSpace #-}-  fromBaseSpace = fmap fromDouble . toColorYCbCr+  fromBaseSpace = fmap fromDouble . toColorY'CbCr   {-# INLINE fromBaseSpace #-}   luminance = luminance . toBaseSpace   {-# INLINE luminance #-} --- | `YCbCr` representation for some (@`RedGreenBlue` cs i@) color space-instance (Luma (cs i), ColorSpace (cs i 'NonLinear) i e, RedGreenBlue (cs i) i) =>-         ColorSpace (YCbCr (cs i 'NonLinear)) i e where-  type BaseModel (YCbCr (cs i 'NonLinear)) = CM.YCbCr-  type BaseSpace (YCbCr (cs i 'NonLinear)) = cs i 'NonLinear-  toBaseSpace = fmap fromDouble . fromColorYCbCr+instance (Typeable cs, Luma (cs i), ColorSpace (cs i 'NonLinear) i e, RedGreenBlue (cs i) i) =>+         ColorSpace (Y'CbCr (cs i)) i e where+  type BaseModel (Y'CbCr (cs i)) = CM.YCbCr+  type BaseSpace (Y'CbCr (cs i)) = cs i 'NonLinear+  toBaseSpace = fmap fromDouble . fromColorY'CbCr   {-# INLINE toBaseSpace #-}-  fromBaseSpace = fmap fromDouble . toColorYCbCr+  fromBaseSpace = fmap fromDouble . toColorY'CbCr   {-# INLINE fromBaseSpace #-}   luminance = luminance . toBaseSpace   {-# INLINE luminance #-}@@ -148,8 +138,8 @@ -- -- @since 0.1.3 ycbcr2srgb ::-     (RedGreenBlue cs i, RealFloat e) => Color (YCbCr (cs 'NonLinear)) e -> Color (cs 'NonLinear) e-ycbcr2srgb (ColorYCbCr y' cb cr) = ColorRGB r' g' b'+     (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@@ -162,35 +152,35 @@ -- -- @since 0.1.3 srgb2ycbcr ::-     (RedGreenBlue cs i, RealFloat e) => Color (cs 'NonLinear) e -> Color (YCbCr (cs 'NonLinear)) e-srgb2ycbcr (ColorRGB r' g' b') = ColorYCbCr y' cb cr+     (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' {-# INLINE srgb2ycbcr #-} --- | Convert any RGB color space that has `Luma` specified to `YCbCr`+-- | Convert any RGB color space that has `Luma` specified to `Y'CbCr` -- -- @since 0.1.3-toColorYCbCr ::+toColorY'CbCr ::      forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e)   => Color (cs 'NonLinear) e'-  -> Color (YCbCr (cs 'NonLinear)) e-toColorYCbCr rgb = YCbCr (CM.rgb2ycbcr (unColorRGB rgb) weights)+  -> Color (Y'CbCr cs) e+toColorY'CbCr rgb = Y'CbCr (CM.rgb2ycbcr (unColorRGB rgb) weights)   where     !weights = rgbLumaWeights rgb-{-# INLINE toColorYCbCr #-}+{-# INLINE toColorY'CbCr #-} --- | Convert `YCbCr` to the base RGB color space, which must have `Luma` implemented.+-- | Convert `Y'CbCr` to the base RGB color space, which must have `Luma` implemented. -- -- @since 0.1.3-fromColorYCbCr ::+fromColorY'CbCr ::      forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e)-  => Color (YCbCr (cs 'NonLinear)) e'+  => Color (Y'CbCr cs) e'   -> Color (cs 'NonLinear) e-fromColorYCbCr ycbcr = rgb+fromColorY'CbCr ycbcr = rgb   where     !rgb = mkColorRGB (CM.ycbcr2rgb (coerce ycbcr :: Color CM.YCbCr e') weights)     !weights = rgbLumaWeights rgb-{-# INLINE fromColorYCbCr #-}+{-# INLINE fromColorY'CbCr #-}

@@ -4,10 +4,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Space.RGB.Derived.AdobeRGB@@ -19,18 +19,14 @@ -- module Graphics.Color.Space.RGB.Derived.AdobeRGB   ( AdobeRGB-  , AdobeRGB.primaries-  , AdobeRGB.transfer-  , AdobeRGB.itransfer-  , module Graphics.Color.Space   ) where -import Data.Coerce import Data.Typeable import Foreign.Storable import Graphics.Color.Model.Internal import qualified Graphics.Color.Model.RGB as CM-import Graphics.Color.Space+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB.Internal import qualified Graphics.Color.Space.RGB.AdobeRGB as AdobeRGB  @@ -97,8 +93,8 @@  -- | `AdobeRGB` color space (derived) instance Illuminant i => RedGreenBlue (AdobeRGB i) i where-  gamut = AdobeRGB.primaries-  ecctf = AdobeRGB . fmap AdobeRGB.transfer . coerce-  {-# INLINE ecctf #-}-  dcctf = AdobeRGB . fmap AdobeRGB.itransfer . coerce-  {-# INLINE dcctf #-}+  gamut = coerceGamut (gamut @_ @AdobeRGB.AdobeRGB)+  transfer = transfer @_ @AdobeRGB.AdobeRGB+  {-# INLINE transfer #-}+  itransfer = itransfer @_ @AdobeRGB.AdobeRGB+  {-# INLINE itransfer #-}

@@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}@@ -20,9 +19,7 @@ -- module Graphics.Color.Space.RGB.Derived.CIERGB   ( CIERGB-  , CIERGB.primaries   , castLinearity-  , module Graphics.Color.Space   ) where  import Data.Coerce@@ -30,7 +27,8 @@ import Foreign.Storable import Graphics.Color.Model.Internal import qualified Graphics.Color.Model.RGB as CM-import Graphics.Color.Space+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB.Internal import qualified Graphics.Color.Space.CIE1931.RGB as CIERGB  @@ -67,7 +65,7 @@   fromComponents = mkColorRGB . fromComponents   {-# INLINE fromComponents #-} --- | `CIERGB` linear color space (derived)+-- | `CIERGB` color space (derived) instance (Illuminant i, Typeable l, Elevator e) => ColorSpace (CIERGB i l) i e where   type BaseModel (CIERGB i l) = CM.RGB   toBaseSpace = id@@ -78,16 +76,16 @@   {-# INLINE luminance #-}   toColorXYZ = rgbLinear2xyz . fmap toRealFloat . castLinearity   {-# INLINE toColorXYZ #-}-  fromColorXYZ xyz = castLinearity (fromRealFloat <$> (xyz2rgbLinear @(CIERGB i) xyz))+  fromColorXYZ xyz = castLinearity (fromRealFloat <$> xyz2rgbLinear @(CIERGB i) xyz)   {-# INLINE fromColorXYZ #-}  -- | `CIERGB` color space (derived) instance Illuminant i => RedGreenBlue (CIERGB i) i where-  gamut = CIERGB.primaries-  ecctf = coerce-  {-# INLINE ecctf #-}-  dcctf = coerce-  {-# INLINE dcctf #-}+  gamut = coerceGamut (gamut @_ @CIERGB.CIERGB)+  transfer = id+  {-# INLINE transfer #-}+  itransfer = id+  {-# INLINE itransfer #-}  -- | CIE RGB does not utilize any gamma function, therefore it is safe to cast the -- `Linearity` kind.

@@ -4,10 +4,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Space.RGB.Derived.SRGB@@ -19,18 +19,14 @@ -- module Graphics.Color.Space.RGB.Derived.SRGB   ( SRGB-  , SRGB.primaries-  , SRGB.transfer-  , SRGB.itransfer-  , module Graphics.Color.Space   ) where -import Data.Coerce import Data.Typeable import Foreign.Storable import Graphics.Color.Model.Internal import qualified Graphics.Color.Model.RGB as CM-import Graphics.Color.Space+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB.Internal import Graphics.Color.Space.RGB.Luma import qualified Graphics.Color.Space.RGB.SRGB as SRGB @@ -99,11 +95,11 @@  -- | `SRGB` color space (derived) instance Illuminant i => RedGreenBlue (SRGB i) i where-  gamut = SRGB.primaries-  ecctf = SRGB . fmap SRGB.transfer . coerce-  {-# INLINE ecctf #-}-  dcctf = SRGB . fmap SRGB.itransfer . coerce-  {-# INLINE dcctf #-}+  gamut = coerceGamut (gamut @_ @SRGB.SRGB)+  transfer = transfer @_ @SRGB.SRGB+  {-# INLINE transfer #-}+  itransfer = itransfer @_ @SRGB.SRGB+  {-# INLINE itransfer #-}   instance Luma (SRGB i) where

@@ -1,13 +1,12 @@-{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NegativeLiterals #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Space.RGB.ITU.Rec470@@ -24,17 +23,14 @@   , pattern BT470_625   , BT470_625   , D65-  , primaries525-  , primaries625-  , module Graphics.Color.Space   ) where -import Data.Coerce import Data.Typeable import Foreign.Storable-import qualified Graphics.Color.Model.RGB as CM-import Graphics.Color.Space import Graphics.Color.Illuminant.ITU.Rec470+import qualified Graphics.Color.Model.RGB as CM+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB.Internal  ------------------------------------ -- ITU-R BT.470 (525) --------------@@ -102,11 +98,13 @@  -- | ITU-R BT.470 (525) color space instance RedGreenBlue BT470_525 C where-  gamut = primaries525-  ecctf c = BT470_525 (fmap (gamma 2.2) (coerce c))-  {-# INLINE ecctf #-}-  dcctf c = BT470_525 (fmap (igamma 2.2) (coerce c))-  {-# INLINE dcctf #-}+  gamut = Gamut (Primary 0.67 0.33)+                (Primary 0.21 0.71)+                (Primary 0.14 0.08)+  transfer = gamma (1 / 2.2)+  {-# INLINE transfer #-}+  itransfer = gamma 2.2+  {-# INLINE itransfer #-}  ------------------------------------ -- ITU-R BT.470 (625) --------------@@ -174,34 +172,16 @@  -- | ITU-R BT.470 (625) color space instance RedGreenBlue BT470_625 D65 where-  gamut = primaries625-  ecctf c = BT470_625 (fmap (gamma 2.8) (coerce c))-  {-# INLINE ecctf #-}-  dcctf c = BT470_625 (fmap (igamma 2.8) (coerce c))-  {-# INLINE dcctf #-}+  gamut = Gamut (Primary 0.64 0.33)+                (Primary 0.29 0.60)+                (Primary 0.15 0.06)+  transfer = gamma (1 / 2.8)+  {-# INLINE transfer #-}+  itransfer = gamma 2.8+  {-# INLINE itransfer #-} +-- | Gamma correction function gamma :: Floating a => a -> a -> a gamma p v = v ** p {-# INLINE gamma #-}--igamma :: Floating a => a -> a -> a-igamma p v = v ** (1 / p)-{-# INLINE igamma #-}---- | Primaries for ITU-R BT.470 (525).------ @since 0.1.0-primaries525 :: RealFloat e => Gamut rgb i e-primaries525 = Gamut (Primary 0.67 0.33)-                     (Primary 0.21 0.71)-                     (Primary 0.14 0.08)----- | Primaries for ITU-R BT.470 and BT.601 (625).------ @since 0.1.0-primaries625 :: RealFloat e => Gamut rgb i e-primaries625 = Gamut (Primary 0.64 0.33)-                     (Primary 0.29 0.60)-                     (Primary 0.15 0.06) 

@@ -5,10 +5,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NegativeLiterals #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Space.RGB.ITU.Rec601@@ -24,21 +24,16 @@   , pattern BT601_625   , BT601_625   , D65-  , primaries525-  , primaries625-  , transfer-  , itransfer-  , module Graphics.Color.Space   ) 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 Graphics.Color.Space-import Graphics.Color.Space.RGB.ITU.Rec470 (primaries625)+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB.Internal+import Graphics.Color.Space.RGB.ITU.Rec470 (BT470_625) import Graphics.Color.Space.RGB.Luma  @@ -110,11 +105,13 @@  -- | ITU-R BT.601 (525) color space instance RedGreenBlue BT601_525 D65 where-  gamut = primaries525-  ecctf = BT601_525 . fmap transfer . coerce-  {-# INLINE ecctf #-}-  dcctf = BT601_525 . fmap itransfer . coerce-  {-# INLINE dcctf #-}+  gamut = Gamut (Primary 0.630 0.340)+                (Primary 0.310 0.595)+                (Primary 0.155 0.070)+  transfer = transferRec601+  {-# INLINE transfer #-}+  itransfer = itransferRec601+  {-# INLINE itransfer #-}  ------------------------------------ -- ITU-R BT.601 (625) --------------@@ -182,11 +179,11 @@  -- | ITU-R BT.601 (625) color space instance RedGreenBlue BT601_625 D65 where-  gamut = primaries625-  ecctf = BT601_625 . fmap transfer . coerce-  {-# INLINE ecctf #-}-  dcctf = BT601_625 . fmap itransfer . coerce-  {-# INLINE dcctf #-}+  gamut = coerceGamut (gamut @_ @BT470_625)+  transfer = transferRec601+  {-# INLINE transfer #-}+  itransfer = itransferRec601+  {-# INLINE itransfer #-}  instance Luma BT601_525 where   rWeight = 0.299@@ -210,11 +207,11 @@ -- \] -- -- @since 0.1.0-transfer :: (Ord a, Floating a) => a -> a-transfer l+transferRec601 :: (Ord a, Floating a) => a -> a+transferRec601 l   | l < 0.018 = 4.5 * l   | otherwise = 1.099 * (l ** 0.45 {- ~ 1 / 2.2 -}) - 0.099-{-# INLINE transfer #-}+{-# INLINE transferRec601 #-}  -- | Rec.601 inverse transfer function "gamma". This is a helper function, therefore `dcctf` should -- be used instead.@@ -226,21 +223,12 @@ --   \end{cases} -- \] ----- @since 0.1.0-itransfer :: (Ord a, Floating a) => a -> a-itransfer e+itransferRec601 :: (Ord a, Floating a) => a -> a+itransferRec601 e   | e < inv0018 = e / 4.5   | otherwise = ((e + 0.099) / 1.099) ** (1 / 0.45)-  where-    !inv0018 = transfer 0.018 -- ~ 0.081-{-# INLINE itransfer #-}-+{-# INLINE itransferRec601 #-} --- | Primaries for ITU-R BT.601 (525).------ @since 0.1.0-primaries525 :: RealFloat e => Gamut rgb i e-primaries525 = Gamut (Primary 0.630 0.340)-                     (Primary 0.310 0.595)-                     (Primary 0.155 0.070)+inv0018 :: (Ord a, Floating a) => a+inv0018 = transferRec601 0.018 -- ~ 0.081 

@@ -4,10 +4,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NegativeLiterals #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Space.RGB.ITU.Rec709@@ -21,19 +21,15 @@   ( pattern BT709   , BT709   , D65-  , primaries-  , Rec601.transfer-  , Rec601.itransfer-  , module Graphics.Color.Space   ) where -import Data.Coerce import Data.Typeable import Foreign.Storable import Graphics.Color.Model.Internal import qualified Graphics.Color.Model.RGB as CM-import Graphics.Color.Space-import Graphics.Color.Space.RGB.ITU.Rec601 as Rec601 (D65, itransfer, transfer)+import Graphics.Color.Space.Internal+import Graphics.Color.Space.RGB.Internal+import Graphics.Color.Space.RGB.ITU.Rec601 as Rec601 (D65, BT601_625) import Graphics.Color.Space.RGB.Luma  -- | [ITU-R BT.709](https://en.wikipedia.org/wiki/Rec._709) color space@@ -98,20 +94,13 @@  -- | ITU-R BT.709 color space instance RedGreenBlue BT709 D65 where-  gamut = primaries-  ecctf = BT709 . fmap Rec601.transfer . coerce-  {-# INLINE ecctf #-}-  dcctf = BT709 . fmap Rec601.itransfer . coerce-  {-# INLINE dcctf #-}----- | Primaries for ITU-R BT.709, which are also the primaries for sRGB color space.------ @since 0.1.0-primaries :: RealFloat e => Gamut rgb i e-primaries = Gamut (Primary 0.64 0.33)-                  (Primary 0.30 0.60)-                  (Primary 0.15 0.06)+  gamut = Gamut (Primary 0.64 0.33)+                (Primary 0.30 0.60)+                (Primary 0.15 0.06)+  transfer = transfer @_ @BT601_625+  {-# INLINE transfer #-}+  itransfer = itransfer @_ @BT601_625+  {-# INLINE itransfer #-}   instance Luma BT709 where

@@ -1,3 +1,4 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-}@@ -6,12 +7,12 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-}@@ -28,7 +29,10 @@   , pattern ColorRGBA   , RedGreenBlue(..)   , Linearity(..)+  , ecctf+  , dcctf   , Gamut(..)+  , coerceGamut   , rgb2xyz   , rgbLinear2xyz   , xyz2rgb@@ -44,7 +48,7 @@   , rgbColorGamut   , pixelWhitePoint   , gamutWhitePoint-  , module Graphics.Color.Algebra+  , module Graphics.Color.Space.Internal   ) where  import Data.Coerce@@ -60,22 +64,21 @@   -- the __@i@__ type parameter   gamut :: RealFloat e => Gamut cs i e -  -- | Encoding color component transfer function (inverse). Also known as opto-electronic-  -- transfer function (OETF / OECF) or gamma function.-  ecctf :: (RealFloat a, Elevator a) => Color (cs 'Linear) a -> Color (cs 'NonLinear) a+  -- | @since 0.3.0+  transfer :: RealFloat e => e -> e -  -- | Decoding color component transfer function (forward)-  dcctf :: (RealFloat a, Elevator a) => Color (cs 'NonLinear) a -> Color (cs 'Linear) a+  -- | @since 0.3.0+  itransfer :: RealFloat e => e -> e    -- | Normalized primary matrix for this RGB color space. Default implementation derives   -- it from `chromaticity`-  npm :: (ColorSpace (cs 'Linear) i a, RealFloat a) => NPM cs a+  npm :: (ColorSpace (cs 'Linear) i e, RealFloat e) => NPM cs e   npm = npmDerive gamut   {-# INLINE npm #-}    -- | Inverse normalized primary matrix for this RGB color space. Default implementation   -- derives it from `chromaticity`-  inpm :: (ColorSpace (cs 'Linear) i a, RealFloat a) => INPM cs a+  inpm :: (ColorSpace (cs 'Linear) i e, RealFloat e) => INPM cs e   inpm = inpmDerive gamut   {-# INLINE inpm #-} @@ -91,8 +94,16 @@     Coercible (Color (cs l) e) (Color CM.RGB e) => Color (cs l) e -> Color CM.RGB e   unColorRGB = coerce +-- | This function allows for creating a completely mismatched color space spec. Make+-- sure you know what you are doing, if you need to use it.+--+-- @since 0.3.0+coerceGamut :: Gamut cs' i' e -> Gamut cs i e+coerceGamut (Gamut r g b) = Gamut (coerce r) (coerce g) (coerce b) -data Gamut cs i e = Gamut++-- | RGB color space gamut specification.+data Gamut (cs :: Linearity -> Type) i e = Gamut   { gamutRedPrimary   :: !(Primary i e)   , gamutGreenPrimary :: !(Primary i e)   , gamutBluePrimary  :: !(Primary i e)@@ -112,9 +123,35 @@ -- its type carries enough information for this operation. -- -- @since 0.1.0-gamutWhitePoint :: (RedGreenBlue cs i, RealFloat e) => Gamut cs i e -> WhitePoint i e+gamutWhitePoint ::+     forall cs e i. (RedGreenBlue cs i, RealFloat e)+  => Gamut cs i e+  -> WhitePoint i e gamutWhitePoint _ = whitePoint {-# INLINE gamutWhitePoint #-}+++-- | Encoding color component transfer function (forward). Also known as opto-electronic+-- transfer function (OETF / OECF).+--+-- @since 0.1.0+ecctf ::+     forall cs e i. (RedGreenBlue cs i, RealFloat e)+  => Color (cs 'Linear) e+  -> Color (cs 'NonLinear) e+ecctf = mkColorRGB . fmap (transfer @_ @cs) . unColorRGB+{-# INLINE ecctf #-}++-- | Decoding color component transfer function (inverse).  Also known as electro-optical+-- transfer function (EOTF / EOCF).+--+-- @since 0.1.0+dcctf ::+     forall cs e i. (RedGreenBlue cs i, RealFloat e)+  => Color (cs 'NonLinear) e+  -> Color (cs 'Linear) e+dcctf = mkColorRGB . fmap (itransfer @_ @cs) . unColorRGB+{-# INLINE dcctf #-}   -- | Linear transformation of a pixel in a linear RGB color space into XYZ color space

@@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -10,7 +9,9 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} -- | -- Module      : Graphics.Color.Space.RGB.Luma -- Copyright   : (c) Alexey Kuleshevich 2018-2020@@ -30,14 +31,17 @@   , Weights(..)   , rgbLuma   , rgbLumaWeights+  , toBaseLinearSpace   ) where -import Data.Kind import Data.Coerce+import Data.Kind+import Data.Typeable import Foreign.Storable-import Graphics.Color.Model.RGB as CM import Graphics.Color.Model.Internal-import Graphics.Color.Model.Y as CM+import Graphics.Color.Model.RGB as CM+import Graphics.Color.Model.X as CM+import Graphics.Color.Space.Internal import Graphics.Color.Space.RGB.Internal  -------------@@ -46,54 +50,86 @@  -- | [Luma](https://en.wikipedia.org/wiki/Luma_(video\)) of a non-linear gamma corrected -- RGB color space. (Not to be confused with luminance `Y`)-data Y'+data Y' (cs :: Linearity -> Type)  -- | Constructor for Luma.-newtype instance Color Y' e = Luma (CM.Color CM.Y e)+newtype instance Color (Y' cs) e = Luma (CM.Color CM.X e)  -- | Constructor for Luma `Y'`. (Not to be confused with luminance `Y`) -- -- @since 0.1.0-pattern Y' :: e -> Color Y' e-pattern Y' y = Luma (CM.Y y)+pattern Y' :: e -> Color (Y' cs) e+pattern Y' y = Luma (CM.X y) {-# COMPLETE Y' #-}  -- | Constructor for `Y'` with alpha channel. (Not to be confused with luminance `Y`) -- -- @since 0.1.4-pattern Y'A :: e -> e -> Color (Alpha Y') e-pattern Y'A y a = Alpha (Luma (CM.Y y)) a+pattern Y'A :: e -> e -> Color (Alpha (Y' cs)) e+pattern Y'A y a = Alpha (Luma (CM.X y)) a {-# COMPLETE Y'A #-}  -- | `Y'` - luma of a color space-deriving instance Eq e => Eq (Color Y' e)+deriving instance Eq e => Eq (Color (Y' cs) e) -- | `Y'` - luma of a color space-deriving instance Ord e => Ord (Color Y' e)+deriving instance Ord e => Ord (Color (Y' cs) e) -- | `Y'` - luma of a color space-deriving instance Functor (Color Y')+deriving instance Functor (Color (Y' cs)) -- | `Y'` - luma of a color space-deriving instance Applicative (Color Y')+deriving instance Applicative (Color (Y' cs)) -- | `Y'` - luma of a color space-deriving instance Foldable (Color Y')+deriving instance Foldable (Color (Y' cs)) -- | `Y'` - luma of a color space-deriving instance Traversable (Color Y')+deriving instance Traversable (Color (Y' cs)) -- | `Y'` - luma of a color space-deriving instance Storable e => Storable (Color Y' e)+deriving instance Storable e => Storable (Color (Y' cs) e)   -- | `Y'` - as a color model-instance Elevator e => Show (Color Y' e) where+instance (Typeable cs, Elevator e) => Show (Color (Y' cs) e) where   showsPrec _ = showsColorModel  -- | `Y'` - as a color model-instance Elevator e => ColorModel Y' e where-  type Components Y' e = e+instance (Typeable cs, Elevator e) => ColorModel (Y' cs) e where+  type Components (Y' cs) e = e   toComponents (Y' y) = y   {-# INLINE toComponents #-}   fromComponents = Y'   {-# INLINE fromComponents #-}  +instance ( Typeable cs+         , Illuminant i+         , ColorSpace (cs 'Linear) i e+         , ColorSpace (cs 'NonLinear) i e+         , Luma cs+         , RedGreenBlue cs i+         , RealFloat e+         ) =>+         ColorSpace (Y' cs) i e where+  type BaseModel (Y' cs) = CM.X+  type BaseSpace (Y' cs) = cs 'NonLinear+  toBaseSpace y = pure (coerce y :: e)+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = rgbLuma+  {-# INLINE fromBaseSpace #-}+  luminance = luminance . toBaseLinearSpace+  {-# INLINE luminance #-}+  toColorXYZ = toColorXYZ . toBaseLinearSpace+  {-# INLINE toColorXYZ #-}++-- | Convert Luma directly into the linear version of base space. This is equivalent to+-- `dcctf . toBaseSpace`, but is a bit faster, since inverse transfer function is applied+-- only once+--+-- @since 0.3.0+toBaseLinearSpace ::+     forall cs e i. (RedGreenBlue cs i, Applicative (Color (cs 'Linear)), RealFloat e)+  => Color (Y' cs) e+  -> Color (cs 'Linear) e+toBaseLinearSpace y = pure (itransfer @_ @cs (coerce y :: e))+{-# INLINE toBaseLinearSpace #-}+ ------------------ -- Luma Weights -- ------------------@@ -135,7 +171,7 @@ rgbLuma ::      forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e)   => Color (cs 'NonLinear) e'-  -> Color Y' e+  -> Color (Y' cs) e rgbLuma rgb' = Y' (coerce (fmap toRealFloat rgb :: Color CM.RGB e) `dotProduct` coerce weights)   where     !rgb = unColorRGB rgb'

@@ -8,6 +8,7 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Space.RGB.SRGB@@ -25,11 +26,6 @@   , SRGB   , D50   , D65-  , primaries-  , npmStandard-  , inpmStandard-  , transfer-  , itransfer   ) where  import Data.Coerce@@ -40,11 +36,50 @@ 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.Rec709 (D65, primaries)+import Graphics.Color.Space.RGB.ITU.Rec709 (BT709, D65) import Graphics.Color.Space.RGB.Luma --- | The most common [sRGB](https://en.wikipedia.org/wiki/SRGB) color space with the--- default `D65` illuminant+-- | The most common [sRGB](https://en.wikipedia.org/wiki/SRGB) color space, which is+-- defined with:+--+-- * `D65` illuminant+--+-- * Transfer function:+--+-- \[+-- \gamma(u) = \begin{cases}+--     12.92 u & u \leq 0.0031308 \\+--     1.055 u^{1/2.4} - 0.055 & \text{otherwise}+--   \end{cases}+-- \]+--+-- * Inverse transfer function+--+-- \[+-- \gamma^{-1}(u) = \begin{cases}+--     u / 12.92 & u \leq 0.04045 \\+--     \left(\tfrac{u + 0.055}{1.055}\right)^{2.4} & \text{otherwise}+--   \end{cases}+-- \]+--+-- * Normalized primary matrix:+--+-- >>> :set -XDataKinds+-- >>> import Graphics.Color.Space.RGB+-- >>> npm :: NPM SRGB Float+-- [ [ 0.41240000, 0.35760000, 0.18050000 ]+-- , [ 0.21260000, 0.71520000, 0.07220000 ]+-- , [ 0.01930000, 0.11920000, 0.95050000 ] ]+--+-- * Inverse normalized primary matrix:+--+-- >>> :set -XDataKinds+-- >>> import Graphics.Color.Space.RGB+-- >>> inpm :: INPM SRGB Float+-- [ [ 3.24060000,-1.53720000,-0.49860000 ]+-- , [-0.96890000, 1.87580000, 0.04150000 ]+-- , [ 0.05570000,-0.20400000, 1.05700000 ] ]+-- data SRGB (l :: Linearity)  @@ -123,82 +158,23 @@  -- | `SRGB` color space instance RedGreenBlue SRGB D65 where-  gamut = primaries-  npm = npmStandard-  inpm = inpmStandard-  ecctf = SRGB . fmap transfer . coerce-  {-# INLINE ecctf #-}-  dcctf = SRGB . fmap itransfer . coerce-  {-# INLINE dcctf #-}+  gamut = coerce (gamut @_ @BT709)+  npm = NPM $ M3x3 (V3 0.4124 0.3576 0.1805)+                   (V3 0.2126 0.7152 0.0722)+                   (V3 0.0193 0.1192 0.9505)+  inpm = INPM $ M3x3 (V3  3.2406 -1.5372 -0.4986)+                     (V3 -0.9689  1.8758  0.0415)+                     (V3  0.0557 -0.2040  1.0570)+  transfer u+    | u <= 0.0031308 = 12.92 * u+    | otherwise = 1.055 * (u ** (1 / 2.4)) - 0.055+  {-# INLINE transfer #-}+  itransfer u+    | u <= 0.04045 = u / 12.92+    | otherwise = ((u + 0.055) / 1.055) ** 2.4+  {-# INLINE itransfer #-}  instance Luma SRGB where   rWeight = 0.299   gWeight = 0.587   bWeight = 0.114----- | sRGB normalized primary matrix. This is a helper definition, use `npm` instead.------ >>> :set -XDataKinds--- >>> import Graphics.Color.Space.RGB--- >>> npmStandard :: NPM SRGB Float--- [ [ 0.41240000, 0.35760000, 0.18050000 ]--- , [ 0.21260000, 0.71520000, 0.07220000 ]--- , [ 0.01930000, 0.11920000, 0.95050000 ] ]------ @since 0.1.0-npmStandard :: RealFloat a => NPM SRGB a-npmStandard = NPM $ M3x3 (V3 0.4124 0.3576 0.1805)-                         (V3 0.2126 0.7152 0.0722)-                         (V3 0.0193 0.1192 0.9505)----- | sRGB inverse normalized primary matrix. This is a helper definition, use `inpm` instead.------ >>> :set -XDataKinds--- >>> import Graphics.Color.Space.RGB--- >>> inpmStandard :: INPM SRGB Float--- [ [ 3.24060000,-1.53720000,-0.49860000 ]--- , [-0.96890000, 1.87580000, 0.04150000 ]--- , [ 0.05570000,-0.20400000, 1.05700000 ] ]------ @since 0.1.0-inpmStandard :: RealFloat a => INPM SRGB a-inpmStandard = INPM $ M3x3 (V3  3.2406 -1.5372 -0.4986)-                           (V3 -0.9689  1.8758  0.0415)-                           (V3  0.0557 -0.2040  1.0570)----- | sRGB transfer function "gamma". This is a helper function, therefore `ecctf` should be used--- instead.------ \[--- \gamma(u) = \begin{cases}---     12.92 u & u \leq 0.0031308 \\---     1.055 u^{1/2.4} - 0.055 & \text{otherwise}---   \end{cases}--- \]------ @since 0.1.0-transfer :: (Ord a, Floating a) => a -> a-transfer u-  | u <= 0.0031308 = 12.92 * u-  | otherwise = 1.055 * (u ** (1 / 2.4)) - 0.055-{-# INLINE transfer #-}---- | sRGB inverse transfer function "gamma". This is a helper function, therefore `dcctf` should--- be used instead.------ \[--- \gamma^{-1}(u) = \begin{cases}---     u / 12.92 & u \leq 0.04045 \\---     \left(\tfrac{u + 0.055}{1.055}\right)^{2.4} & \text{otherwise}---   \end{cases}--- \]------ @since 0.1.0-itransfer :: (Ord a, Floating a) => a -> a-itransfer u-  | u <= 0.04045 = u / 12.92-  | otherwise = ((u + 0.055) / 1.055) ** 2.4-{-# INLINE itransfer #-}

@@ -1,10 +1,7 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NegativeLiterals #-}-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-}@@ -237,9 +234,8 @@  import Data.Typeable import Graphics.Color.Space-import Graphics.Color.Space.CIE1976.LAB import Graphics.Color.Adaptation.VonKries-import Graphics.Color.Space.RGB.SRGB+import Graphics.Color.Algebra (showsType)  -- -- TODO: Find a home somewhere for this common illuminant -- data D50

@@ -11,8 +11,8 @@ -- Portability : non-portable -- module Graphics.Pixel-  ( Pixel(Pixel, PixelY, PixelRGB, PixelHSI, PixelHSL, PixelHSV,-      PixelCMYK, PixelYCbCr, PixelYA, PixelRGBA, PixelHSIA, PixelHSLA,+  ( Pixel(Pixel, PixelX, PixelRGB, PixelHSI, PixelHSL, PixelHSV,+      PixelCMYK, PixelYCbCr, PixelXA, PixelRGBA, PixelHSIA, PixelHSLA,       PixelHSVA, PixelCMYKA, PixelYCbCrA)   , liftPixel   , pixelColor@@ -34,9 +34,9 @@ -- | Constructor for a grayscale pixel with single channel. -- -- @since 0.1.0-pattern PixelY :: e -> Pixel Y e-pattern PixelY y = Pixel (ColorY y)-{-# COMPLETE PixelY #-}+pattern PixelX :: e -> Pixel X e+pattern PixelX y = Pixel (ColorX y)+{-# COMPLETE PixelX #-}  -- | Constructor for a pixel with @RGB@ color model. --@@ -84,9 +84,9 @@ -- | Constructor for a grayscale pixel with a transparency channel. -- -- @since 0.1.0-pattern PixelYA :: e -> e -> Pixel (Alpha Y) e-pattern PixelYA y a = Pixel (Alpha (ColorY y) a)-{-# COMPLETE PixelYA #-}+pattern PixelXA :: e -> e -> Pixel (Alpha X) e+pattern PixelXA y a = Pixel (Alpha (ColorX y) a)+{-# COMPLETE PixelXA #-}  -- | Constructor for a pixel with @RGB@ color model and Alpha channel. --

@@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-}@@ -16,9 +15,9 @@ -- Portability : non-portable -- module Graphics.Pixel.ColorSpace-  ( Pixel(Pixel, PixelY, PixelXYZ, PixelRGB, PixelHSI, PixelHSL, PixelHSV,-      PixelCMYK, PixelYCbCr, PixelY', PixelYA, PixelXYZA, PixelRGBA, PixelHSIA, PixelHSLA,-      PixelHSVA, PixelCMYKA, PixelYCbCrA, PixelY'A)+  ( Pixel(Pixel, PixelY, PixelXYZ, PixelLAB, PixelRGB, PixelHSI, PixelHSL, PixelHSV,+      PixelCMYK, PixelY'CbCr, PixelY', PixelYA, PixelXYZA, PixelLABA, PixelRGBA, PixelHSIA, PixelHSLA,+      PixelHSVA, PixelCMYKA, PixelY'CbCrA, PixelY'A)   , liftPixel   , pixelColor   -- * Conversion@@ -45,29 +44,18 @@   -- ** sRGB color space   , pattern PixelSRGB   , pattern PixelSRGBA-  , SRGB-  , D65-  -- ** Adobe RGB color space-  , AdobeRGB   -- ** Luma   , rgbPixelLuma   -- * Re-export of color space   , module Graphics.Color.Space-  , module Graphics.Color.Space.RGB.Luma-  , module Graphics.Color.Space.RGB.Alternative   , module Graphics.Color.Algebra.Binary   ) where  import Data.Coerce import Graphics.Color.Adaptation.VonKries-import Graphics.Color.Model.Internal import Graphics.Color.Algebra.Binary import qualified Graphics.Color.Model.RGB as CM import Graphics.Color.Space-import Graphics.Color.Space.RGB.AdobeRGB-import Graphics.Color.Space.RGB.Alternative-import Graphics.Color.Space.RGB.SRGB-import Graphics.Color.Space.RGB.Luma import Graphics.Pixel.Internal  -- | Convert a pixel from one color space to any other.@@ -123,6 +111,7 @@ pattern PixelXYZ x y z = Pixel (XYZ (V3 x y z)) {-# COMPLETE PixelXYZ #-} + -- | Constructor for a pixel in @CIE1931 XYZ@ color space with Alpha channel -- -- @since 0.1.0@@ -131,6 +120,20 @@ {-# COMPLETE PixelXYZA #-}  +-- | Constructor for a pixel in @CIE1976 LAB@ color space+--+-- @since 0.3.0+pattern PixelLAB :: e -> e -> e -> Pixel (LAB i) e+pattern PixelLAB l' a' b' = Pixel (LAB (V3 l' a' b'))+{-# COMPLETE PixelLAB #-}++-- | Constructor for a pixel in @CIE1976 LAB@ color space with Alpha channel+--+-- @since 0.3.0+pattern PixelLABA :: e -> e -> e -> e -> Pixel (Alpha (LAB i)) e+pattern PixelLABA l' a' b' a = Pixel (Alpha (LAB (V3 l' a' b')) a)+{-# COMPLETE PixelLABA #-}+ -- | Constructor for a pixel in RGB color space. -- -- @since 0.1.0@@ -170,24 +173,24 @@ {-# COMPLETE PixelCMYK #-}  --- | Constructor for a pixel in @YCbCr@.+-- | Constructor for a pixel in @Y'CbCr@. -- -- @since 0.1.0-pattern PixelYCbCr :: e -> e -> e -> Pixel (YCbCr cs) e-pattern PixelYCbCr y cb cr = Pixel (ColorYCbCr y cb cr)-{-# COMPLETE PixelYCbCr #-}+pattern PixelY'CbCr :: e -> e -> e -> Pixel (Y'CbCr cs) e+pattern PixelY'CbCr y cb cr = Pixel (ColorY'CbCr y cb cr)+{-# COMPLETE PixelY'CbCr #-}  -- | Constructor for a pixel with Luma (not to be confused with luminance `Y`) -- -- @since 0.1.4-pattern PixelY' :: e -> Pixel Y' e+pattern PixelY' :: e -> Pixel (Y' cs) e pattern PixelY' y = Pixel (Y' y) {-# COMPLETE PixelY' #-}  -- | Constructor for a pixel with Luma and Alpha channel (not to be confused with luminance `Y`) -- -- @since 0.1.4-pattern PixelY'A :: e -> e -> Pixel (Alpha Y') e+pattern PixelY'A :: e -> e -> Pixel (Alpha (Y' cs)) e pattern PixelY'A y a = Pixel (Alpha (Y' y) a) {-# COMPLETE PixelY'A #-} @@ -232,18 +235,18 @@ {-# COMPLETE PixelCMYKA #-}  --- | Constructor for a pixel in @YCbCr@ with alpha channel.+-- | Constructor for a pixel in @Y'CbCr@ with alpha channel. -- -- @since 0.1.0-pattern PixelYCbCrA :: e -> e -> e -> e -> Pixel (Alpha (YCbCr cs)) e-pattern PixelYCbCrA y cb cr a = Pixel (ColorYCbCrA y cb cr a)-{-# COMPLETE PixelYCbCrA #-}+pattern PixelY'CbCrA :: e -> e -> e -> e -> Pixel (Alpha (Y'CbCr cs)) e+pattern PixelY'CbCrA y cb cr a = Pixel (ColorY'CbCrA y cb cr a)+{-# COMPLETE PixelY'CbCrA #-}  -- | Convert non-linear RGB color space into linear one -- -- @since 0.2.0 toPixelLinearRGB ::-     (RedGreenBlue cs i, Elevator e, RealFloat e) => Pixel (cs 'NonLinear) e -> Pixel (cs 'Linear) e+     (RedGreenBlue cs i, RealFloat e) => Pixel (cs 'NonLinear) e -> Pixel (cs 'Linear) e toPixelLinearRGB = liftPixel dcctf {-# INLINE toPixelLinearRGB #-} @@ -251,7 +254,7 @@ -- -- @since 0.2.0 fromPixelLinearRGB ::-     (RedGreenBlue cs i, Elevator e, RealFloat e) => Pixel (cs 'Linear) e -> Pixel (cs 'NonLinear) e+     (RedGreenBlue cs i, RealFloat e) => Pixel (cs 'Linear) e -> Pixel (cs 'NonLinear) e fromPixelLinearRGB = liftPixel ecctf {-# INLINE fromPixelLinearRGB #-} @@ -261,7 +264,7 @@ rgbPixelLuma ::      forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e)   => Pixel (cs 'NonLinear) e'-  -> Pixel Y' e+  -> Pixel (Y' cs) e rgbPixelLuma = liftPixel rgbLuma  -- | Compute luminance of a pixel color

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -6,6 +5,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_HADDOCK hide, not-home #-} -- | -- Module      : Graphics.Pixel.Internal -- Copyright   : (c) Alexey Kuleshevich 2019-2020@@ -23,12 +23,14 @@   , toPixel64   , toPixelF   , toPixelD+  , VU.MVector(MV_Pixel)+  , VU.Vector(V_Pixel)+  , module Graphics.Color.Model.Internal   ) where  import Data.Coerce import Control.DeepSeq (NFData) import Graphics.Color.Model.Internal-import Control.Monad (liftM) import Foreign.Storable import qualified Data.Vector.Generic as V import qualified Data.Vector.Generic.Mutable as VM@@ -74,12 +76,12 @@   {-# INLINE basicUnsafeSlice #-}   basicOverlaps (MV_Pixel mvec) (MV_Pixel mvec') = VM.basicOverlaps mvec mvec'   {-# INLINE basicOverlaps #-}-  basicUnsafeNew len = MV_Pixel `liftM` VM.basicUnsafeNew len+  basicUnsafeNew len = MV_Pixel <$> VM.basicUnsafeNew len   {-# INLINE basicUnsafeNew #-}   basicUnsafeReplicate len val =-    MV_Pixel `liftM` VM.basicUnsafeReplicate len (toComponents (coerce val))+    MV_Pixel <$> VM.basicUnsafeReplicate len (toComponents (coerce val))   {-# INLINE basicUnsafeReplicate #-}-  basicUnsafeRead (MV_Pixel mvec) idx = (coerce . fromComponents) `liftM` VM.basicUnsafeRead mvec idx+  basicUnsafeRead (MV_Pixel mvec) idx = coerce . fromComponents <$> VM.basicUnsafeRead mvec idx   {-# INLINE basicUnsafeRead #-}   basicUnsafeWrite (MV_Pixel mvec) idx val = VM.basicUnsafeWrite mvec idx (toComponents (coerce val))   {-# INLINE basicUnsafeWrite #-}@@ -91,26 +93,24 @@   {-# INLINE basicUnsafeCopy #-}   basicUnsafeMove (MV_Pixel mvec) (MV_Pixel mvec') = VM.basicUnsafeMove mvec mvec'   {-# INLINE basicUnsafeMove #-}-  basicUnsafeGrow (MV_Pixel mvec) len = MV_Pixel `liftM` VM.basicUnsafeGrow mvec len+  basicUnsafeGrow (MV_Pixel mvec) len = MV_Pixel <$> VM.basicUnsafeGrow mvec len   {-# INLINE basicUnsafeGrow #-}-#if MIN_VERSION_vector(0,11,0)   basicInitialize (MV_Pixel mvec) = VM.basicInitialize mvec   {-# INLINE basicInitialize #-}-#endif   newtype instance VU.Vector (Pixel cs e) = V_Pixel (VU.Vector (Components cs e))  instance (ColorModel cs e) => V.Vector VU.Vector (Pixel cs e) where-  basicUnsafeFreeze (MV_Pixel mvec) = V_Pixel `liftM` V.basicUnsafeFreeze mvec+  basicUnsafeFreeze (MV_Pixel mvec) = V_Pixel <$> V.basicUnsafeFreeze mvec   {-# INLINE basicUnsafeFreeze #-}-  basicUnsafeThaw (V_Pixel vec) = MV_Pixel `liftM` V.basicUnsafeThaw vec+  basicUnsafeThaw (V_Pixel vec) = MV_Pixel <$> V.basicUnsafeThaw vec   {-# INLINE basicUnsafeThaw #-}   basicLength (V_Pixel vec) = V.basicLength vec   {-# INLINE basicLength #-}   basicUnsafeSlice idx len (V_Pixel vec) = V_Pixel (V.basicUnsafeSlice idx len vec)   {-# INLINE basicUnsafeSlice #-}-  basicUnsafeIndexM (V_Pixel vec) idx = (coerce . fromComponents) `liftM` V.basicUnsafeIndexM vec idx+  basicUnsafeIndexM (V_Pixel vec) idx = coerce . fromComponents <$> V.basicUnsafeIndexM vec idx   {-# INLINE basicUnsafeIndexM #-}   basicUnsafeCopy (MV_Pixel mvec) (V_Pixel vec) = V.basicUnsafeCopy mvec vec   {-# INLINE basicUnsafeCopy #-}

@@ -8,6 +8,7 @@ import Graphics.Color.Space.Common import Graphics.Color.Illuminant.Common import Graphics.Color.Illuminant.CIE1931+import Graphics.Color.Algebra  spec :: Spec spec =

@@ -10,6 +10,8 @@ import Data.Proxy import Graphics.Color.Space import Graphics.Color.Model.Common+import GHC.TypeLits+import Graphics.Color.Algebra (showsType)   colorTemperatureExpectation ::

@@ -5,12 +5,13 @@ {-# LANGUAGE TypeApplications #-} module Graphics.Color.Illuminant.WikipediaSpec (spec) where +import qualified Data.Colour.CIE as Colour+import qualified Data.Colour.CIE.Illuminant as Colour import Data.Proxy-import Graphics.Color.Space.Common+import Graphics.Color.Algebra (showsType) import Graphics.Color.Illuminant.Common import Graphics.Color.Illuminant.Wikipedia-import qualified Data.Colour.CIE as Colour-import qualified Data.Colour.CIE.Illuminant as Colour+import Graphics.Color.Space.Common  shouldMatch ::      forall i. Illuminant i

@@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}

@@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -11,10 +10,9 @@ import qualified Data.Colour.SRGB as Colour import Graphics.Color.Illuminant.CIE1931 as I2 import qualified Graphics.Color.Illuminant.Wikipedia as W-import Graphics.Color.Space.CIE1976.LAB import Graphics.Color.Space.Common import Graphics.Color.Space.RGB.Derived.SRGBSpec ()-import Graphics.Color.Space.RGB.Derived.SRGB+import Graphics.Color.Space.RGB.Derived.SRGB as D  instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (LAB (i :: k)) e) where   arbitrary = ColorLAB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator@@ -28,9 +26,9 @@     prop "lab2srgb" $ \lab@(ColorLAB l' a' b' :: Color (LAB 'W.D65) Double) ->       case Colour.toSRGB (Colour.cieLAB Colour.d65 l' a' b') of         Colour.RGB r g b ->-          (convertColor lab :: Color (SRGB 'W.D65 'NonLinear) Double)+          (convertColor lab :: Color (D.SRGB 'W.D65 'NonLinear) Double)           `epsilonEqColorDouble` ColorRGB r g b-    prop "srgb2xlab" $ \rgb@(ColorRGB r g b :: Color (SRGB 'W.D65 'NonLinear) Double) ->+    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)

@@ -4,7 +4,6 @@ module Graphics.Color.Space.RGB.AdobeRGBSpec (spec, arbitraryElevator) where  import Graphics.Color.Space.Common-import Graphics.Color.Space.RGB.AdobeRGB  instance (Elevator e, Random e) => Arbitrary (Color (AdobeRGB l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator

@@ -5,9 +5,7 @@ module Graphics.Color.Space.RGB.Alternative.CMYKSpec (spec) where  import Graphics.Color.Space.Common-import Graphics.Color.Space.RGB.SRGB import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived-import Graphics.Color.Space.RGB.Alternative.CMYK import Graphics.Color.Space.RGB.Derived.SRGBSpec ()  

@@ -4,9 +4,7 @@ module Graphics.Color.Space.RGB.Alternative.HSISpec (spec) where  import Graphics.Color.Space.Common-import Graphics.Color.Space.RGB.SRGB-import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived-import Graphics.Color.Space.RGB.Alternative.HSI+import qualified Graphics.Color.Space.RGB.Derived.SRGB as D import Graphics.Color.Space.RGB.SRGBSpec () import Graphics.Color.Space.RGB.Derived.SRGBSpec () @@ -18,5 +16,5 @@ spec =   describe "HSI" $ do     describe "Derived-sRGB" $ do-      colorModelSpec @(HSI (Derived.SRGB D65 'NonLinear)) @Word "HSI"-      colorSpaceSpec @(HSI (Derived.SRGB D65 'NonLinear)) @Double+      colorModelSpec @(HSI (D.SRGB D65 'NonLinear)) @Word "HSI"+      colorSpaceSpec @(HSI (D.SRGB D65 'NonLinear)) @Double

@@ -4,9 +4,7 @@ module Graphics.Color.Space.RGB.Alternative.HSLSpec (spec) where  import Graphics.Color.Space.Common-import Graphics.Color.Space.RGB.SRGB-import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived-import Graphics.Color.Space.RGB.Alternative.HSL+import qualified Graphics.Color.Space.RGB.Derived.SRGB as D import Graphics.Color.Space.RGB.SRGBSpec () import Graphics.Color.Space.RGB.Derived.SRGBSpec () @@ -18,5 +16,5 @@ spec =   describe "HSL" $ do     describe "Derived-sRGB" $ do-      colorModelSpec @(HSL (Derived.SRGB D65 'NonLinear)) @Word "HSL"-      colorSpaceSpec @(HSL (Derived.SRGB D65 'NonLinear)) @Double+      colorModelSpec @(HSL (D.SRGB D65 'NonLinear)) @Word "HSL"+      colorSpaceSpec @(HSL (D.SRGB D65 'NonLinear)) @Double

@@ -4,9 +4,7 @@ module Graphics.Color.Space.RGB.Alternative.HSVSpec (spec) where  import Graphics.Color.Space.Common-import Graphics.Color.Space.RGB.SRGB-import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived-import Graphics.Color.Space.RGB.Alternative.HSV+import qualified Graphics.Color.Space.RGB.Derived.SRGB as D import Graphics.Color.Space.RGB.SRGBSpec () import Graphics.Color.Space.RGB.Derived.SRGBSpec () @@ -18,7 +16,7 @@ spec =   describe "HSV" $ do     describe "Derived-sRGB" $ do-      colorModelSpec @(HSV (Derived.SRGB D65 'NonLinear)) @Word "HSV"-      colorSpaceSpec @(HSV (Derived.SRGB D65 'NonLinear)) @Double-      colorModelSpec @(HSV (Derived.SRGB D65 'Linear)) @Int "HSV"-      colorSpaceSpec @(HSV (Derived.SRGB D65 'Linear)) @Float+      colorModelSpec @(HSV (D.SRGB D65 'NonLinear)) @Word "HSV"+      colorSpaceSpec @(HSV (D.SRGB D65 'NonLinear)) @Double+      colorModelSpec @(HSV (D.SRGB D65 'Linear)) @Int "HSV"+      colorSpaceSpec @(HSV (D.SRGB D65 'Linear)) @Float

@@ -7,43 +7,41 @@  import qualified Codec.Picture.Types as JuicyPixels import Graphics.Color.Space.Common-import Graphics.Color.Space.RGB.SRGB import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived-import Graphics.Color.Space.RGB.Alternative.YCbCr import Graphics.Color.Space.RGB.SRGBSpec () import Graphics.Color.Space.RGB.Derived.SRGBSpec ()  -instance (Elevator e, Random e) => Arbitrary (Color (YCbCr cs) e) where+instance (Elevator e, Random e) => Arbitrary (Color (Y'CbCr cs) e) where   arbitrary =-    ColorYCbCr <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator+    ColorY'CbCr <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator  -- Accurate roundtrip to/from both XYZ and SRGB is not possible due to the nature of the -- algorithm. spec :: Spec spec =-  describe "YCbCr" $ do+  describe "Y'CbCr" $ do     describe "sRGB" $ do-      colorModelSpec @(YCbCr (SRGB 'NonLinear)) @Word "YCbCr"-      colorSpaceCommonSpec @(YCbCr (SRGB 'NonLinear)) @Double $ pure ()+      colorModelSpec @(Y'CbCr SRGB) @Word "Y'CbCr"+      colorSpaceCommonSpec @(Y'CbCr SRGB) @Double $ pure ()     describe "Derived-sRGB" $ do-      colorModelSpec @(YCbCr (Derived.SRGB D65 'NonLinear)) @Word "YCbCr"-      colorSpaceCommonSpec @(YCbCr (Derived.SRGB D65 'NonLinear)) @Double $ pure ()-    prop "toColorYCbCr . toColorYCbCr" $ \(rgb :: Color (Derived.SRGB D65 'NonLinear) Double) ->+      colorModelSpec @(Y'CbCr (Derived.SRGB D65)) @Word "Y'CbCr"+      colorSpaceCommonSpec @(Y'CbCr (Derived.SRGB D65)) @Double $ pure ()+    prop "toColorY'CbCr . toColorY'CbCr" $ \(rgb :: Color (Derived.SRGB D65 'NonLinear) Double) ->       rgb `epsilonEqColor`-      fromColorYCbCr (toColorYCbCr rgb :: Color (YCbCr (Derived.SRGB D65 'NonLinear)) Double)-    prop "toColorYCbCr == srgb2ycbcr" $ \(rgb :: Color (SRGB 'NonLinear) Double) ->+      fromColorY'CbCr (toColorY'CbCr rgb :: Color (Y'CbCr (Derived.SRGB D65)) Double)+    prop "toColorY'CbCr == srgb2ycbcr" $ \(rgb :: Color (SRGB 'NonLinear) Double) ->       srgb2ycbcr rgb `epsilonEqColor`-      (toColorYCbCr rgb :: Color (YCbCr (SRGB 'NonLinear)) Double)-    prop "fromColorYCbCr == ycbcr2srgb" $ \(ycbcr :: Color (YCbCr (SRGB 'NonLinear)) Double) ->-      ycbcr2srgb ycbcr `epsilonEqColor` (fromColorYCbCr ycbcr :: Color (SRGB 'NonLinear) Double)+      (toColorY'CbCr rgb :: Color (Y'CbCr SRGB) Double)+    prop "fromColorY'CbCr == ycbcr2srgb" $ \(ycbcr :: Color (Y'CbCr SRGB) Double) ->+      ycbcr2srgb ycbcr `epsilonEqColor` (fromColorY'CbCr ycbcr :: Color (SRGB 'NonLinear) Double)     describe "Match JuicyPixels" $ do       prop "rgb2ycbcr" $ \(rgb@(ColorRGB r g b) :: Color (SRGB 'NonLinear) Word8) ->         case JuicyPixels.convertPixel (JuicyPixels.PixelRGB8 r g b) of           JuicyPixels.PixelYCbCr8 y cb cr ->-            (fromBaseSpace rgb :: Color (YCbCr (SRGB 'NonLinear)) Word8)-            `approxIntegralColorExpect1` ColorYCbCr y cb cr-      prop "ycbcr2rgb" $ \(ycbcr@(ColorYCbCr y cb cr) :: Color (YCbCr (SRGB 'NonLinear)) Word8) ->+            (fromBaseSpace rgb :: Color (Y'CbCr SRGB) Word8)+            `approxIntegralColorExpect1` ColorY'CbCr y cb cr+      prop "ycbcr2rgb" $ \(ycbcr@(ColorY'CbCr y cb cr) :: Color (Y'CbCr SRGB) Word8) ->         case JuicyPixels.convertPixel (JuicyPixels.PixelYCbCr8 y cb cr) of           JuicyPixels.PixelRGB8 r g b ->-            (toBaseSpace ycbcr) `approxIntegralColorExpect1` ColorRGB r g b+            toBaseSpace ycbcr `approxIntegralColorExpect1` ColorRGB r g b

@@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -8,15 +7,15 @@  import Graphics.Color.Illuminant.CIE1931 import Graphics.Color.Space.Common-import Graphics.Color.Space.RGB.Derived.AdobeRGB+import qualified Graphics.Color.Space.RGB.Derived.AdobeRGB as D -instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (AdobeRGB (i :: k) l) e) where+instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (D.AdobeRGB (i :: k) l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator   spec :: Spec spec = describe "AdobeRGB" $ do-  colorModelSpec @(AdobeRGB 'D65 'NonLinear) @Word "AdobeRGB CIE1931 'D65 'NonLinear"-  colorSpaceSpec @(AdobeRGB 'D65 'NonLinear) @Float-  colorModelSpec @(AdobeRGB 'D50 'Linear) @Int "AdobeRGB CIE1931 'D50 'Linear"-  colorSpaceSpec @(AdobeRGB 'D50 'Linear) @Double+  colorModelSpec @(D.AdobeRGB 'D65 'NonLinear) @Word "AdobeRGB CIE1931 'D65 'NonLinear"+  colorSpaceSpec @(D.AdobeRGB 'D65 'NonLinear) @Float+  colorModelSpec @(D.AdobeRGB 'D50 'Linear) @Int "AdobeRGB CIE1931 'D50 'Linear"+  colorSpaceSpec @(D.AdobeRGB 'D50 'Linear) @Double

@@ -1,21 +1,20 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Graphics.Color.Space.RGB.Derived.CIERGBSpec (spec) where  import Graphics.Color.Illuminant.CIE1931-import Graphics.Color.Space.RGB.Derived.CIERGB+import qualified Graphics.Color.Space.RGB.Derived.CIERGB as D import Graphics.Color.Space.Common -instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (CIERGB (i :: k) l) e) where+instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (D.CIERGB (i :: k) l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator  spec :: Spec spec = describe "RGB" $ do-  colorModelSpec @(CIERGB 'E 'NonLinear) @Word "CIERGB CIE1931 'E 'NonLinear"-  colorSpaceSpec @(CIERGB 'E 'NonLinear) @Float-  colorModelSpec @(CIERGB 'D75 'Linear) @Int "CIERGB CIE1931 'D75 'Linear"-  colorSpaceSpec @(CIERGB 'D75 'Linear) @Double+  colorModelSpec @(D.CIERGB 'E 'NonLinear) @Word "CIERGB CIE1931 'E 'NonLinear"+  colorSpaceSpec @(D.CIERGB 'E 'NonLinear) @Float+  colorModelSpec @(D.CIERGB 'D75 'Linear) @Int "CIERGB CIE1931 'D75 'Linear"+  colorSpaceSpec @(D.CIERGB 'D75 'Linear) @Double

@@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -12,35 +11,35 @@ import Graphics.Color.Illuminant.CIE1931 import qualified Graphics.Color.Illuminant.Wikipedia as W import Graphics.Color.Space.Common-import Graphics.Color.Space.RGB.Derived.SRGB+import Graphics.Color.Space.RGB.Derived.SRGB as D -instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (SRGB (i :: k) l) e) where+instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (D.SRGB (i :: k) l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator   spec :: Spec spec = describe "SRGB" $ do-  colorModelSpec @(SRGB 'D65 'NonLinear) @Word "SRGB CIE1931 'D65 'NonLinear"-  colorSpaceSpec @(SRGB 'D65 'NonLinear) @Float-  colorModelSpec @(SRGB 'D55 'Linear) @Int "SRGB CIE1931 'D55 'Linear"-  colorSpaceSpec @(SRGB 'D55 'Linear) @Double+  colorModelSpec @(D.SRGB 'D65 'NonLinear) @Word "SRGB CIE1931 'D65 'NonLinear"+  colorSpaceSpec @(D.SRGB 'D65 'NonLinear) @Float+  colorModelSpec @(D.SRGB 'D55 'Linear) @Int "SRGB CIE1931 'D55 'Linear"+  colorSpaceSpec @(D.SRGB 'D55 'Linear) @Double   describe "Same as colour package" $ do     prop "xyz2srgb" $ \xyz@(ColorXYZ x y z :: Color (XYZ 'W.D65) Double) ->       case Colour.toSRGB (Colour.cieXYZ x y z) of         Colour.RGB r g b ->-          (fromColorXYZ xyz :: Color (SRGB 'W.D65 'NonLinear) Double)+          (fromColorXYZ xyz :: Color (D.SRGB 'W.D65 'NonLinear) Double)           `epsilonEqColorDouble`           ColorRGB r g b     prop "xyz2linearsrgb" $ \xyz@(ColorXYZ x y z :: Color (XYZ 'W.D65 ) Double) ->       case Colour.toRGB (Colour.cieXYZ x y z) of         Colour.RGB r g b ->-          dcctf (fromColorXYZ xyz :: Color (SRGB 'W.D65 'NonLinear) Double) `epsilonEqColorDouble`+          dcctf (fromColorXYZ xyz :: Color (D.SRGB 'W.D65 'NonLinear) Double) `epsilonEqColorDouble`           ColorRGB r g b-    prop "srgb2xyz" $ \rgb@(ColorRGB r g b :: Color (SRGB 'W.D65 'NonLinear) Double) ->+    prop "srgb2xyz" $ \rgb@(ColorRGB r g b :: Color (D.SRGB 'W.D65 'NonLinear) Double) ->       case Colour.cieXYZView (Colour.sRGB r g b) of         (x, y, z) ->           toColorXYZ rgb `epsilonEqColorDouble` ColorXYZ x y z-    prop "linersrgb2xyz" $ \rgb@(ColorRGB r g b :: Color (SRGB 'W.D65 'Linear) Double) ->+    prop "linersrgb2xyz" $ \rgb@(ColorRGB r g b :: Color (D.SRGB 'W.D65 'Linear) Double) ->       case Colour.cieXYZView (Colour.rgb r g b) of         (x, y, z) ->           toColorXYZ (ecctf rgb) `epsilonEqColorDouble` ColorXYZ x y z

@@ -4,7 +4,6 @@ module Graphics.Color.Space.RGB.SRGBSpec (spec, arbitraryElevator) where  import Graphics.Color.Space.Common-import Graphics.Color.Space.RGB.SRGB  instance (Elevator e, Random e) => Arbitrary (Color (SRGB l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator

@@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -18,9 +17,7 @@ import GHC.TypeLits import Graphics.Color.Model.Common hiding ((.&.)) import Graphics.Color.Space-import Graphics.Color.Space.RGB import Graphics.Color.Standard.RAL as RAL-import Graphics.Color.Space.CIE1976.LAB import Data.Bits  @@ -48,7 +45,7 @@           let mkTest expected (rname, received) =                 it rname $ do                   when (rname `elem` pendingNames) $ pendingWith "Some discrepancy"-                  (expect received expected)+                  expect received expected           zipWithM_ mkTest expectedColors receivedColors     it "Color ShowS" $ do       show (RAL :: RAL "GreenBeige") `shouldBe` "RAL \"GreenBeige\""