Merge pull request #85 from safareli/resize

Fix resize

Author: garyb

package.json

@@ -7,8 +7,8 @@
   },
   "devDependencies": {
     "eslint": "^3.17.1",
-    "pulp": "^10.0.4",
-    "purescript-psa": "^0.5.0-rc.1",
+    "pulp": "^11.0.0",
+    "purescript-psa": "^0.5.1",
     "rimraf": "^2.6.1"
   }
 }

src/Test/QuickCheck/Gen.purs

@@ -37,7 +37,7 @@ import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Random (RANDOM)
 import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
 import Control.Monad.State (State, runState, evalState)
-import Control.Monad.State.Class (state, modify)
+import Control.Monad.State.Class (state, get, modify)
 import Control.Monad.Gen.Class (class MonadGen)
 import Control.Lazy (class Lazy)
 
@@ -83,7 +83,7 @@ instance monadGenGen :: MonadGen Gen where
   chooseInt = chooseInt
   chooseFloat = choose
   chooseBool = (_ < 0.5) <$> uniform
-  resize f g = stateful \state -> resize (f state.size) g
+  resize f g = sized \s -> resize (f s) g
   sized = sized
 
 -- | Exposes the underlying State implementation.
@@ -118,7 +118,7 @@ sized f = stateful (\s -> f s.size)
 
 -- | Modify a random generator by setting a new size parameter.
 resize :: forall a. Size -> Gen a -> Gen a
-resize sz g = Gen $ state \s -> runGen g s { size = sz }
+resize sz g = Gen $ fst <<< runGen g <<< (_ { size = sz }) <$> get
 
 -- | Create a random generator which samples a range of `Number`s i
 -- | with uniform probability.

test/Main.purs

@@ -6,16 +6,19 @@ 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 Control.Monad.Gen.Class as MGen
 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 Data.Tuple (fst)
 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')
+import Test.QuickCheck.Gen (Gen, vectorOf, randomSample', resize, Size, runGen, sized)
+import Test.QuickCheck.LCG (mkSeed)
 
 data Foo a = F0 a | F1 a a | F2 { foo :: a, bar :: Array a }
 derive instance genericFoo :: Generic (Foo a) _
@@ -31,8 +34,26 @@ quickCheckFail
 quickCheckFail = assert <=< map isLeft <<< try <<< quickCheck
 
 
+testResize :: (forall a. Size -> Gen a -> Gen a) -> Boolean
+testResize resize' =
+  let
+    initialSize = 2
+    gen = do
+      s1 <- sized pure
+      s2 <- resize' 1 (sized pure)
+      s3 <- sized pure
+      pure $ [ s1, s2, s3 ] == [ initialSize, 1, initialSize ]
+  in
+    fst $ runGen gen { newSeed: mkSeed 0, size: initialSize }
+
+
 main :: Eff (assert :: ASSERT, console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION) Unit
 main = do
+  log "MonadGen.resize"
+  assert (testResize (MGen.resize <<< const))
+  log "Gen.resize"
+  assert (testResize (resize))
+
   log "Try with some little Gens first"
   logShow =<< go 10
   logShow =<< go 100