Skip to content

Commit

Permalink
A few more tests for Elevator
Browse files Browse the repository at this point in the history
  • Loading branch information
@lehins
lehins committed Feb 5, 2020
1 parent 053b295 commit 12aa0b3
Show file tree
Hide file tree
Showing 7 changed files with 148 additions and 21 deletions.
1 change: 1 addition & 0 deletions Color/CHANGELOG.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@

* Fix `YCbCr` conversion to derived RGB color spaces
* Fix conversion of `toWord64 (1 :: Double)` and `toWord632 (1 :: Float)`.
* Addition of `xyzColorMatchingFunctions` and `spectralPowerDistributions`

## 0.1.1

Expand Down
4 changes: 2 additions & 2 deletions Color/Color.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@ copyright: 2019-2020 Alexey Kuleshevich
category: Graphics
extra-source-files: README.md
, CHANGELOG.md
extra-doc-files: files/*.png
extra-doc-files: files/*.svg
cabal-version: >=1.10
build-type: Custom
tested-with: GHC == 8.4.3
Expand All @@ -20,6 +20,7 @@ tested-with: GHC == 8.4.3
, GHC == 8.6.4
, GHC == 8.6.5
, GHC == 8.8.1
, GHC == 8.8.2

custom-setup
setup-depends:
Expand Down Expand Up @@ -69,7 +70,6 @@ library
-- , Graphics.Color.Space.RGB.AdobeWideGamut
-- , Graphics.Color.Space.RGB.ProPhoto
-- , Graphics.Color.Space.RGB.DCI_P3

-- , Graphics.Color.Space.LMS
, Graphics.Color.Standard.RAL
, Graphics.Pixel
Expand Down
1 change: 1 addition & 0 deletions Color/files/colorMatchingFunctions.svg
View file
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Binary file removed Color/files/spectralPowerDistributions.png
View file
Binary file not shown.
1 change: 1 addition & 0 deletions Color/files/spectralPowerDistributions.svg
View file
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
4 changes: 3 additions & 1 deletion Color/src/Graphics/Color/Illuminant/CIE1931.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -428,7 +428,7 @@ wavelengths = spectralPowerDistributions
--
-- All of the values were taken directly from: /CIE15: Technical Report: Colorimetry, 3rd edition/
--
-- ![spectralPowerDistributions](files/spectralPowerDistributions.png)
-- ![spectralPowerDistributions](files/spectralPowerDistributions.svg)
--
-- @since 0.1.2
spectralPowerDistributions :: [(Double, V3 Double)]
Expand Down Expand Up @@ -546,6 +546,8 @@ spectralPowerDistributions =
--
-- All of the values were taken directly from: /CIE15: Technical Report: Colorimetry, 3rd edition/
--
-- ![colorMatchingFunctions](files/colorMatchingFunctions.png)
--
-- @since 0.1.2
xyzColorMatchingFunctions :: [(Double, V3 Double, V2 Double)]
xyzColorMatchingFunctions =
Expand Down
158 changes: 140 additions & 18 deletions Color/tests/Graphics/Color/Algebra/ElevatorSpec.hs
View file
Original file line number Diff line number Diff line change
@@ -1,36 +1,63 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Graphics.Color.Algebra.ElevatorSpec (spec) where

import Data.Int
import Data.Proxy
import Graphics.Color.Algebra
import Graphics.Color.Model.Common

eprop :: (Testable prop, Elevator a, Random a) => String -> (a -> prop) -> Spec
eprop name = prop name . forAll arbitraryElevator

prop_NegativeBecomesPositive :: (Show a, Ord a, Num a) => (b -> a) -> Negative b -> Property
prop_NegativeBecomesPositive f (Negative val) = property $ f val `shouldSatisfy` (>= 0)

specNegativeBecomesPositive :: forall a . (Ord a, Elevator a, Arbitrary a) => Proxy a -> Spec
specNegativeBecomesPositive _ = do
prop "fromRealFloat :: Float" $ prop_NegativeBecomesPositive (fromRealFloat :: Float -> a)
prop "fromDouble" $ prop_NegativeBecomesPositive (fromDouble :: Double -> a)
prop "fromRealFloat :: Double" $ prop_NegativeBecomesPositive (fromRealFloat :: Double -> a)
prop "toFloat" $ prop_NegativeBecomesPositive (toFloat :: a -> Float)
prop "toDouble" $ prop_NegativeBecomesPositive (toDouble :: a -> Double)
prop "toRealFloat :: Float" $ prop_NegativeBecomesPositive (toRealFloat :: a -> Float)
prop "toRealFloat :: Double" $ prop_NegativeBecomesPositive (toRealFloat :: a -> Double)

prop_NegativeBecomesZero :: (Show a, Ord a, Num a) => (b -> a) -> Negative b -> Property
prop_NegativeBecomesZero f (Negative val) = property $ f val `shouldSatisfy` (== 0)

specNegativeBecomesZero :: forall a . (Ord a, Elevator a) => Proxy a -> Spec
specNegativeBecomesZero _ = do
prop "fromRealFloat :: Float" $ prop_NegativeBecomesZero (fromRealFloat :: Float -> a)
prop "fromDouble" $ prop_NegativeBecomesZero (fromDouble :: Double -> a)
prop "fromRealFloat :: Double" $ prop_NegativeBecomesZero (fromRealFloat :: Double -> a)

spec :: Spec
spec =
describe "Elevator" $ do
describe "Word8" $ do
eprop "toWord8 . toWord8" $ \(e :: Word8) -> e === toWord8 e
specNegativeBecomesZero (Proxy :: Proxy Word8)
eprop "toWord8" $ \(e :: Word8) -> e === toWord8 e
eprop "toWord8 . toWord16" $ \(e :: Word8) -> e === toWord8 (toWord16 e)
eprop "toWord8 . toWord32" $ \(e :: Word8) -> e === toWord8 (toWord32 e)
eprop "toWord8 . toWord64" $ \(e :: Word8) -> e === toWord8 (toWord64 e)
eprop "toWord8 . toFloat" $ \(e :: Word8) -> e === toWord8 (toFloat e)
eprop "toWord8 . toDouble" $ \(e :: Word8) -> e === toWord8 (toDouble e)
eprop "toWord8 . toFloat :: Float" $ \(e :: Word8) -> e === toWord8 (toFloat e :: Float)
eprop "toWord8 . toRealFloat :: Float" $ \(e :: Word8) ->
e === toWord8 (toRealFloat e :: Float)
eprop "toWord8 . toRealFloat :: Double" $ \(e :: Word8) ->
e === toWord8 (toRealFloat e :: Double)
eprop "fromRealFloat . toFloat :: Float" $ \(e :: Word8) -> e === fromRealFloat (toFloat e)
eprop "fromRealFloat . toRealFloat :: Float" $ \(e :: Word8) ->
e === fromRealFloat (toRealFloat e :: Float)
eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Word8) ->
e === fromRealFloat (toRealFloat e :: Double)
eprop "fromDouble . toDouble" $ \(e :: Word8) -> e === fromDouble (toDouble e)
eprop "fromRealFloat . toDouble" $ \(e :: Word8) -> e === fromRealFloat (toDouble e)
eprop "read . toShowS" $ \(e :: Word8) -> e === read (toShowS e "")
describe "Word16" $ do
eprop "toWord16 . toWord16" $ \(e :: Word16) -> e === toWord16 e
specNegativeBecomesZero (Proxy :: Proxy Word16)
eprop "toWord16" $ \(e :: Word16) -> e === toWord16 e
eprop "toWord16 . toWord32" $ \(e :: Word16) -> e === toWord16 (toWord32 e)
eprop "toWord16 . toWord64" $ \(e :: Word16) -> e === toWord16 (toWord64 e)
eprop "toWord16 . toFloat" $ \(e :: Word16) -> e === toWord16 (toFloat e)
Expand All @@ -39,14 +66,17 @@ spec =
e === toWord16 (toRealFloat e :: Float)
eprop "toWord16 . toRealFloat :: Double" $ \(e :: Word16) ->
e === toWord16 (toRealFloat e :: Double)
eprop "fromRealFloat . toFloat :: Float" $ \(e :: Word16) -> e === fromRealFloat (toFloat e)
eprop "fromRealFloat . toRealFloat :: Float" $ \(e :: Word16) ->
e === fromRealFloat (toRealFloat e :: Float)
eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Word16) ->
e === fromRealFloat (toRealFloat e :: Double)
eprop "fromDouble . toDouble" $ \(e :: Word16) -> e === fromDouble (toDouble e)
eprop "fromRealFloat . toDouble" $ \(e :: Word16) -> e === fromRealFloat (toDouble e)
eprop "read . toShowS" $ \(e :: Word16) -> e === read (toShowS e "")
describe "Word32" $ do
eprop "toWord32 . toWord32" $ \(e :: Word32) -> e === toWord32 e
specNegativeBecomesZero (Proxy :: Proxy Word32)
eprop "toWord32" $ \(e :: Word32) -> e === toWord32 e
eprop "toWord32 . toWord64" $ \(e :: Word32) -> e === toWord32 (toWord64 e)
prop "toWord32 . toFloat" $
forAll (choose (0, maxFloatI)) $ \(e :: Word32) -> e === toWord32 (toFloat e)
Expand All @@ -55,15 +85,19 @@ spec =
forAll (choose (0, maxFloatI)) $ \(e :: Word32) -> e === toWord32 (toRealFloat e :: Float)
eprop "toWord32 . toRealFloat :: Double" $ \(e :: Word32) ->
e === toWord32 (toRealFloat e :: Double)
prop "fromRealFloat . toFloat :: Float" $
forAll (choose (0, maxFloatI)) $ \(e :: Word32) -> e === fromRealFloat (toFloat e :: Float)
prop "fromRealFloat . toRealFloat :: Float" $
forAll (choose (0, maxFloatI)) $ \(e :: Word32) ->
e === fromRealFloat (toRealFloat e :: Float)
eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Word32) ->
e === fromRealFloat (toRealFloat e :: Double)
eprop "fromDouble . toDouble" $ \(e :: Word32) -> e === fromDouble (toDouble e)
eprop "fromRealFloat . toDouble" $ \(e :: Word32) -> e === fromRealFloat (toDouble e)
eprop "read . toShowS" $ \(e :: Word32) -> e === read (toShowS e "")
describe "Word64" $ do
eprop "toWord64 . toWord64" $ \(e :: Word64) -> e === toWord64 e
specNegativeBecomesZero (Proxy :: Proxy Word64)
eprop "toWord64" $ \(e :: Word64) -> e === toWord64 e
prop "toWord64 . toFloat" $
forAll (choose (0, maxFloatI)) $ \(e :: Word64) -> e === toWord64 (toFloat e)
prop "toWord64 . toDouble" $
Expand All @@ -83,33 +117,121 @@ spec =
prop "fromDouble . toDouble" $
forAll (choose (0, maxDoubleI)) $ \(e :: Word64) ->
shouldBeApproxIntegral 1 e (fromDouble (toDouble e))
prop "fromRealFloat . toDouble" $
forAll (choose (0, maxDoubleI)) $ \(e :: Word64) ->
shouldBeApproxIntegral 1 e (fromRealFloat (toDouble e))
eprop "read . toShowS" $ \(e :: Word64) -> e === read (toShowS e "")
describe "Word" $ do
specNegativeBecomesZero (Proxy :: Proxy Word)
eprop "toWord64" $ \(e :: Word) -> fromIntegral e === toWord64 e
prop "toWord64 . toFloat" $
forAll (choose (0, maxFloatI)) $ \(e :: Word) -> fromIntegral e === toWord64 (toFloat e)
prop "toWord64 . toDouble" $
forAll (choose (0, maxDoubleI)) $ \(e :: Word) ->
shouldBeApproxIntegral 1 (fromIntegral e) (toWord64 (toDouble e))
prop "toWord64 . toRealFloat :: Float" $
forAll (choose (0, maxFloatI)) $ \(e :: Word) ->
fromIntegral e === toWord64 (toRealFloat e :: Float)
prop "toWord64 . toRealFloat :: Double" $
forAll (choose (0, maxDoubleI)) $ \(e :: Word) ->
shouldBeApproxIntegral 1 (fromIntegral e) (toWord64 (toRealFloat e :: Double))
prop "fromRealFloat . toRealFloat :: Float" $
forAll (choose (0, maxFloatI)) $ \(e :: Word) ->
e === fromRealFloat (toRealFloat e :: Float)
prop "fromRealFloat . toRealFloat :: Double" $
forAll (choose (0, maxFloatI)) $ \(e :: Word) ->
e === fromRealFloat (toRealFloat e :: Double)
prop "fromDouble . toDouble" $
forAll (choose (0, maxDoubleI)) $ \(e :: Word) ->
shouldBeApproxIntegral 1 e (fromDouble (toDouble e))
prop "fromRealFloat . toDouble" $
forAll (choose (0, maxDoubleI)) $ \(e :: Word) ->
shouldBeApproxIntegral 1 e (fromRealFloat (toDouble e))
eprop "read . toShowS" $ \(e :: Word) -> e === read (toShowS e "")
describe "Float" $ do
-- eprop "toWord8 . toWord8" $ \(e :: Word8) -> e === toWord8 e
-- eprop "toWord8 . toWord16" $ \(e :: Word8) -> e === toWord8 (toWord16 e)
-- eprop "toWord8 . toWord32" $ \(e :: Word8) -> e === toWord8 (toWord32 e)
-- eprop "toWord8 . toWord64" $ \(e :: Word8) -> e === toWord8 (toWord64 e)
-- eprop "toWord8 . toDouble" $ \(e :: Word8) -> e === toWord8 (toDouble e)
-- eprop "toWord8 . toRealFloat :: Float" $ \(e :: Word8) ->
-- e === toWord8 (toRealFloat e :: Float)
-- eprop "toWord8 . toRealFloat :: Double" $ \(e :: Word8) ->
-- e === toWord8 (toRealFloat e :: Double)
eprop "fromRealFloat . toFloat" $ \(e :: Float) -> e === toRealFloat (toFloat e)
eprop "fromRealFloat . toDouble" $ \(e :: Float) -> e === toRealFloat (toDouble e)
eprop "fromRealFloat . toFloat" $ \(e :: Float) -> e === fromRealFloat (toFloat e)
eprop "fromRealFloat . toDouble" $ \(e :: Float) -> e === fromRealFloat (toDouble e)
eprop "fromRealFloat . toRealFloat :: Float" $ \(e :: Float) ->
e === fromRealFloat (toRealFloat e :: Float)
eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Float) ->
e === fromRealFloat (toRealFloat e :: Double)
eprop "fromDouble . toDouble" $ \(e :: Float) -> e === fromDouble (toDouble e)
eprop "fromRealFloat . toDouble" $ \(e :: Float) -> e === fromRealFloat (toDouble e)
--eprop "read . toShowS" $ \(e :: Float) -> e === read (toShowS e "")
it "toWord32 (maxBound edge case)" $ toWord32 (1 :: Float) `shouldBe` maxBound
describe "Double" $ do
eprop "fromRealFloat . toDouble" $ \(e :: Double) -> e === toRealFloat (toDouble e)
eprop "fromRealFloat . toDouble" $ \(e :: Double) -> e === fromRealFloat (toDouble e)
eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Double) ->
e === fromRealFloat (toRealFloat e :: Double)
eprop "fromDouble . toDouble" $ \(e :: Double) -> e === fromDouble (toDouble e)
it "fromDouble . toWord64" $ toWord64 (1 :: Double) `shouldBe` maxBound
eprop "fromRealFloat . toDouble" $ \(e :: Double) -> e === fromRealFloat (toDouble e)
it "toWord64 (maxBound edge case)" $ toWord64 (1 :: Double) `shouldBe` maxBound
let pos :: (Integral a, Num b) => a -> b
pos = fromIntegral . max 0
describe "Int8" $ do
specNegativeBecomesPositive (Proxy :: Proxy Int8)
eprop "toWord8" $ \(e :: Int8) -> pos e === toWord8 e
eprop "fromRealFloat . toFloat :: Float" $ \(e :: Int8) ->
(pos e :: Int8) === fromRealFloat (toFloat e :: Float)
eprop "fromRealFloat . toRealFloat :: Float" $ \(e :: Int8) ->
(pos e :: Int8) === fromRealFloat (toRealFloat e :: Float)
eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Int8) ->
(pos e :: Int8) === fromRealFloat (toRealFloat e :: Double)
eprop "fromDouble . toDouble" $ \(e :: Int8) -> (pos e :: Int8) === fromDouble (toDouble e)
eprop "fromRealFloat . toDouble" $ \(e :: Int8) ->
(pos e :: Int8) === fromRealFloat (toDouble e)
eprop "read . toShowS" $ \(e :: Int8) -> e === read (toShowS e "")
describe "Int16" $ do
specNegativeBecomesPositive (Proxy :: Proxy Int16)
eprop "toWord16" $ \(e :: Int16) -> pos e === toWord16 e
eprop "fromRealFloat . toFloat :: Float" $ \(e :: Int16) ->
(pos e :: Int16) === fromRealFloat (toFloat e :: Float)
eprop "fromRealFloat . toRealFloat :: Float" $ \(e :: Int16) ->
(pos e :: Int16) === fromRealFloat (toRealFloat e :: Float)
eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Int16) ->
(pos e :: Int16) === fromRealFloat (toRealFloat e :: Double)
eprop "fromDouble . toDouble" $ \(e :: Int16) -> (pos e :: Int16) === fromDouble (toDouble e)
eprop "fromRealFloat . toDouble" $ \(e :: Int16) ->
(pos e :: Int16) === fromRealFloat (toDouble e)
eprop "read . toShowS" $ \(e :: Int16) -> e === read (toShowS e "")
describe "Int32" $ do
specNegativeBecomesPositive (Proxy :: Proxy Int32)
eprop "toWord32" $ \(e :: Int32) -> pos e === toWord32 e
prop "fromRealFloat . toFloat :: Float" $
forAll (choose (0, maxFloatI)) $ \(e :: Int32) ->
(pos e :: Int32) === fromRealFloat (toFloat e)
prop "fromRealFloat . toRealFloat :: Float" $
forAll (choose (0, maxFloatI)) $ \(e :: Int32) ->
(pos e :: Int32) === fromRealFloat (toRealFloat e :: Float)
eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Int32) ->
(pos e :: Int32) === fromRealFloat (toRealFloat e :: Double)
eprop "fromDouble . toDouble" $ \(e :: Int32) -> (pos e :: Int32) === fromDouble (toDouble e)
eprop "read . toShowS" $ \(e :: Int32) -> e === read (toShowS e "")
describe "Int64" $ do
specNegativeBecomesPositive (Proxy :: Proxy Int64)
eprop "toWord64" $ \(e :: Int64) -> pos e === toWord64 e
prop "fromRealFloat . toRealFloat :: Float" $
forAll (choose (0, maxFloatI)) $ \(e :: Int64) ->
(pos e :: Int64) === fromRealFloat (toRealFloat e :: Float)
prop "fromRealFloat . toRealFloat :: Double" $
forAll (choose (0, maxDoubleI)) $ \(e :: Int64) ->
shouldBeApproxIntegral 1 (pos e :: Int64) (fromRealFloat (toRealFloat e :: Double))
prop "fromDouble . toDouble" $
forAll (choose (0, maxDoubleI)) $ \(e :: Int64) ->
shouldBeApproxIntegral 1 (pos e) (fromDouble (toDouble e) :: Int64)
eprop "read . toShowS" $ \(e :: Int64) -> e === read (toShowS e "")
describe "Int" $ do
specNegativeBecomesPositive (Proxy :: Proxy Int)
prop "fromRealFloat . toRealFloat :: Float" $
forAll (choose (0, maxFloatI)) $ \(e :: Int) ->
(pos e :: Int) === fromRealFloat (toRealFloat e :: Float)
prop "fromRealFloat . toRealFloat :: Double" $
forAll (choose (0, maxDoubleI)) $ \(e :: Int) ->
shouldBeApproxIntegral 1 (pos e :: Int) (fromRealFloat (toRealFloat e :: Double))
prop "fromDouble . toDouble" $
forAll (choose (0, maxDoubleI)) $ \(e :: Int) ->
shouldBeApproxIntegral 1 (pos e) (fromDouble (toDouble e) :: Int)
eprop "read . toShowS" $ \(e :: Int) -> e === read (toShowS e "")
where
maxFloatI, maxDoubleI :: Integral a => a
maxFloatI = 2 ^ (24 :: Int)
Expand Down

0 comments on commit 12aa0b3

Please sign in to comment.