Skip to content

Commit 5482318

Browse files
committed
Merge pull request #102 from treeowl/validation
Add tests for Applicative and Monad instances
2 parents 54c3603 + b2b55b0 commit 5482318

File tree

1 file changed

+20
-0
lines changed

1 file changed

+20
-0
lines changed

tests/seq-properties.hs

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ import qualified Prelude
1717
import qualified Data.List
1818
import Test.QuickCheck hiding ((><))
1919
import Test.QuickCheck.Poly
20+
import Test.QuickCheck.Function
2021
import Test.Framework
2122
import Test.Framework.Providers.QuickCheck2
2223

@@ -93,6 +94,9 @@ main = defaultMain
9394
, testProperty "zipWith3" prop_zipWith3
9495
, testProperty "zip4" prop_zip4
9596
, testProperty "zipWith4" prop_zipWith4
97+
, testProperty "<*>" prop_ap
98+
, testProperty "*>" prop_then
99+
, testProperty ">>=" prop_bind
96100
]
97101

98102
------------------------------------------------------------------------
@@ -588,6 +592,22 @@ prop_zipWith4 xs ys zs ts =
588592
toList' (zipWith4 f xs ys zs ts) ~= Data.List.zipWith4 f (toList xs) (toList ys) (toList zs) (toList ts)
589593
where f = (,,,)
590594

595+
-- Applicative operations
596+
597+
prop_ap :: Seq A -> Seq B -> Bool
598+
prop_ap xs ys =
599+
toList' ((,) <$> xs <*> ys) ~= ( (,) <$> toList xs <*> toList ys )
600+
601+
prop_then :: Seq A -> Seq B -> Bool
602+
prop_then xs ys =
603+
toList' (xs *> ys) ~= (toList xs *> toList ys)
604+
605+
-- Monad operations
606+
607+
prop_bind :: Seq A -> Fun A (Seq B) -> Bool
608+
prop_bind xs (Fun _ f) =
609+
toList' (xs >>= f) ~= (toList xs >>= toList . f)
610+
591611
-- Simple test monad
592612

593613
data M a = Action Int a

0 commit comments

Comments
 (0)