Alternative functions for better error reporting

bower.json

@@ -22,6 +22,7 @@
   "dependencies": {
     "purescript-proxy": "^3.0.0",
     "purescript-enums": "^4.0.0",
-    "purescript-quickcheck": "^5.0.0"
+    "purescript-quickcheck": "^5.0.0",
+    "purescript-quickcheck-combinators": "^0.1.1"
   }
 }

src/Test/QuickCheck/Laws.purs

@@ -23,6 +23,7 @@ derive newtype instance boundedEnumA :: BoundedEnum A
 derive newtype instance coarbitraryA ∷ Coarbitrary A
 derive newtype instance eqA ∷ Eq A
 derive newtype instance ordA ∷ Ord A
+derive newtype instance showA ∷ Show A
 derive newtype instance semigroupA ∷ Semigroup A
 instance monoidA ∷ Monoid A where mempty = A EQ
 
@@ -35,6 +36,7 @@ derive newtype instance boundedEnumB :: BoundedEnum B
 derive newtype instance coarbitraryB ∷ Coarbitrary B
 derive newtype instance eqB ∷ Eq B
 derive newtype instance ordB ∷ Ord B
+derive newtype instance showB ∷ Show B
 derive newtype instance semigroupB ∷ Semigroup B
 instance monoidB ∷ Monoid B where mempty = B EQ
 
@@ -47,6 +49,7 @@ derive newtype instance boundedEnumC :: BoundedEnum C
 derive newtype instance coarbitraryC ∷ Coarbitrary C
 derive newtype instance eqC ∷ Eq C
 derive newtype instance ordC ∷ Ord C
+derive newtype instance showC ∷ Show C
 derive newtype instance semigroupC ∷ Semigroup C
 instance monoidC ∷ Monoid C where mempty = C EQ
 
@@ -59,6 +62,7 @@ derive newtype instance boundedEnumD :: BoundedEnum D
 derive newtype instance coarbitraryD ∷ Coarbitrary D
 derive newtype instance eqD ∷ Eq D
 derive newtype instance ordD ∷ Ord D
+derive newtype instance showD ∷ Show D
 derive newtype instance semigroupD ∷ Semigroup D
 instance monoidD ∷ Monoid D where mempty = D EQ
 
@@ -71,5 +75,6 @@ derive newtype instance boundedEnumE :: BoundedEnum E
 derive newtype instance coarbitraryE ∷ Coarbitrary E
 derive newtype instance eqE ∷ Eq E
 derive newtype instance ordE ∷ Ord E
+derive newtype instance showE ∷ Show E
 derive newtype instance semigroupE ∷ Semigroup E
 instance monoidE ∷ Monoid E where mempty = E EQ

src/Test/QuickCheck/Laws/Control.purs

@@ -1,15 +1,15 @@
 module Test.QuickCheck.Laws.Control (module Exports) where
 
-import Test.QuickCheck.Laws.Control.Alt (checkAlt) as Exports
-import Test.QuickCheck.Laws.Control.Alternative (checkAlternative) as Exports
-import Test.QuickCheck.Laws.Control.Applicative (checkApplicative) as Exports
-import Test.QuickCheck.Laws.Control.Apply (checkApply) as Exports
-import Test.QuickCheck.Laws.Control.Bind (checkBind) as Exports
-import Test.QuickCheck.Laws.Control.Category (checkCategory) as Exports
-import Test.QuickCheck.Laws.Control.Comonad (checkComonad) as Exports
-import Test.QuickCheck.Laws.Control.Extend (checkExtend) as Exports
-import Test.QuickCheck.Laws.Control.Monad (checkMonad) as Exports
-import Test.QuickCheck.Laws.Control.MonadPlus (checkMonadPlus) as Exports
-import Test.QuickCheck.Laws.Control.MonadZero (checkMonadZero) as Exports
-import Test.QuickCheck.Laws.Control.Plus (checkPlus) as Exports
-import Test.QuickCheck.Laws.Control.Semigroupoid (checkSemigroupoid) as Exports
+import Test.QuickCheck.Laws.Control.Alt (checkAlt, checkAltShow) as Exports
+import Test.QuickCheck.Laws.Control.Alternative (checkAlternative, checkAlternativeShow) as Exports
+import Test.QuickCheck.Laws.Control.Applicative (checkApplicative, checkApplicativeShow) as Exports
+import Test.QuickCheck.Laws.Control.Apply (checkApply, checkApplyShow) as Exports
+import Test.QuickCheck.Laws.Control.Bind (checkBind, checkBindShow) as Exports
+import Test.QuickCheck.Laws.Control.Category (checkCategory, checkCategoryShow) as Exports
+import Test.QuickCheck.Laws.Control.Comonad (checkComonad, checkComonadShow) as Exports
+import Test.QuickCheck.Laws.Control.Extend (checkExtend, checkExtendShow) as Exports
+import Test.QuickCheck.Laws.Control.Monad (checkMonad, checkMonadShow) as Exports
+import Test.QuickCheck.Laws.Control.MonadPlus (checkMonadPlus, checkMonadPlusShow) as Exports
+import Test.QuickCheck.Laws.Control.MonadZero (checkMonadZero, checkMonadZeroShow) as Exports
+import Test.QuickCheck.Laws.Control.Plus (checkPlus, checkPlusShow) as Exports
+import Test.QuickCheck.Laws.Control.Semigroupoid (checkSemigroupoid, checkSemigroupoidShow) as Exports

src/Test/QuickCheck/Laws/Control/Alt.purs

@@ -5,7 +5,7 @@ import Prelude
 import Control.Alt (class Alt, (<|>))
 import Effect (Effect)
 import Effect.Console (log)
-import Test.QuickCheck (quickCheck')
+import Test.QuickCheck (quickCheck', Result, (===))
 import Test.QuickCheck.Arbitrary (class Arbitrary)
 import Test.QuickCheck.Laws (A, B)
 import Type.Proxy (Proxy2)
@@ -35,3 +35,33 @@ checkAlt _ = do
 
   distributivity ∷ (A → B) → f A → f A → Boolean
   distributivity f x y = (f <$> (x <|> y)) == ((f <$> x) <|> (f <$> y))
+
+
+-- | Like `checkAlt`, but with better error reporting.
+-- | - Associativity: `(x <|> y) <|> z == x <|> (y <|> z)`
+-- | - Distributivity: `f <$> (x <|> y) == (f <$> x) <|> (f <$> y)`
+checkAltShow
+  ∷ ∀ f
+  . Alt f
+  ⇒ Arbitrary (f A)
+  ⇒ Eq (f A)
+  ⇒ Eq (f B)
+  ⇒ Show (f A)
+  ⇒ Show (f B)
+  ⇒ Proxy2 f
+  → Effect Unit
+checkAltShow _ = do
+
+  log "Checking 'Associativity' law for Alt"
+  quickCheck' 1000 associativity
+
+  log "Checking 'Distributivity' law for Alt"
+  quickCheck' 1000 distributivity
+
+  where
+
+  associativity ∷ f A → f A → f A → Result
+  associativity x y z = ((x <|> y) <|> z) === (x <|> (y <|> z))
+
+  distributivity ∷ (A → B) → f A → f A → Result
+  distributivity f x y = (f <$> (x <|> y)) === ((f <$> x) <|> (f <$> y))

src/Test/QuickCheck/Laws/Control/Alternative.purs

@@ -7,7 +7,7 @@ import Control.Alternative (class Alternative)
 import Control.Plus (empty)
 import Effect (Effect)
 import Effect.Console (log)
-import Test.QuickCheck (quickCheck')
+import Test.QuickCheck (quickCheck', Result, (===))
 import Test.QuickCheck.Arbitrary (class Arbitrary)
 import Test.QuickCheck.Laws (A, B)
 import Type.Proxy (Proxy2)
@@ -37,3 +37,33 @@ checkAlternative _ = do
 
   annihilation ∷ f A → Boolean
   annihilation x = (empty <*> x) == empty ∷ f A
+
+
+-- | Like `checkAlternative`, but with better error reporting.
+-- | - Distributivity: `(f <|> g) <*> x == (f <*> x) <|> (g <*> x)`
+-- | - Annihilation: `empty <*> x = empty`
+checkAlternativeShow
+  ∷ ∀ f
+  . Alternative f
+  ⇒ Arbitrary (f (A → B))
+  ⇒ Arbitrary (f A)
+  ⇒ Eq (f A)
+  ⇒ Eq (f B)
+  ⇒ Show (f A)
+  ⇒ Show (f B)
+  ⇒ Proxy2 f  → Effect Unit
+checkAlternativeShow _ = do
+
+  log "Checking 'Left identity' law for Alternative"
+  quickCheck' 1000 distributivity
+
+  log "Checking 'Annihilation' law for Alternative"
+  quickCheck' 1000 annihilation
+
+  where
+
+  distributivity ∷ f (A → B) → f (A → B) → f A → Result
+  distributivity f g x = ((f <|> g) <*> x) === ((f <*> x) <|> (g <*> x))
+
+  annihilation ∷ f A → Result
+  annihilation x = (empty <*> x) === empty ∷ f A

src/Test/QuickCheck/Laws/Control/Applicative.purs

@@ -5,7 +5,7 @@ import Prelude
 import Data.Function as F
 import Effect (Effect)
 import Effect.Console (log)
-import Test.QuickCheck (quickCheck')
+import Test.QuickCheck (quickCheck', Result, (===))
 import Test.QuickCheck.Arbitrary (class Arbitrary)
 import Test.QuickCheck.Laws (A, B, C)
 import Type.Proxy (Proxy2)
@@ -52,3 +52,51 @@ checkApplicative _ = do
 
   interchange ∷ A → f (A → B) → Boolean
   interchange y u = (u <*> pure y) == (pure (_ $ y) <*> u)
+
+
+-- | Like `checkApplicative`, but with better error reporting.
+-- | - Identity: `(pure identity) <*> v = v`
+-- | - Composition: `(pure (<<<)) <*> f <*> g <*> h = f <*> (g <*> h)`
+-- | - Homomorphism: `(pure f) <*> (pure x) = pure (f x)`
+-- | - Interchange: `u <*> (pure y) = (pure ($ y)) <*> u`
+checkApplicativeShow
+  ∷ ∀ f
+  . Applicative f
+  ⇒ Arbitrary (f A)
+  ⇒ Arbitrary (f (A → B))
+  ⇒ Arbitrary (f (B → C))
+  ⇒ Eq (f A)
+  ⇒ Eq (f B)
+  ⇒ Eq (f C)
+  ⇒ Show (f A)
+  ⇒ Show (f B)
+  ⇒ Show (f C)
+  ⇒ Proxy2 f
+  → Effect Unit
+checkApplicativeShow _ = do
+
+  log "Checking 'Identity' law for Applicative"
+  quickCheck' 1000 identity
+
+  log "Checking 'Composition' law for Applicative"
+  quickCheck' 1000 composition
+
+  log "Checking 'Homomorphism' law for Applicative"
+  quickCheck' 1000 homomorphism
+
+  log "Checking 'Interchange' law for Applicative"
+  quickCheck' 1000 interchange
+
+  where
+
+  identity ∷ f A → Result
+  identity v = (pure F.identity <*> v) === v
+
+  composition ∷ f (B → C) → f (A → B) → f A → Result
+  composition f g x = (pure (<<<) <*> f <*> g <*> x) === (f <*> (g <*> x))
+
+  homomorphism ∷ (A → B) → A → Result
+  homomorphism f x = (pure f <*> pure x) === (pure (f x) ∷ f B)
+
+  interchange ∷ A → f (A → B) → Result
+  interchange y u = (u <*> pure y) === (pure (_ $ y) <*> u)

src/Test/QuickCheck/Laws/Control/Apply.purs

@@ -4,7 +4,7 @@ import Prelude
 
 import Effect (Effect)
 import Effect.Console (log)
-import Test.QuickCheck (quickCheck')
+import Test.QuickCheck (quickCheck', Result, (===))
 import Test.QuickCheck.Arbitrary (class Arbitrary)
 import Test.QuickCheck.Laws (A, B, C)
 import Type.Proxy (Proxy2)
@@ -28,3 +28,26 @@ checkApply _ = do
 
   associativeComposition ∷ f (B → C) → f (A → B) → f A → Boolean
   associativeComposition f g x = ((<<<) <$> f <*> g <*> x) == (f <*> (g <*> x))
+
+
+-- | Like `checkApply`, but with better error reporting.
+-- | - Associative composition: `(<<<) <$> f <*> g <*> h = f <*> (g <*> h)`
+checkApplyShow
+  ∷ ∀ f
+  . Apply f
+  ⇒ Arbitrary (f A)
+  ⇒ Arbitrary (f (A → B))
+  ⇒ Arbitrary (f (B → C))
+  ⇒ Eq (f C)
+  ⇒ Show (f C)
+  ⇒ Proxy2 f
+  → Effect Unit
+checkApplyShow _ = do
+
+  log "Checking 'Associative composition' law for Apply"
+  quickCheck' 1000 associativeComposition
+
+  where
+
+  associativeComposition ∷ f (B → C) → f (A → B) → f A → Result
+  associativeComposition f g x = ((<<<) <$> f <*> g <*> x) === (f <*> (g <*> x))

src/Test/QuickCheck/Laws/Control/Bind.purs

@@ -4,7 +4,7 @@ import Prelude
 
 import Effect (Effect)
 import Effect.Console (log)
-import Test.QuickCheck (quickCheck')
+import Test.QuickCheck (quickCheck', Result, (===))
 import Test.QuickCheck.Arbitrary (class Arbitrary)
 import Test.QuickCheck.Laws (A)
 import Type.Proxy (Proxy2)
@@ -26,3 +26,24 @@ checkBind _ = do
 
   associativity ∷ m A → (A → m A) → (A → m A) → Boolean
   associativity m f g = ((m >>= f) >>= g) == (m >>= (\x → f x >>= g))
+
+
+-- | Like `checkBind`, but with better error reporting
+-- | - Associativity: `(x >>= f) >>= g = x >>= (\k → f k >>= g)`
+checkBindShow
+  ∷ ∀ m
+  . Bind m
+  ⇒ Arbitrary (m A)
+  ⇒ Eq (m A)
+  ⇒ Show (m A)
+  ⇒ Proxy2 m
+  → Effect Unit
+checkBindShow _ = do
+
+  log "Checking 'Associativity' law for Bind"
+  quickCheck' 1000 associativity
+
+  where
+
+  associativity ∷ m A → (A → m A) → (A → m A) → Result
+  associativity m f g = ((m >>= f) >>= g) === (m >>= (\x → f x >>= g))

src/Test/QuickCheck/Laws/Control/Category.purs

@@ -5,7 +5,8 @@ import Prelude
 import Data.Function as F
 import Effect (Effect)
 import Effect.Console (log)
-import Test.QuickCheck (quickCheck')
+import Test.QuickCheck (quickCheck', Result, (===))
+import Test.QuickCheck.Combinators ((&=&))
 import Test.QuickCheck.Arbitrary (class Arbitrary)
 import Test.QuickCheck.Laws (B, C)
 import Type.Proxy (Proxy3)
@@ -28,3 +29,24 @@ checkCategory _ = do
   identity ∷ a B C → Boolean
   identity p = (F.identity <<< p) == p
             && (p <<< F.identity) == p
+
+
+-- | - Identity: `id <<< p = p <<< id = p`
+checkCategoryShow
+  ∷ ∀ a
+  . Category a
+  ⇒ Arbitrary (a B C)
+  ⇒ Eq (a B C)
+  ⇒ Show (a B C)
+  ⇒ Proxy3 a
+  → Effect Unit
+checkCategoryShow _ = do
+
+  log "Checking 'Identity' law for Category"
+  quickCheck' 1000 identity
+
+  where
+
+  identity ∷ a B C → Result
+  identity p = ((F.identity <<< p) === p)
+           &=& ((p <<< F.identity) === p)

src/Test/QuickCheck/Laws/Control/Comonad.purs

@@ -6,7 +6,7 @@ import Control.Comonad (class Comonad, extract)
 import Control.Extend ((<<=))
 import Effect (Effect)
 import Effect.Console (log)
-import Test.QuickCheck (quickCheck')
+import Test.QuickCheck (quickCheck', Result, (===))
 import Test.QuickCheck.Arbitrary (class Arbitrary, class Coarbitrary)
 import Test.QuickCheck.Laws (A, B)
 import Type.Proxy (Proxy2)
@@ -36,3 +36,32 @@ checkComonad _ = do
 
   rightIdentity ∷ (w A → B) → w A → Boolean
   rightIdentity f x = extract (f <<= x) == f x
+
+
+-- | Like `checkComonad`, but with better error reporting.
+-- | - Left Identity: `extract <<= x = x`
+-- | - Right Identity: `extract (f <<= x) = f x`
+checkComonadShow
+  ∷ ∀ w
+  . Comonad w
+  ⇒ Arbitrary (w A)
+  ⇒ Coarbitrary (w A)
+  ⇒ Eq (w A)
+  ⇒ Show (w A)
+  ⇒ Proxy2 w
+  → Effect Unit
+checkComonadShow _ = do
+
+  log "Checking 'Left identity' law for Comonad"
+  quickCheck' 1000 leftIdentity
+
+  log "Checking 'Right identity' law for Comonad"
+  quickCheck' 1000 rightIdentity
+
+  where
+
+  leftIdentity ∷ w A → Result
+  leftIdentity x = (extract <<= x) === x
+
+  rightIdentity ∷ (w A → B) → w A → Result
+  rightIdentity f x = extract (f <<= x) === f x