tasty-quickcheck-laws 0.0.2 → 0.0.3

raw patch · 8 files changed

+272/−7 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• README.md +2/−0
• src/Test/Tasty/QuickCheck/Laws.hs +4/−0
• src/Test/Tasty/QuickCheck/Laws/IdentityMonad.hs +144/−0
• src/Test/Tasty/QuickCheck/Laws/MaybeMonad.hs +2/−2
• src/Test/Tasty/QuickCheck/Laws/Semigroup.hs +64/−0
• tasty-quickcheck-laws.cabal +3/−1
• test/Main.hs +46/−4

@@ -1,6 +1,13 @@ Changelog for tasty-quickcheck-laws =================================== +0.0.3+-----++* Added+    * Identity monad laws+    * Semigroup laws+ 0.0.2 ----- 

@@ -8,10 +8,12 @@ Currently includes laws for the following type classes:  * Eq+* Semigroup * Monoid * Functor * Applicative * Monad+* Identity Monad * State Monad * Reader Monad * Writer Monad

@@ -16,10 +16,12 @@   , module Test.Tasty.QuickCheck.Laws.Functor   , module Test.Tasty.QuickCheck.Laws.Monad   , module Test.Tasty.QuickCheck.Laws.Monoid+  , module Test.Tasty.QuickCheck.Laws.Semigroup   , module Test.Tasty.QuickCheck.Laws.ReaderMonad   , module Test.Tasty.QuickCheck.Laws.StateMonad   , module Test.Tasty.QuickCheck.Laws.WriterMonad   , module Test.Tasty.QuickCheck.Laws.MaybeMonad+  , module Test.Tasty.QuickCheck.Laws.IdentityMonad ) where  import Test.Tasty.QuickCheck.Laws.Applicative@@ -29,7 +31,9 @@ import Test.Tasty.QuickCheck.Laws.Functor import Test.Tasty.QuickCheck.Laws.Monad import Test.Tasty.QuickCheck.Laws.Monoid+import Test.Tasty.QuickCheck.Laws.Semigroup import Test.Tasty.QuickCheck.Laws.ReaderMonad import Test.Tasty.QuickCheck.Laws.StateMonad import Test.Tasty.QuickCheck.Laws.WriterMonad import Test.Tasty.QuickCheck.Laws.MaybeMonad+import Test.Tasty.QuickCheck.Laws.IdentityMonad

@@ -0,0 +1,144 @@+{- |+Module      : Test.Tasty.QuickCheck.Laws.IdentityMonad+Description : Prefab tasty trees of quickcheck properties for the identity monad laws+Copyright   : 2019, Automattic, Inc.+License     : BSD3+Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)+Stability   : experimental+Portability : POSIX+-}++++{-# LANGUAGE Rank2Types #-}+module Test.Tasty.QuickCheck.Laws.IdentityMonad (+    testIdentityMonadLaws++  -- * Identity Monad Laws+  , testIdentityMonadLawUnwrapReturn+  , testIdentityMonadLawReturnUnwrap+  , testIdentityMonadLawBind+) where++import Data.Proxy+  ( Proxy(..) )+import Data.Typeable+  ( Typeable, typeRep )+import Test.Tasty+  ( TestTree, testGroup )+import Test.Tasty.QuickCheck+  ( testProperty, Property, Arbitrary(..), CoArbitrary(..) )+import Text.Show.Functions+  ()++import Test.Tasty.QuickCheck.Laws.Class++++-- | Constructs a @TestTree@ checking that the identity monad laws hold for @m@ with value types @a@ and @b@, using a given equality test for values of type @forall u. m u@. The equality context type @t@ is for constructors @m@ from which we can only extract a value within a context, such as reader-like constructors.+testIdentityMonadLaws+  :: ( Monad m+     , Eq a, Eq b+     , Show t, Show a+     , Show (m a)+     , Arbitrary t, Arbitrary a, CoArbitrary a+     , Arbitrary (m a), Arbitrary (m b)+     , Typeable m, Typeable a+     )+  => Proxy m -- ^ Type constructor under test+  -> Proxy t -- ^ Equality context for @m@+  -> Proxy a -- ^ Value type+  -> Proxy b -- ^ Value type+  -> (forall u. (Eq u) => t -> m u -> m u -> Bool) -- ^ Equality test+  -> (forall a. m a -> a) -- ^ @unwrap@+  -> TestTree+testIdentityMonadLaws pm pt pa pb eq unwrap =+  let+    label = "Identity Monad Laws for " ++ (show $ typeRep pm) ++ " with " +++      "a :: " ++ (show $ typeRep pa)+  in+    testGroup label+      [ testIdentityMonadLawUnwrapReturn pm pt pa unwrap+      , testIdentityMonadLawReturnUnwrap pm pt pa eq unwrap+      , testIdentityMonadLawBind pm pt pa pb eq unwrap+      ]++++-- | @unwrap . return === id@+testIdentityMonadLawUnwrapReturn+  :: ( Monad m, Eq a, Show a+     , Show t+     , Arbitrary t, Arbitrary a, Show (m a)+     )+  => Proxy m -- ^ Type constructor under test+  -> Proxy t -- ^ Equality context for @m@+  -> Proxy a -- ^ Value type+  -> (forall a. m a -> a) -- ^ @unwrap@+  -> TestTree+testIdentityMonadLawUnwrapReturn pm pt pa unwrap =+  testProperty "unwrap . return === id" $+    identityMonadLawUnwrapReturn pm pt pa unwrap++identityMonadLawUnwrapReturn+  :: (Monad m, Eq a)+  => Proxy m -> Proxy t -> Proxy a+  -> (forall a. m a -> a) -- ^ @unwrap@+  -> t -> a -> Bool+identityMonadLawUnwrapReturn _ _ _ unwrap t x =+  (unwrap . return $ x) == x++++-- | @unwrap . return === id@+testIdentityMonadLawReturnUnwrap+  :: ( Monad m, Eq a+     , Show t+     , Arbitrary t, Arbitrary (m a), Show (m a)+     )+  => Proxy m -- ^ Type constructor under test+  -> Proxy t -- ^ Equality context for @m@+  -> Proxy a -- ^ Value type+  -> (forall u. (Eq u) => t -> m u -> m u -> Bool) -- ^ Equality test+  -> (forall a. m a -> a) -- ^ @unwrap@+  -> TestTree+testIdentityMonadLawReturnUnwrap pm pt pa eq bail =+  testProperty "return . unwrap == id" $+    identityMonadLawReturnUnwrap pm pt pa eq bail++identityMonadLawReturnUnwrap+  :: (Monad m, Eq a)+  => Proxy m -> Proxy t -> Proxy a+  -> (forall u. (Eq u) => t -> m u -> m u -> Bool) -- ^ Equality test+  -> (forall a. m a -> a) -- ^ unwrap+  -> t -> m a -> Bool+identityMonadLawReturnUnwrap _ _ _ eq unwrap t x =+  (eq t) (return . unwrap $ x) (x)++++-- | @unwrap (x >>= f) === unwrap (f (unwrap x))@+testIdentityMonadLawBind+  :: ( Monad m, Eq b+     , Show t, CoArbitrary a, Arbitrary (m b)+     , Arbitrary t, Arbitrary (m a), Show (m a)+     )+  => Proxy m -- ^ Type constructor under test+  -> Proxy t -- ^ Equality context for @m@+  -> Proxy a -- ^ Value type+  -> Proxy b -- ^ Value type+  -> (forall u. (Eq u) => t -> m u -> m u -> Bool) -- ^ Equality test+  -> (forall a. m a -> a) -- ^ @unwrap@+  -> TestTree+testIdentityMonadLawBind pm pt pa pb eq unwrap =+  testProperty "x >>= f === f (unwrap x)" $+    identityMonadLawBind pm pt pa pb eq unwrap++identityMonadLawBind+  :: (Monad m, Eq b)+  => Proxy m -> Proxy t -> Proxy a -> Proxy b+  -> (forall u. (Eq u) => t -> m u -> m u -> Bool) -- ^ Equality test+  -> (forall a. m a -> a) -- ^ @unwrap@+  -> t -> m a -> (a -> m b) -> Bool+identityMonadLawBind _ _ _ _ eq unwrap t x f =+  (eq t) (x >>= f) (f (unwrap x))

@@ -33,7 +33,7 @@   --- | Constructs a @TestTree@ checking that the maybe monad laws hold for @m@ with maybe type @r@ and value types @a@ and @b@, using a given equality test for values of type @forall u. m u@. The equality context type @t@ is for constructors @m@ from which we can only extract a value within a context, such as reader-like constructors.+-- | Constructs a @TestTree@ checking that the maybe monad laws hold for @m@ with value types @a@ and @b@, using a given equality test for values of type @forall u. m u@. The equality context type @t@ is for constructors @m@ from which we can only extract a value within a context, such as reader-like constructors. testMaybeMonadLaws   :: ( Monad m      , Eq a@@ -80,7 +80,7 @@   :: (Monad m, Eq a)   => Proxy m -> Proxy t -> Proxy a   -> (forall u. (Eq u) => t -> m u -> m u -> Bool) -- ^ Equality test-  -> (forall a. m a) -- ^ bail+  -> (forall a. m a) -- ^ @bail@   -> t -> m a -> Bool maybeMonadLawBailThen _ _ _ eq bail t x =   (eq t) (bail >> x) (bail)

@@ -0,0 +1,64 @@+{- |+Module      : Test.Tasty.QuickCheck.Laws.Semigroup+Description : Prefab tasty trees of quickcheck properties for the Semigroup laws+Copyright   : 2019, Automattic, Inc.+License     : BSD3+Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)+Stability   : experimental+Portability : POSIX+-}++++module Test.Tasty.QuickCheck.Laws.Semigroup (+    testSemigroupLaws++  -- * Semigroup Laws+  , testSemigroupLawAssociative+) where++import Data.Proxy+  ( Proxy(..) )+import Data.Semigroup+  ( Semigroup(..) )+import Data.Typeable+  ( Typeable, typeRep )+import Test.Tasty+  ( TestTree, testGroup )+import Test.Tasty.QuickCheck+  ( testProperty, Property, Arbitrary(..) )++import Test.Tasty.QuickCheck.Laws.Class++++-- | Constructs a @TestTree@ checking that the @Semigroup@ class laws hold for @a@.+testSemigroupLaws+  :: (Semigroup a, Eq a, Show a, Arbitrary a, Typeable a)+  => Proxy a+  -> TestTree+testSemigroupLaws pa =+  let label = "Semigroup Laws for " ++ (show $ typeRep pa) in+  testGroup label+    [ testSemigroupLawAssociative pa+    ]++++++-- | @(a <> b) <> c === a <> (b <> c)@+testSemigroupLawAssociative+  :: (Semigroup a, Eq a, Show a, Arbitrary a)+  => Proxy a+  -> TestTree+testSemigroupLawAssociative pa =+  testProperty "(a <> b) <> c === a <> (b <> c)" $+    semigroupLawAssociative pa++semigroupLawAssociative+  :: (Semigroup a, Eq a)+  => Proxy a+  -> a -> a -> a -> Bool+semigroupLawAssociative _ a b c =+  (a <> b) <> c == a <> (b <> c)

@@ -1,5 +1,5 @@ name:           tasty-quickcheck-laws-version:        0.0.2+version:        0.0.3 description:    Please see the README on GitHub at <https://github.com/nbloomf/tasty-quickcheck-laws#readme> homepage:       https://github.com/nbloomf/tasty-quickcheck-laws#readme bug-reports:    https://github.com/nbloomf/tasty-quickcheck-laws/issues@@ -42,10 +42,12 @@     Test.Tasty.QuickCheck.Laws.Functor     Test.Tasty.QuickCheck.Laws.Monad     Test.Tasty.QuickCheck.Laws.Monoid+    Test.Tasty.QuickCheck.Laws.Semigroup     Test.Tasty.QuickCheck.Laws.ReaderMonad     Test.Tasty.QuickCheck.Laws.StateMonad     Test.Tasty.QuickCheck.Laws.WriterMonad     Test.Tasty.QuickCheck.Laws.MaybeMonad+    Test.Tasty.QuickCheck.Laws.IdentityMonad   

@@ -5,6 +5,7 @@ import System.Environment import Control.Monad (ap) import Test.QuickCheck+import Data.Typeable  import Test.Tasty.QuickCheck.Laws @@ -20,6 +21,11 @@       , testEqLaws pB       , testEqLaws pI       ]+    , testGroup "Semigroup Laws"+      [ testSemigroupLaws (Proxy :: Proxy [()])+      , testSemigroupLaws (Proxy :: Proxy [Bool])+      , testSemigroupLaws (Proxy :: Proxy (Maybe [()]))+      ]     , testGroup "Monoid Laws"       [ testMonoidLaws (Proxy :: Proxy [()])       , testMonoidLaws (Proxy :: Proxy [Bool])@@ -58,6 +64,11 @@       , testMonadLaws3 pEi pU pU pB pI (const (==))       , testMonadLaws3 pLs pU pU pB pI (const (==))       ]+    , testGroup "Identity Monad Laws"+      [ testIdentityMonadLaws pId pU pU pU (const (==)) unwrap+      , testIdentityMonadLaws pId pU pB pB (const (==)) unwrap+      , testIdentityMonadLaws pId pU pI pI (const (==)) unwrap+      ]     , testGroup "State Monad Laws"       [ testStateMonadLaws pSU pU pU pU stateEq get put       , testStateMonadLaws pSB pB pB pB stateEq get put@@ -116,6 +127,8 @@ pEB = Proxy :: Proxy (Error Bool) pEI = Proxy :: Proxy (Error Int) +pId = Proxy :: Proxy Identity+ pWU = Proxy :: Proxy (Writer ()) pWLs = const Proxy :: Proxy a -> Proxy (Writer [a]) @@ -127,7 +140,8 @@ -- Basic State Monad  data State s a = State-  { runState :: s -> (a,s) }+  { runState :: s -> (a,s)+  } deriving Typeable  stateEq   :: (Eq s, Eq a)@@ -162,7 +176,8 @@ -- Basic Reader Monad  data Reader r a = Reader-  { runReader :: r -> a }+  { runReader :: r -> a+  } deriving Typeable  readerEq   :: (Eq a)@@ -201,7 +216,7 @@  data Error e a = Error   { runError :: Either e a-  } deriving (Eq, Show)+  } deriving (Eq, Show, Typeable)  instance Monad (Error e) where   return a = Error (Right a)@@ -234,7 +249,7 @@  data Writer w a = Writer   { runWriter :: (a,w)-  } deriving (Eq, Show)+  } deriving (Eq, Show, Typeable)  instance (Monoid w) => Monad (Writer w) where   return a = Writer (a, mempty)@@ -275,3 +290,30 @@     ((a,f),w) = runWriter x   in     Writer (a, f w)++++-- Basic Identity Monad++data Identity a = Identity a+  deriving (Eq, Show, Typeable)++instance Functor Identity where+  fmap f (Identity x) = Identity (f x)++instance Applicative Identity where+  pure = Identity++  (Identity f) <*> (Identity x) =+    Identity (f x)++instance Monad Identity where+  return = Identity++  (Identity x) >>= f = f x++instance (Arbitrary a) => Arbitrary (Identity a) where+  arbitrary = Identity <$> arbitrary++unwrap :: Identity a -> a+unwrap (Identity x) = x