Merge pull request #81 from Risto-Stevcev/master

Added some more helper comparison operations

Author: paf31

bower.json

@@ -33,5 +33,8 @@
     "purescript-strings": "^3.0.0",
     "purescript-transformers": "^3.0.0",
     "purescript-generics-rep": "^5.0.0"
+  },
+  "devDependencies": {
+    "purescript-assert": "^3.0.0"
   }
 }

src/Test/QuickCheck.purs

@@ -28,8 +28,18 @@ module Test.QuickCheck
   , (<?>)
   , assertEquals
   , (===)
+  , (==?)
   , assertNotEquals
   , (/==)
+  , (/=?)
+  , assertLessThan
+  , (<?)
+  , assertLessThanEq
+  , (<=?)
+  , assertGreaterThan
+  , (>?)
+  , assertGreaterThanEq
+  , (>=?)
   , module Test.QuickCheck.LCG
   , module Test.QuickCheck.Arbitrary
   ) where
@@ -41,15 +51,13 @@ import Control.Monad.Eff.Console (CONSOLE, log)
 import Control.Monad.Eff.Exception (EXCEPTION, throwException, error)
 import Control.Monad.Eff.Random (RANDOM)
 import Control.Monad.Rec.Class (Step(..), tailRec)
-
 import Data.Foldable (for_)
 import Data.List (List)
 import Data.Maybe (Maybe(..))
 import Data.Maybe.First (First(..))
 import Data.Monoid (mempty)
 import Data.Tuple (Tuple(..))
 import Data.Unfoldable (replicateA)
-
 import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary, class Coarbitrary, coarbitrary)
 import Test.QuickCheck.Gen (Gen, evalGen, runGen)
 import Test.QuickCheck.LCG (Seed, runSeed, randomSeed)
@@ -161,14 +169,40 @@ withHelp false msg = Failed msg
 
 infix 2 withHelp as <?>
 
+-- | Self-documenting comparison operation
+assertOp :: forall a. Eq a => Show a => (a -> a -> Boolean) -> String -> a -> a -> Result
+assertOp op failString a b = a `op` b <?> show a <> failString <> show b
+
 -- | Self-documenting equality assertion
 assertEquals :: forall a. Eq a => Show a => a -> a -> Result
-assertEquals a b = a == b <?> show a <> " /= " <> show b
+assertEquals = assertOp (==) " /= "
 
 infix 2 assertEquals as ===
+infix 2 assertEquals as ==?
 
 -- | Self-documenting inequality assertion
 assertNotEquals :: forall a. Eq a => Show a => a -> a -> Result
-assertNotEquals a b = a /= b <?> show a <> " == " <> show b
+assertNotEquals = assertOp (/=) " == "
 
 infix 2 assertNotEquals as /==
+infix 2 assertNotEquals as /=?
+
+assertLessThan :: forall a. Ord a => Show a => a -> a -> Result
+assertLessThan = assertOp (<) " >= "
+
+infix 2 assertLessThan as <?
+
+assertLessThanEq :: forall a. Ord a => Show a => a -> a -> Result
+assertLessThanEq = assertOp (<=) " > "
+
+infix 2 assertLessThanEq as <=?
+
+assertGreaterThan :: forall a. Ord a => Show a => a -> a -> Result
+assertGreaterThan = assertOp (>) " <= "
+
+infix 2 assertGreaterThan as >?
+
+assertGreaterThanEq :: forall a. Ord a => Show a => a -> a -> Result
+assertGreaterThanEq = assertOp (>=) " < "
+
+infix 2 assertGreaterThanEq as >=?

test/Main.purs

@@ -4,24 +4,34 @@ import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, log, logShow)
+import Control.Monad.Eff.Exception (try, EXCEPTION)
 import Control.Monad.Eff.Random (RANDOM)
-
 import Data.Array.Partial (head)
+import Data.Either (isLeft)
 import Data.Foldable (sum)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
-
 import Partial.Unsafe (unsafePartial)
-
+import Test.Assert (assert, ASSERT)
+import Test.QuickCheck (class Testable, quickCheck, (/=?), (<=?), (<?), (==?), (>=?), (>?))
 import Test.QuickCheck.Arbitrary (arbitrary, genericArbitrary, class Arbitrary)
 import Test.QuickCheck.Gen (Gen, vectorOf, randomSample')
 
 data Foo a = F0 a | F1 a a | F2 { foo :: a, bar :: Array a }
 derive instance genericFoo :: Generic (Foo a) _
 instance showFoo :: Show a => Show (Foo a) where show = genericShow
-instance arbitraryFoo :: Arbitrary a => Arbitrary (Foo a) where arbitrary = genericArbitrary 
+instance arbitraryFoo :: Arbitrary a => Arbitrary (Foo a) where arbitrary = genericArbitrary
+
 
-main :: Eff (console :: CONSOLE, random :: RANDOM) Unit
+quickCheckFail
+  :: forall t e
+   . Testable t
+  => t
+  -> Eff (assert :: ASSERT, console :: CONSOLE, random :: RANDOM | e) Unit
+quickCheckFail = assert <=< map isLeft <<< try <<< quickCheck
+
+
+main :: Eff (assert :: ASSERT, console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION) Unit
 main = do
   log "Try with some little Gens first"
   logShow =<< go 10
@@ -36,6 +46,26 @@ main = do
   log "Generating via Generic"
   logShow =<< randomSample' 10 (arbitrary :: Gen (Foo Int))
 
+  quickCheck \(x :: Int) -> x <? x + 1
+  quickCheck \(x :: Int) -> x <=? x + 1
+  quickCheck \(x :: Int) -> x >=? x - 1
+  quickCheck \(x :: Int) -> x >? x - 1
+  quickCheck \(x :: Int) -> x + x ==? x * 2
+  quickCheck \(x :: Int) -> x + x /=? x * 3
+
+  quickCheck     $ 1 ==? 1
+  quickCheckFail $ 1 /=? 1
+  quickCheck     $ 1 <?  2
+  quickCheckFail $ 1 >=? 2
+  quickCheck     $ 3 <=? 3
+  quickCheckFail $ 3 >?  3
+  quickCheck     $ 3 >=? 3
+  quickCheckFail $ 3 <?  3
+  quickCheck     $ 4 /=? 3
+  quickCheckFail $ 4 ==? 3
+  quickCheck     $ 4 >?  3
+  quickCheckFail $ 4 <=? 3
+
   where
   go n = map (sum <<< unsafeHead) $ randomSample' 1 (vectorOf n (arbitrary :: Gen Int))