diff options
author | Yann Herklotz <git@ymhg.org> | 2019-04-17 19:20:10 +0100 |
---|---|---|
committer | Yann Herklotz <git@ymhg.org> | 2019-04-17 19:20:10 +0100 |
commit | 09792210537446b3400c61c699da8351cfe725dc (patch) | |
tree | 5d69c93d5aac364fca29d341030e1c643d1fdde0 /test | |
parent | 374fb6406dc93c8fb9c8a9b26c7a5c3516af3832 (diff) | |
download | verismith-09792210537446b3400c61c699da8351cfe725dc.tar.gz verismith-09792210537446b3400c61c699da8351cfe725dc.zip |
Extend property tests to ResultT
Diffstat (limited to 'test')
-rw-r--r-- | test/Property.hs | 46 |
1 files changed, 21 insertions, 25 deletions
diff --git a/test/Property.hs b/test/Property.hs index 8b9f338..06c2e86 100644 --- a/test/Property.hs +++ b/test/Property.hs @@ -69,33 +69,29 @@ type GenFunctor f a b c = ) mapCompose - :: forall f a b c - . GenFunctor f a b c - => (forall x. Gen x -> Gen (f x)) - -> Gen a - -> Gen b - -> Gen c - -> Property -mapCompose genF genA genB genC = - Hog.property $ do - g <- Hog.forAllFn $ Hog.fn @a genB - f <- Hog.forAllFn $ Hog.fn @b genC - xs <- Hog.forAll $ genF genA - fmap (f . g) xs === fmap f (fmap g xs) + :: forall f a b c + . GenFunctor f a b c + => (forall x . Gen x -> Gen (f x)) + -> Gen a + -> Gen b + -> Gen c + -> Property +mapCompose genF genA genB genC = Hog.property $ do + g <- Hog.forAllFn $ Hog.fn @a genB + f <- Hog.forAllFn $ Hog.fn @b genC + xs <- Hog.forAll $ genF genA + fmap (f . g) xs === fmap f (fmap g xs) propertyResultInterrupted :: Property propertyResultInterrupted = do - mapCompose - genResult - (Hog.int (Hog.linear 0 100)) - (Hog.int (Hog.linear 0 100)) - (Hog.int (Hog.linear 0 100)) - where - genResult :: Gen a -> Gen (Result Text a) - genResult a = Hog.choice - [ Pass <$> a - , Fail <$> Hog.text (Hog.linear 1 100) Hog.unicode - ] + mapCompose genResult + (Hog.int (Hog.linear 0 100)) + (Hog.int (Hog.linear 0 100)) + (Hog.int (Hog.linear 0 100)) + where + genResult :: Gen a -> Gen (Result Text a) + genResult a = Hog.choice + [Pass <$> a, Fail <$> Hog.text (Hog.linear 1 100) Hog.unicode] propertyTests :: TestTree propertyTests = testGroup @@ -103,5 +99,5 @@ propertyTests = testGroup [ testProperty "simple graph generation check" simpleGraph -- , testProperty "parser input" parserInput -- , testProperty "parser idempotence" parserIdempotent - , testProperty "fmap for Result" propertyResultInterrupted + , testProperty "fmap for Result" propertyResultInterrupted ] |