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
75
76
|
module Spec.Applicative (testApplicative) where
import Data.Functor.Compose (Compose(..))
import Data.Functor.Identity (Identity(..))
import Hedgehog
import Hedgehog.Classes
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Prelude hiding (either)
testApplicative :: [(String, [Laws])]
testApplicative =
[ ("[]", lawsList)
, ("Maybe", lawsMaybe)
, ("Either e", lawsEither)
, ("Compose", lawsCompose)
-- , ("Bin", lawsBin)
]
lawsList :: [Laws]
lawsList = [applicativeLaws (Gen.list (Range.linear 0 6))]
lawsMaybe :: [Laws]
lawsMaybe = [applicativeLaws Gen.maybe]
lawsEither :: [Laws]
lawsEither = [applicativeLaws eitherInteger]
lawsCompose :: [Laws]
lawsCompose = [applicativeLaws genCompose]
genCompose :: Gen a -> Gen (Compose Identity Identity a)
genCompose = fmap (Compose . Identity . Identity)
eitherInteger :: MonadGen m => m a -> m (Either Integer a)
eitherInteger = either (Gen.integral (Range.linear 0 20))
either :: MonadGen m => m e -> m a -> m (Either e a)
either genE genA =
Gen.sized $ \n ->
Gen.frequency [
(2, Left <$> genE)
, (1 + fromIntegral n, Right <$> genA)
]
{-
data Bin a = Leaf | Node (Bin a) a (Bin a)
deriving (Eq, Show)
instance Functor Bin where
fmap _ Leaf = Leaf
fmap f (Node l x r) = Node (fmap f l) (f x) (fmap f r)
instance Applicative Bin where
pure x = Node Leaf x Leaf
Leaf <*> _ = Leaf
_ <*> Leaf = Leaf
Node fl fx fr <*> Node l x r = Node (fl <*> l) (fx x) (fr <*> r)
genBin' :: Gen a -> Gen (Bin a)
genBin' gen = do
x <- gen
pure $ Node (Node Leaf x (Node Leaf x Leaf)) x (Node (Node Leaf x Leaf) x Leaf)
genBin :: Gen a -> Gen (Bin a)
genBin gen = Gen.frequency
[ (1, pure Leaf)
, (6, genBin' gen)
]
lawsBin :: [Laws]
lawsBin = [applicativeLaws genBin]
-}
|
