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
69
70
71
72
73
74
|
{-# LANGUAGE DerivingVia #-}
module Spec.Contravariant (testContravariant) where
import Hedgehog
import Hedgehog.Classes
--import Data.Functor.Contravariant -- lol
import Data.Functor.Const (Const(..))
import Data.Functor.Sum (Sum(..))
import Data.Functor.Product (Product(..))
import Data.Proxy (Proxy(..))
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
testContravariant :: [(String, [Laws])]
testContravariant =
[ ("Proxy", listProxy)
, ("Const", listConst)
, ("Sum", listSum)
, ("Product", listProduct)
-- , ("Bad Contravariant", listBadContravariant)
]
listProxy :: [Laws]
listProxy = [contravariantLaws genProxy]
listConst :: [Laws]
listConst = [contravariantLaws genConst]
listSum :: [Laws]
listSum = [contravariantLaws genSum]
listProduct :: [Laws]
listProduct = [contravariantLaws genProduct]
--listBadContravariant :: [Laws]
--listBadContravariant = [contravariantLaws genBadContravariant]
genProxy :: Gen a -> Gen (Proxy a)
genProxy = const (pure Proxy)
genConst :: Gen b -> Gen (Const Integer b)
genConst _ = fmap Const (Gen.integral (Range.linear 0 20))
genSum :: Gen a -> Gen (Sum (Const ()) (Const ()) a)
genSum _genA =
Gen.sized $ \n ->
Gen.frequency [
(2, pure $ InL (Const ()))
, (1 + fromIntegral n, pure $ InR (Const ()))
]
genProduct :: Gen a -> Gen (Product (Const ()) (Const ()) a)
genProduct _genA = do
pure (Pair (Const ()) (Const ()))
{-
newtype BadContravariant a = BadContravariant (a -> a)
instance Show (BadContravariant a) where
show _ = "BadContravariant <<Endo>>"
instance Eq a => Eq (BadContravariant a) where
BadContravariant f == BadContravariant g = False
instance Contravariant BadContravariant where
contramap f _ = BadContravariant id
genBadContravariant :: Gen a -> Gen (BadContravariant a)
genBadContravariant = fmap (BadContravariant . const)
-}
|
