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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
{- ORMOLU_DISABLE -}
-- Options passed to GHC
{-# OPTIONS_GHC -fno-warn-orphans #-}
--------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
-- CPP: GHC >= 7.8 for Safe Haskell
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE Safe #-}
#endif
{- ORMOLU_ENABLE -}
--------------------------------------------------------------------------------
-- | QuickCheck utilities for testing.
module QuickCheckUtil where
--------------------------------------------------------------------------------
-- CPP: GHC >= 8 for NonEmpty
#if __GLASGOW_HASKELL__ >= 800
import Control.Applicative (liftA2)
import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
import Data.Maybe (mapMaybe)
#endif
import Test.QuickCheck
--------------------------------------------------------------------------------
eqWith :: Eq b => (a -> b) -> (a -> b) -> a -> Bool
eqWith f g x = f x == g x
eqOn :: Eq b => (a -> Bool) -> (a -> b) -> (a -> b) -> a -> Property
eqOn c f g x = c x ==> f x == g x
--------------------------------------------------------------------------------
quickCheckLabeledProperties :: [(String, Property)] -> IO ()
quickCheckLabeledProperties = quickCheck . conjoin . map (uncurry label)
--------------------------------------------------------------------------------
-- CPP: GHC >= 8 for NonEmpty
#if __GLASGOW_HASKELL__ >= 800
{-
We include the instances for NonEmpty because QuickCheck (>= 2.10) does not. We
could alternatively depend on quickcheck-instances (>= 0.3.15), but
quickcheck-instances has sometimes lagged behind newer GHC/base versions. By
including the instances here, we do not need to track the quickcheck-instances
version, thus simplifying dlist.cabal and reducing the maintenance effort.
-}
instance Arbitrary1 NonEmpty where
liftArbitrary arb = liftA2 (:|) arb (liftArbitrary arb)
liftShrink shr (x :| xs) = mapMaybe nonEmpty . liftShrink shr $ x : xs
instance Arbitrary a => Arbitrary (NonEmpty a) where
{-# INLINABLE arbitrary #-}
arbitrary = arbitrary1
{-# INLINABLE shrink #-}
shrink = shrink1
#endif
|
