blob: 0152960d9add955d959d7c9270d1a79e20e96245 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
module Main where
import qualified Data.ByteString.Lazy as BL
import PFM
import Test.Tasty
import Test.Tasty.QuickCheck ( (===) )
import qualified Test.Tasty.QuickCheck as QC
newtype TestPFMImage = TestPFMImage { getPFMImage :: PFMImage }
deriving (Show)
newtype TestPFMColour = TestPFMColour { getPFMColour :: PFMColour }
deriving (Show)
newtype TestPPMImage = TestPPMImage { getPPMImage :: PPMImage }
deriving (Show)
newtype TestPPMColour = TestPPMColour { getPPMColour :: PPMColour }
deriving (Show)
instance QC.Arbitrary TestPFMImage where
arbitrary = TestPFMImage <$> (PFMImage <$> QC.arbitrary <*> QC.arbitrary
<*> (QC.listOf1 . QC.listOf1) (getPFMColour <$> QC.arbitrary))
instance QC.Arbitrary TestPPMImage where
arbitrary = TestPPMImage <$> (PPMImage <$> QC.arbitrary <*> QC.arbitrary
<*> (QC.listOf1 . QC.listOf1) (getPPMColour <$> QC.arbitrary))
instance QC.Arbitrary TestPFMColour where
arbitrary = TestPFMColour <$> (PFMColour <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary)
instance QC.Arbitrary TestPPMColour where
arbitrary = TestPPMColour <$> (PPMColour <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary)
parserIdempotent' :: TestPFMImage -> QC.Property
parserIdempotent' (TestPFMImage v) = p i === (p . p) i
where
encStrict = BL.toStrict . encode
i = encStrict v
p = encStrict . parse
parserIdempotent :: TestTree
parserIdempotent = QC.testProperty "parser idempotent" parserIdempotent'
tests :: TestTree
tests = testGroup "Property" [parserIdempotent]
main :: IO ()
main = defaultMain tests
|
