From 0736a039d9517e456c62d1b13298d8ab27f40ebf Mon Sep 17 00:00:00 2001
From: Jorge Acereda <jacereda@gmail.com>
Date: Fri, 11 Nov 2016 00:34:41 +0100
Subject: [PATCH 1/2] Add checks for BoundedEnum

---
 src/Test/QuickCheck/Laws.purs                 | 151 +++++-------------
 src/Test/QuickCheck/Laws/Data.purs            |   1 +
 .../QuickCheck/Laws/Data/BoundedEnum.purs     |  84 ++++++++++
 test/Test/Data/Either.purs                    |   1 +
 test/Test/Data/Maybe.purs                     |   1 +
 test/Test/Data/Ordering.purs                  |   1 +
 test/Test/Data/Tuple.purs                     |   1 +
 test/Test/Data/Unit.purs                      |   1 +
 test/Test/Prim/Boolean.purs                   |   1 +
 9 files changed, 135 insertions(+), 107 deletions(-)
 create mode 100644 src/Test/QuickCheck/Laws/Data/BoundedEnum.purs

diff --git a/src/Test/QuickCheck/Laws.purs b/src/Test/QuickCheck/Laws.purs
index e4b056f..7dfd83d 100644
--- a/src/Test/QuickCheck/Laws.purs
+++ b/src/Test/QuickCheck/Laws.purs
@@ -4,13 +4,11 @@ module Test.QuickCheck.Laws
   ) where
 
 import Prelude
-
 import Control.Monad.Eff.Console (log)
-
+import Data.Enum (class BoundedEnum)
 import Data.Monoid (class Monoid)
-
 import Test.QuickCheck (QC)
-import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary, class Coarbitrary, coarbitrary)
+import Test.QuickCheck.Arbitrary (class Arbitrary, class Coarbitrary)
 
 checkLaws ∷ ∀ eff. String → QC eff Unit → QC eff Unit
 checkLaws typeName laws = do
@@ -19,117 +17,56 @@ checkLaws typeName laws = do
 
 newtype A = A Ordering
 
-instance eqA ∷ Eq A where
-  eq (A x) (A y) = eq x y
-
-instance ordA ∷ Ord A where
-  compare (A x) (A y) = compare x y
-
-instance boundedA ∷ Bounded A where
-  top = A top
-  bottom = A bottom
-
-instance semigroupA ∷ Semigroup A where
-  append (A x) (A y) = A (x <> y)
-
-instance monoidA ∷ Monoid A where
-  mempty = A EQ
-
-instance arbitraryA ∷ Arbitrary A where
-  arbitrary = A <$> arbitrary
-
-instance coarbitraryA ∷ Coarbitrary A where
-  coarbitrary (A x) = coarbitrary x
+derive newtype instance arbitraryA ∷ Arbitrary A
+derive newtype instance boundedA ∷ Bounded A
+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 semigroupA ∷ Semigroup A
+instance monoidA ∷ Monoid A where mempty = A EQ
 
 newtype B = B Ordering
 
-instance eqB ∷ Eq B where
-  eq (B x) (B y) = eq x y
-
-instance ordB ∷ Ord B where
-  compare (B x) (B y) = compare x y
-
-instance boundedB ∷ Bounded B where
-  top = B top
-  bottom = B bottom
-
-instance semigroupB ∷ Semigroup B where
-  append (B x) (B y) = B (x <> y)
-
-instance monoidB ∷ Monoid B where
-  mempty = B EQ
-
-instance arbitraryB ∷ Arbitrary B where
-  arbitrary = B <$> arbitrary
-
-instance coarbitraryB ∷ Coarbitrary B where
-  coarbitrary (B x) = coarbitrary x
+derive newtype instance arbitraryB ∷ Arbitrary B
+derive newtype instance boundedB ∷ Bounded B
+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 semigroupB ∷ Semigroup B
+instance monoidB ∷ Monoid B where mempty = B EQ 
 
 newtype C = C Ordering
 
-instance eqC ∷ Eq C where
-  eq (C x) (C y) = eq x y
-
-instance ordC ∷ Ord C where
-  compare (C x) (C y) = compare x y
-
-instance boundedC ∷ Bounded C where
-  top = C top
-  bottom = C bottom
-
-instance semigroupC ∷ Semigroup C where
-  append (C x) (C y) = C (x <> y)
-
-instance monoidC ∷ Monoid C where
-  mempty = C EQ
-
-instance arbitraryC ∷ Arbitrary C where
-  arbitrary = C <$> arbitrary
-
-instance coarbitraryC ∷ Coarbitrary C where
-  coarbitrary (C x) = coarbitrary x
-
+derive newtype instance arbitraryC ∷ Arbitrary C
+derive newtype instance boundedC ∷ Bounded C
+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 semigroupC ∷ Semigroup C
+instance monoidC ∷ Monoid C where mempty = C EQ
+                                  
 newtype D = D Ordering
 
-instance eqD ∷ Eq D where
-  eq (D x) (D y) = eq x y
-
-instance ordD ∷ Ord D where
-  compare (D x) (D y) = compare x y
-
-instance boundedD ∷ Bounded D where
-  top = D top
-  bottom = D bottom
-
-instance semigroupD ∷ Semigroup D where
-  append (D x) (D y) = D (x <> y)
-
-instance monoidD ∷ Monoid D where
-  mempty = D EQ
-
-instance arbitraryD ∷ Arbitrary D where
-  arbitrary = D <$> arbitrary
-
-instance coarbitraryD ∷ Coarbitrary D where
-  coarbitrary (D x) = coarbitrary x
-
+derive newtype instance arbitraryD ∷ Arbitrary D
+derive newtype instance boundedD ∷ Bounded D
+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 semigroupD ∷ Semigroup D
+instance monoidD ∷ Monoid D where mempty = D EQ
+                                  
 newtype E = E Ordering
 
-instance eqE ∷ Eq E where
-  eq (E x) (E y) = eq x y
-
-instance ordE ∷ Ord E where
-  compare (E x) (E y) = compare x y
-
-instance boundedE ∷ Bounded E where
-  top = E top
-  bottom = E bottom
-
-instance semigroupE ∷ Semigroup E where
-  append (E x) (E y) = E (x <> y)
-
-instance arbitraryE ∷ Arbitrary E where
-  arbitrary = E <$> arbitrary
+derive newtype instance arbitraryE ∷ Arbitrary E
+derive newtype instance boundedE ∷ Bounded E
+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 semigroupE ∷ Semigroup E
+instance monoidE ∷ Monoid E where mempty = E EQ                         
 
-instance coarbitraryE ∷ Coarbitrary E where
-  coarbitrary (E x) = coarbitrary x
diff --git a/src/Test/QuickCheck/Laws/Data.purs b/src/Test/QuickCheck/Laws/Data.purs
index 9e194e0..608dfa3 100644
--- a/src/Test/QuickCheck/Laws/Data.purs
+++ b/src/Test/QuickCheck/Laws/Data.purs
@@ -4,6 +4,7 @@ import Test.QuickCheck.Laws.Data.BooleanAlgebra (checkBooleanAlgebra) as Exports
 import Test.QuickCheck.Laws.Data.Bounded (checkBounded) as Exports
 import Test.QuickCheck.Laws.Data.CommutativeRing (checkCommutativeRing) as Exports
 import Test.QuickCheck.Laws.Data.Eq (checkEq) as Exports
+import Test.QuickCheck.Laws.Data.BoundedEnum (checkBoundedEnum) as Exports
 import Test.QuickCheck.Laws.Data.EuclideanRing (checkEuclideanRing) as Exports
 import Test.QuickCheck.Laws.Data.Field (checkField) as Exports
 import Test.QuickCheck.Laws.Data.Foldable (checkFoldable, checkFoldableFunctor) as Exports
diff --git a/src/Test/QuickCheck/Laws/Data/BoundedEnum.purs b/src/Test/QuickCheck/Laws/Data/BoundedEnum.purs
new file mode 100644
index 0000000..fc2a7a8
--- /dev/null
+++ b/src/Test/QuickCheck/Laws/Data/BoundedEnum.purs
@@ -0,0 +1,84 @@
+
+module Test.QuickCheck.Laws.Data.BoundedEnum where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+import Data.Array (replicate, foldl)
+import Data.Enum (toEnum, Cardinality, cardinality, fromEnum, class BoundedEnum, pred, succ)
+import Data.Maybe (Maybe(Just))
+import Data.Newtype (unwrap)
+import Test.QuickCheck (QC, quickCheck')
+import Test.QuickCheck.Arbitrary (class Arbitrary)
+import Type.Proxy (Proxy)
+
+
+-- | - succ: `succ bottom >>= succ >>= succ ... succ [cardinality - 1 times] = top`
+-- | - pred: `pred top    >>= pred >>= pred ... pred [cardinality - 1 times] = bottom`
+-- | - predsucc: `forall a > bottom: pred a >>= succ = Just a`
+-- | - succpred: `forall a < top:  succ a >>= pred = Just a`
+-- | - enumpred: `forall a > bottom: fromEnum <$> pred a = Just (fromEnum a - 1)`
+-- | - enumsucc: `forall a < top:  fromEnum <$> succ a = Just (fromEnum a + 1)`
+-- | - compare: `compare e1 e2 = compare (fromEnum e1) (fromEnum e2)`
+-- | - tofromenum: toEnum (fromEnum a) = Just a
+
+checkBoundedEnum
+  ∷ ∀ eff a
+  . (Arbitrary a, BoundedEnum a, Ord a)
+  ⇒ Proxy a
+  → QC eff Unit
+checkBoundedEnum _ = do
+
+  log "Checking 'succ' law for BoundedEnum"
+  quickCheck' 1 succLaw
+
+  log "Checking 'pred' law for BoundedEnum"
+  quickCheck' 1 predLaw
+
+  log "Checking 'predsucc' law for BoundedEnum"
+  quickCheck' 1000 predsuccLaw
+
+  log "Checking 'succpred' law for BoundedEnum"
+  quickCheck' 1000 succpredLaw
+
+  log "Checking 'enumpred' law for BoundedEnum"
+  quickCheck' 1000 enumpredLaw
+
+  log "Checking 'enumsucc' law for BoundedEnum"
+  quickCheck' 1000 enumsuccLaw
+
+  log "Checking 'compare' law for BoundedEnum"
+  quickCheck' 1000 compareLaw
+
+  log "Checking 'tofromenum' law for BoundedEnum"
+  quickCheck' 1000 tofromenumLaw
+
+
+  where
+    c :: Int
+    c = unwrap (cardinality :: Cardinality a)
+    
+    succLaw :: Boolean
+    succLaw = (Just top :: Maybe a) ==
+                foldl (>>=) (pure bottom) (replicate (c - 1) succ)
+
+    predLaw :: Boolean
+    predLaw = (Just bottom :: Maybe a) ==
+                foldl (>>=) (pure top) (replicate (c - 1) pred)
+
+    predsuccLaw :: a -> Boolean
+    predsuccLaw a = a == bottom || (pred a >>= succ) == Just a
+    
+    succpredLaw :: a -> Boolean
+    succpredLaw a = a == top || (succ a >>= pred) == Just a
+
+    enumpredLaw :: a -> Boolean
+    enumpredLaw a = a == bottom || (fromEnum <$> pred a) == Just (fromEnum a - 1)
+    
+    enumsuccLaw :: a -> Boolean
+    enumsuccLaw a = a == top || (fromEnum <$> succ a) == Just (fromEnum a + 1)
+
+    compareLaw :: a -> a -> Boolean
+    compareLaw a b = a `compare` b == fromEnum a `compare` fromEnum b
+
+    tofromenumLaw :: a -> Boolean
+    tofromenumLaw a = toEnum (fromEnum a) == Just a
diff --git a/test/Test/Data/Either.purs b/test/Test/Data/Either.purs
index a8e241e..63d77c9 100644
--- a/test/Test/Data/Either.purs
+++ b/test/Test/Data/Either.purs
@@ -15,6 +15,7 @@ checkEither = checkLaws "Either" do
   Data.checkEq prxEither
   Data.checkOrd prxEither
   Data.checkBounded prxEither
+  Data.checkBoundedEnum prxEither
   Data.checkFunctor prx2Either
   Data.checkFoldableFunctor prx2Either  
   Control.checkApply prx2Either
diff --git a/test/Test/Data/Maybe.purs b/test/Test/Data/Maybe.purs
index 5492d02..10ffcb3 100644
--- a/test/Test/Data/Maybe.purs
+++ b/test/Test/Data/Maybe.purs
@@ -15,6 +15,7 @@ checkMaybe = checkLaws "Maybe" do
   Data.checkEq prxMaybe
   Data.checkOrd prxMaybe
   Data.checkBounded prxMaybe
+  Data.checkBoundedEnum prxMaybe
   Data.checkSemigroup prxMaybe
   Data.checkMonoid prxMaybe
   Data.checkFunctor prx2Maybe
diff --git a/test/Test/Data/Ordering.purs b/test/Test/Data/Ordering.purs
index f67e400..ea7c3b3 100644
--- 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.checkBoundedEnum prxOrdering
   Data.checkSemigroup prxOrdering
   where
   prxOrdering = Proxy ∷ Proxy Ordering
diff --git a/test/Test/Data/Tuple.purs b/test/Test/Data/Tuple.purs
index 18b142d..bd1fb8c 100644
--- a/test/Test/Data/Tuple.purs
+++ b/test/Test/Data/Tuple.purs
@@ -15,6 +15,7 @@ checkTuple = checkLaws "Tuple" do
   Data.checkEq prxTuple
   Data.checkOrd prxTuple
   Data.checkBounded prxTuple
+  Data.checkBoundedEnum prxTuple
   Data.checkSemigroup prxTuple
   Data.checkMonoid prxTuple
   Data.checkFunctor prx2Tuple
diff --git a/test/Test/Data/Unit.purs b/test/Test/Data/Unit.purs
index 2d6b6ef..164f2dc 100644
--- 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.checkBoundedEnum prxUnit  
   Data.checkSemigroup prxUnit
   Data.checkMonoid prxUnit
   Data.checkSemiring prxUnit
diff --git a/test/Test/Prim/Boolean.purs b/test/Test/Prim/Boolean.purs
index b49b8fd..3d9530e 100644
--- 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.checkBoundedEnum prxBoolean
   Data.checkHeytingAlgebra prxBoolean
   Data.checkBooleanAlgebra prxBoolean
   where

From 4b03cf01608506da6d662d19f1ec8abf3450ea6c Mon Sep 17 00:00:00 2001
From: Jorge Acereda <jacereda@gmail.com>
Date: Fri, 11 Nov 2016 00:56:15 +0100
Subject: [PATCH 2/2] Add dependency on purescript-enums

---
 bower.json | 1 +
 1 file changed, 1 insertion(+)

diff --git a/bower.json b/bower.json
index 79acd98..e2d27f2 100644
--- a/bower.json
+++ b/bower.json
@@ -21,6 +21,7 @@
   ],
   "dependencies": {
     "purescript-proxy": "^1.0.0",
+    "purescript-enums": "^2.0.1", 
     "purescript-quickcheck": "^3.0.0"
   }
 }