Add checks for Enum (#23)

* Add checks for Enum * Remove redundant checks * New set of laws * Inconsistent variable names * Use pred/succ instead of arithmetic * Don't call checkEnum from checkBoundedEnum * Detect overflow when checking submultiplicative euclidean function * Update module names in imports; fix whitespace * Remove duplicate Enum instances * Fix errors in Enum file * Drop BoundedEnum check for Either * Drop BoundedEnum check for Maybe * Drop BoundedEnum check for Tuple * Add checkEnumGen * Revert EuclideanRing change Co-authored-by: JordanMartinez <[email protected]> Co-authored-by: JordanMartinez <[email protected]>
purescript-contrib · Nov 10, 2021 · 44d0449 · 44d0449
1 parent b09ef8c
commit 44d0449
Show file tree

Hide file tree

Showing 11 changed files with 78 additions and 6 deletions.
diff --git a/src/Test/QuickCheck/Laws.purs b/src/Test/QuickCheck/Laws.purs
@@ -3,7 +3,6 @@ module Test.QuickCheck.Laws
   ) where
 
 import Prelude
-
 import Data.Enum (class Enum, class BoundedEnum)
 import Effect (Effect)
 import Effect.Console (log)

diff --git a/src/Test/QuickCheck/Laws/Data.purs b/src/Test/QuickCheck/Laws/Data.purs
@@ -3,6 +3,7 @@ module Test.QuickCheck.Laws.Data (module Exports) where
 import Test.QuickCheck.Laws.Data.BooleanAlgebra (checkBooleanAlgebra, checkBooleanAlgebraGen) as Exports
 import Test.QuickCheck.Laws.Data.Bounded (checkBounded, checkBoundedGen) as Exports
 import Test.QuickCheck.Laws.Data.CommutativeRing (checkCommutativeRing, checkCommutativeRingGen) as Exports
+import Test.QuickCheck.Laws.Data.Enum (checkEnum, checkEnumGen) as Exports
 import Test.QuickCheck.Laws.Data.Eq (checkEq, checkEqGen) as Exports
 import Test.QuickCheck.Laws.Data.BoundedEnum (checkBoundedEnum, checkBoundedEnumGen) as Exports
 import Test.QuickCheck.Laws.Data.EuclideanRing (checkEuclideanRing, checkEuclideanRingGen) as Exports

diff --git a/src/Test/QuickCheck/Laws/Data/BoundedEnum.purs b/src/Test/QuickCheck/Laws/Data/BoundedEnum.purs
@@ -65,7 +65,6 @@ checkBoundedEnumGen gen = do
   log "Checking 'tofromenum' law for BoundedEnum"
   quickCheck' 1000 $ tofromenumLaw <$> gen
 
-
   where
     c :: Int
     c = unwrap (cardinality :: Cardinality a)
@@ -85,10 +84,10 @@ checkBoundedEnumGen gen = do
     succpredLaw a = a == top || (succ a >>= pred) == Just a
 
     enumpredLaw :: a -> Boolean
-    enumpredLaw a = a == bottom || (fromEnum <$> pred a) == Just (fromEnum a - 1)
+    enumpredLaw a = a == bottom || (fromEnum <$> pred a) == pred (fromEnum a)
 
     enumsuccLaw :: a -> Boolean
-    enumsuccLaw a = a == top || (fromEnum <$> succ a) == Just (fromEnum a + 1)
+    enumsuccLaw a = a == top || (fromEnum <$> succ a) == succ (fromEnum a)
 
     compareLaw :: a -> a -> Boolean
     compareLaw a b = a `compare` b == fromEnum a `compare` fromEnum b

diff --git a/src/Test/QuickCheck/Laws/Data/Enum.purs b/src/Test/QuickCheck/Laws/Data/Enum.purs
@@ -0,0 +1,67 @@
+
+module Test.QuickCheck.Laws.Data.Enum where
+
+import Prelude
+
+import Data.Enum (pred, succ, class Enum)
+import Data.Maybe (maybe)
+import Effect (Effect)
+import Effect.Console (log)
+import Test.QuickCheck (quickCheck')
+import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary)
+import Test.QuickCheck.Gen (Gen)
+import Type.Proxy (Proxy)
+
+checkEnum
+  ∷ ∀ a
+  . Arbitrary a
+  ⇒ Enum a
+  ⇒ Ord a
+  ⇒ Proxy a
+  → Effect Unit
+checkEnum _ = checkEnumGen (arbitrary :: Gen a)
+
+checkEnumGen
+  ∷ ∀ a
+  . Enum a
+  ⇒ Ord a
+  ⇒ Gen a
+  → Effect Unit
+checkEnumGen gen = do
+  log "Checking 'Successor' law for Enum"
+  quickCheck' 1000 $ successor <$> gen
+
+  log "Checking 'Predecessor' law for Enum"
+  quickCheck' 1000 $ predecessor <$> gen
+
+  log "Checking 'Succ retracts pred' law for Enum"
+  quickCheck' 1000 $ succRetractsPred <$> gen
+
+  log "Checking 'Pred retracts succ' law for Enum"
+  quickCheck' 1000 $ predRetractsSucc <$> gen
+
+  log "Checking 'Non-skipping succ' law for Enum"
+  quickCheck' 1000 $ nonSkippingSucc <$> gen <*> gen
+
+  log "Checking 'Non-skipping pred' law for Enum"
+  quickCheck' 1000 $ nonSkippingPred <$> gen <*> gen
+
+  where
+
+    successor :: a -> Boolean
+    successor a = maybe true (a < _) (succ a)
+
+    predecessor :: a -> Boolean
+    predecessor a = maybe true (_ < a) (pred a)
+
+    succRetractsPred :: a -> Boolean
+    succRetractsPred a = (pred a >>= succ >>= pred) == pred a
+
+    predRetractsSucc :: a -> Boolean
+    predRetractsSucc a = (succ a >>= pred >>= succ) == succ a
+
+    nonSkippingSucc :: a -> a -> Boolean
+    nonSkippingSucc a b = b <= a || maybe false (_ <= b) (succ a)
+
+    nonSkippingPred :: a -> a -> Boolean
+    nonSkippingPred a b = a <= b || maybe false (b <= _) (pred a)
diff --git a/src/Test/QuickCheck/Laws/Data/EuclideanRing.purs b/src/Test/QuickCheck/Laws/Data/EuclideanRing.purs
@@ -75,5 +75,5 @@ checkEuclideanRingGen gen = do
 
   submultiplicative ∷ a → a → Boolean
   submultiplicative a b
-    | a /= zero && b /= zero = degree a <= degree (a * b)
-    | otherwise = true
+    | a == zero || b == zero = true
+    | otherwise = degree a <= degree (a * b)
diff --git a/test/Test/Data/Either.purs b/test/Test/Data/Either.purs
@@ -14,6 +14,7 @@ checkEither = checkLaws "Either" do
   Data.checkEq prxEither
   Data.checkOrd prxEither
   Data.checkBounded prxEither
+  Data.checkEnum prxEither  
   Data.checkFunctor prx2Either
   Data.checkFunctorWithIndex prx2Either
   Data.checkFoldableFunctor prx2Either

diff --git a/test/Test/Data/Maybe.purs b/test/Test/Data/Maybe.purs
@@ -14,6 +14,7 @@ checkMaybe = checkLaws "Maybe" do
   Data.checkEq prxMaybe
   Data.checkOrd prxMaybe
   Data.checkBounded prxMaybe
+  Data.checkEnum prxMaybe  
   Data.checkSemigroup prxMaybe
   Data.checkMonoid prxMaybe
   Data.checkFunctor prx2Maybe

diff --git a/test/Test/Data/Ordering.purs b/test/Test/Data/Ordering.purs
@@ -12,6 +12,7 @@ checkOrdering = checkLaws "Ordering" do
   Data.checkEq prxOrdering
   Data.checkOrd prxOrdering
   Data.checkBounded prxOrdering
+  Data.checkEnum prxOrdering  
   Data.checkBoundedEnum prxOrdering
   Data.checkSemigroup prxOrdering
   where

diff --git a/test/Test/Data/Tuple.purs b/test/Test/Data/Tuple.purs
@@ -14,6 +14,7 @@ checkTuple = checkLaws "Tuple" do
   Data.checkEq prxTuple
   Data.checkOrd prxTuple
   Data.checkBounded prxTuple
+  Data.checkEnum prxTuple
   Data.checkSemigroup prxTuple
   Data.checkMonoid prxTuple
   Data.checkFunctor prx2Tuple

diff --git a/test/Test/Data/Unit.purs b/test/Test/Data/Unit.purs
@@ -12,6 +12,7 @@ checkUnit = checkLaws "Unit" do
   Data.checkEq prxUnit
   Data.checkOrd prxUnit
   Data.checkBounded prxUnit
+  Data.checkEnum prxUnit
   Data.checkBoundedEnum prxUnit
   Data.checkSemigroup prxUnit
   Data.checkMonoid prxUnit

diff --git a/test/Test/Prim/Boolean.purs b/test/Test/Prim/Boolean.purs
@@ -12,6 +12,7 @@ checkBoolean = checkLaws "Boolean" do
   Data.checkEq prxBoolean
   Data.checkOrd prxBoolean
   Data.checkBounded prxBoolean
+  Data.checkEnum prxBoolean  
   Data.checkBoundedEnum prxBoolean
   Data.checkHeytingAlgebra prxBoolean
   Data.checkBooleanAlgebra prxBoolean