Construct a lazy list of shrink values to avoid eager running

core/src/main/scala/hedgehog/core/Tree.scala

@@ -5,8 +5,12 @@ import hedgehog.predef._
 /**
  * NOTE: This differs from the Haskell version by not having an effect on the `Node` for performance reasons.
  * See `haskell-difference.md` for more information.
+ *
+ * FIXME The `LazyList` here is critical to avoid running extra tests during shrinking.
+ * The alternative might be something like:
+ * https://github.com/hedgehogqa/scala-hedgehog/compare/topic/issue-66-lazy-shrinking
  */
-case class Tree[M[_], A](value: A, children: M[List[Tree[M, A]]]) {
+case class Tree[M[_], A](value: A, children: M[LazyList[Tree[M, A]]]) {
 
   def map[B](f: A => B)(implicit F: Functor[M]): Tree[M, B] =
     Tree.TreeFunctor[M].map(this)(f)
@@ -20,7 +24,7 @@ case class Tree[M[_], A](value: A, children: M[List[Tree[M, A]]]) {
     )
 
   def prune(implicit F: Applicative[M]): Tree[M, A] =
-    Tree(this.value, F.point(List()))
+    Tree(this.value, F.point(LazyList()))
 }
 
 abstract class TreeImplicits1 {
@@ -37,7 +41,7 @@ abstract class TreeImplicits2 extends TreeImplicits1 {
   implicit def TreeApplicative[M[_]](implicit F: Monad[M]): Applicative[Tree[M, ?]] =
     new Applicative[Tree[M, ?]] {
       def point[A](a: => A): Tree[M, A] =
-        Tree(a, F.point(List()))
+        Tree(a, F.point(LazyList()))
       def ap[A, B](fa: => Tree[M, A])(f: => Tree[M, A => B]): Tree[M, B] =
         // FIX This isn't ideal, but if it's good enough for the Haskell implementation it's good enough for us
         // https://github.com/hedgehogqa/haskell-hedgehog/pull/173
@@ -67,7 +71,7 @@ object Tree extends TreeImplicits2 {
   def unfoldTree[M[_], A, B](f: B => A, g: B => List[B], x: B)(implicit F: Applicative[M]): Tree[M, A] =
     Tree(f(x), F.point(unfoldForest(f, g, x)))
 
-  def unfoldForest[M[_], A, B](f: B => A, g: B => List[B], x: B)(implicit F: Applicative[M]): List[Tree[M, A]] =
-    g(x).map(y => unfoldTree(f, g, y)(F))
+  def unfoldForest[M[_], A, B](f: B => A, g: B => List[B], x: B)(implicit F: Applicative[M]): LazyList[Tree[M, A]] =
+    LazyList.fromList(g(x).map(y => unfoldTree(f, g, y)(F)))
 }
 

core/src/main/scala/hedgehog/predef/LazyList.scala

@@ -0,0 +1,44 @@
+package hedgehog.predef
+
+/**
+ * A _very_ naive lazy-list where the element evaluation is lazy but the spine itself is strict.
+ * Unfortunately using Scala `Stream` results in the head being evaluated prematurely for shrinking.
+ */
+sealed trait LazyList[A] {
+
+  import LazyList._
+
+  def map[B](f: A => B): LazyList[B] =
+    this match {
+      case Nil() =>
+        nil
+      case Cons(h, t) =>
+        Cons(() => f(h()), t.map(f))
+    }
+
+  def ++(b: LazyList[A]): LazyList[A] =
+    this match {
+      case Nil() =>
+        b
+      case Cons(h, t) =>
+        Cons(h, t ++ b)
+    }
+}
+
+object LazyList {
+
+  case class Cons[A](head: () => A, tail: LazyList[A]) extends LazyList[A]
+  case class Nil[A]() extends LazyList[A]
+
+  def nil[A]: LazyList[A] =
+    Nil()
+
+  def cons[A](h: => A, t: LazyList[A]): LazyList[A] =
+    Cons(() => h, t)
+
+  def apply[A](l: A*): LazyList[A] =
+    fromList(l.toList)
+
+  def fromList[A](l: List[A]): LazyList[A] =
+    l.foldRight(nil[A])(cons(_, _))
+}

core/src/main/scala/hedgehog/predef/package.scala

@@ -16,12 +16,12 @@ package object predef {
   def some[A](a: A): Option[A] =
     Some(a)
 
-  def findMapM[M[_], A, B](fa: List[A])(f: A => M[Option[B]])(implicit F: Monad[M]): M[Option[B]] = {
+  def findMapM[M[_], A, B](fa: LazyList[A])(f: A => M[Option[B]])(implicit F: Monad[M]): M[Option[B]] = {
     fa match {
-      case Nil =>
+      case LazyList.Nil() =>
         F.point(None)
-      case h :: t =>
-        F.bind(f(h)) {
+      case LazyList.Cons(h, t) =>
+        F.bind(f(h())) {
           case Some(b) =>
             F.point(Some(b))
           case None =>

test/src/test/scala/hedgehog/ShrinkTest.scala

@@ -0,0 +1,43 @@
+package hedgehog
+
+import hedgehog.core._
+import hedgehog.runner._
+
+object ShrinkTest extends Properties {
+
+  def tests: List[Test] =
+    List(
+      example("test that shrinking only 'runs' the test once per shrink", testLazy)
+    )
+
+  // https://github.com/hedgehogqa/scala-hedgehog/issues/66
+  def testLazy: Result = {
+    // What's that, mutable state?!?
+    // We really want to observe how many times our test is _actually_ run, not just what hedgehog thinks it ran.
+    // In previous incarnations we were accidentally running the test for _each_ shrink,
+    // but only taking the first failed result. For any non-trivial test (ie IO test) this would basically make
+    // shrinking useless.
+    var failed = 0
+
+    val r = Property.check(PropertyConfig.default, for {
+      // NOTE: We're also generating lists-of-lists here at the same time
+      // If implemented too strictly the shrinking _will_ run out of memory
+      // https://github.com/hedgehogqa/scala-hedgehog/issues/62
+      x <- Gen.string(Gen.alpha, Range.linear(0, 100)).list(Range.linear(0, 100)).log("x")
+    } yield {
+      val b = x.length < 5
+      if (!b) {
+        failed = failed + 1
+      }
+      Result.assert(b)
+    }, Seed.fromTime()).value
+
+    r.status match {
+      case Failed(s, _) =>
+        // This count also includes the first failure case
+        ShrinkCount(failed - 1) ==== s
+      case _ =>
+        Result.failure.log("Test failed incorrectly")
+    }
+  }
+}