Future result

.gitignore

@@ -1,3 +1,4 @@
+.idea
 *.class
 dist/*
 target/

build.sbt

@@ -25,8 +25,8 @@ lazy val projectSettings = Seq(
     name := "hedgehog"
   , version in ThisBuild := "1.0.0"
   , organization := "qa.hedgehog"
-  , scalaVersion := "2.12.8"
-  , crossScalaVersions := Seq("2.10.7", "2.11.12", scalaVersion.value, "2.13.0")
+  , scalaVersion := "2.12.11"
+  , crossScalaVersions := Seq("2.10.7", "2.11.12", scalaVersion.value, "2.13.1")
   , fork in run  := true
   , homepage := Some(url("https://hedgehog.qa"))
   , scmInfo := Some(
@@ -112,7 +112,13 @@ lazy val compilationSettings = Seq(
         }
       }
     }
-  , libraryDependencies += compilerPlugin("org.typelevel" %% "kind-projector" % "0.10.3" cross CrossVersion.binary)
+  , libraryDependencies += compilerPlugin("org.typelevel" % "kind-projector" % "0.11.0" cross CrossVersion.full)
+  , libraryDependencies ++= (scalaBinaryVersion.value match {
+      case "2.10" =>
+        compilerPlugin("org.scalamacros" % "paradise" % "2.1.0" cross CrossVersion.full) :: Nil
+      case _ =>
+        Nil
+    })
   )
 
 lazy val testingSettings = Seq(

core/src/main/scala/hedgehog/Property.scala

@@ -1,6 +1,7 @@
 package hedgehog
 
 import hedgehog.core._
+import hedgehog.predef.Monad
 
 trait PropertyTOps extends PropertyTReporting {
 
@@ -37,6 +38,9 @@ trait PropertyTOps extends PropertyTReporting {
   def check(config: PropertyConfig, p: PropertyT[Result], seed: Seed): Report =
     propertyT.report(config, None, seed, p)
 
+  def checkF[F[_]: Monad](config: PropertyConfig, p: PropertyT[F[Result]], seed: Seed): F[Report] =
+    propertyT.reportF(config, None, seed, p)
+
   def checkRandom(config: PropertyConfig, p: PropertyT[Result]): Report =
     // FIX: predef MonadIO
     check(config, p, Seed.fromTime())

core/src/main/scala/hedgehog/core/GenT.scala

@@ -143,6 +143,7 @@ abstract class GenImplicits2 extends GenImplicits1 {
       override def ap[A, B](fa: => GenT[A])(f: => GenT[A => B]): GenT[B] =
         GenT((size, seed) => {
           val f2 = f.run(size, seed)
+          // FIXME: This is not stack safe.
           val fa2 = fa.run(size, f2.value._1)
           Applicative.zip(fa2, f2).map { case ((seed2, oa), (_, o)) =>
             (seed2, o.flatMap(y => oa.map(y(_))))
@@ -167,5 +168,12 @@ object GenT extends GenImplicits2 {
 
       override def bind[A, B](fa: GenT[A])(f: A => GenT[B]): GenT[B] =
         fa.flatMap(f)
+
+      // FIXME: This is not stack safe.
+      override def tailRecM[A, B](a: A)(f: A => GenT[Either[A, B]]): GenT[B] =
+        bind(f(a)) {
+          case Left(value) => tailRecM(value)(f)
+          case Right(value) => point(value)
+        }
     }
 }

core/src/main/scala/hedgehog/core/PropertyT.scala

@@ -3,6 +3,8 @@ package hedgehog.core
 import hedgehog._
 import hedgehog.predef._
 
+import scala.language.higherKinds
+
 case class Name(value: String)
 
 object Name {
@@ -13,8 +15,11 @@ object Name {
 }
 
 sealed trait Log
+
 case class ForAll(name: Name, value: String) extends Log
+
 case class Info(value: String) extends Log
+
 case class Error(value: Exception) extends Log
 
 object Log {
@@ -25,9 +30,9 @@ object Log {
 
 /** A record containing the details of a test run. */
 case class Journal(
-    logs: List[Log]
-  , coverage: Coverage[Cover]
-  ) {
+                    logs: List[Log]
+                    , coverage: Coverage[Cover]
+                  ) {
 
   def ++(o: Journal): Journal =
     Journal(logs ++ o.logs, Coverage.union(coverage, o.coverage)(_ ++ _))
@@ -43,10 +48,10 @@ object Journal {
 }
 
 case class PropertyConfig(
-    testLimit: SuccessCount
-  , discardLimit: DiscardCount
-  , shrinkLimit: ShrinkLimit
-  )
+                           testLimit: SuccessCount
+                           , discardLimit: DiscardCount
+                           , shrinkLimit: ShrinkLimit
+                         )
 
 object PropertyConfig {
 
@@ -55,8 +60,8 @@ object PropertyConfig {
 }
 
 case class PropertyT[A](
-    run: GenT[(Journal, Option[A])]
-  ) {
+                         run: GenT[(Journal, Option[A])]
+                       ) {
 
   def map[B](f: A => B): PropertyT[B] =
     copy(run = run.map(x =>
@@ -73,7 +78,7 @@ case class PropertyT[A](
   def flatMap[B](f: A => PropertyT[B]): PropertyT[B] =
     copy(run = run.flatMap(x =>
       x._2.fold(
-       GenT.GenApplicative.point((x._1, Option.empty[B]))
+        GenT.GenApplicative.point((x._1, Option.empty[B]))
       )(a =>
         try {
           f(a).run.map(y => (x._1 ++ y._1, y._2))
@@ -118,73 +123,108 @@ object PropertyT {
     new Monad[PropertyT] {
       override def map[A, B](fa: PropertyT[A])(f: A => B): PropertyT[B] =
         fa.map(f)
+
       override def point[A](a: => A): PropertyT[A] =
         propertyT.hoist((Journal.empty, a))
+
       override def ap[A, B](fa: => PropertyT[A])(f: => PropertyT[A => B]): PropertyT[B] =
         PropertyT(Applicative.zip(fa.run, f.run)
           .map { case ((l1, oa), (l2, oab)) => (l2 ++ l1, oab.flatMap(y => oa.map(y(_)))) }
         )
+
       override def bind[A, B](fa: PropertyT[A])(f: A => PropertyT[B]): PropertyT[B] =
         fa.flatMap(f)
+
+      // FIXME: This is not stack safe.
+      override def tailRecM[A, B](a: A)(f: A => PropertyT[Either[A, B]]): PropertyT[B] =
+        bind(f(a)) {
+          case Left(value) => tailRecM(value)(f)
+          case Right(value) => point(value)
+        }
     }
 }
 
 trait PropertyTReporting {
 
-  @annotation.tailrec
-  final def takeSmallest(n: ShrinkCount, slimit: ShrinkLimit, t: Tree[Option[(List[Log], Option[Result])]]): Status =
-    t.value match {
-      case None =>
-        Status.gaveUp
+  final def takeSmallest(n: ShrinkCount, slimit: ShrinkLimit, t: Tree[Option[(List[Log], Option[Result])]]): Status = {
+    // TODO: Can we cast this instead?
+    val t2 = t.map(_.map { case (l, r) => (l, r.map[Id[Result]](identity)) })
+    takeSmallestF(n, slimit, t2)
+  }
 
-      case Some((w, r)) =>
+  final def takeSmallestF[F[_]](n: ShrinkCount, slimit: ShrinkLimit, t: Tree[Option[(List[Log], Option[F[Result]])]])(implicit M: Monad[F]): F[Status] = {
+    type TreeF = Tree[Option[(List[Log], Option[F[Result]])]]
+    type Arguments = (ShrinkCount, ShrinkLimit, TreeF)
+    val zero: Arguments = (n, slimit, t)
+    M.tailRecM(zero) { case (n, slimit, t) =>
+      def smallestChild(w: List[Log], r: Option[Result]): F[Either[Arguments, Status]] = {
         if (r.forall(!_.success)) {
           if (n.value >= slimit.value) {
-            Status.failed(n, w ++ r.map(_.logs).getOrElse(Nil))
+            M.point(Right(Status.failed(n, w ++ r.map(_.logs).getOrElse(Nil))))
           } else {
-            findMap(t.children.value)(m =>
+            val x: F[Option[TreeF]] = findMapF(t.children.value) { m =>
               m.value match {
                 case Some((_, None)) =>
-                  some(m)
-                case Some((_, Some(r2))) =>
+                  M.point(some(m))
+                case Some((_, Some(f2))) => M.map(f2) { r2 =>
                   if (!r2.success)
                     some(m)
                   else
                     Option.empty
+                }
                 case None =>
-                  Option.empty
+                  M.point(Option.empty)
               }
-            ) match {
+            }
+            M.map(x) {
               case Some(m) =>
-                takeSmallest(n.inc, slimit, m)
+                Left((n.inc, slimit, m))
               case None =>
-                Status.failed(n, w ++ r.map(_.logs).getOrElse(Nil))
+                Right(Status.failed(n, w ++ r.map(_.logs).getOrElse(Nil)))
             }
           }
         } else {
-          Status.ok
+          M.point(Right(Status.ok))
         }
+      }
+
+      t.value match {
+        case None =>
+          M.point(Right(Status.gaveUp))
+        case Some((w, Some(f))) =>
+          M.bind(f) { r =>
+            smallestChild(w, Some(r))
+          }
+        case Some((w, None)) =>
+          smallestChild(w, None)
+      }
     }
+  }
 
-  def report(config: PropertyConfig, size0: Option[Size], seed0: Seed, p: PropertyT[Result]): Report = {
+  def report(config: PropertyConfig, size0: Option[Size], seed0: Seed, p: PropertyT[Result]): Report =
+  // TODO: Can we cast this instead?
+    reportF(config, size0, seed0, p.map(identity[Id[Result]]))
+
+  def reportF[F[_]](config: PropertyConfig, size0: Option[Size], seed0: Seed, p: PropertyT[F[Result]])(implicit M: Monad[F]): F[Report] = {
     // Increase the size proportionally to the number of tests to ensure better coverage of the desired range
     val sizeInc = Size(Math.max(1, Size.max / config.testLimit.value))
     // Start the size at whatever remainder we have to ensure we run with "max" at least once
     val sizeInit = Size(Size.max % Math.min(config.testLimit.value, Size.max)).incBy(sizeInc)
-    @annotation.tailrec
-    def loop(successes: SuccessCount, discards: DiscardCount, size: Size, seed: Seed, coverage: Coverage[CoverCount]): Report =
+    type Arguments = (SuccessCount, DiscardCount, Size, Seed, Coverage[CoverCount])
+    val zero: Arguments = (SuccessCount(0), DiscardCount(0), size0.getOrElse(sizeInit), seed0, Coverage.empty)
+    M.tailRecM(zero) { case (successes, discards, size, seed, coverage) =>
       if (size.value > Size.max)
-        loop(successes, discards, sizeInit, seed, coverage)
+        M.point(Left((successes, discards, sizeInit, seed, coverage)))
       else if (successes.value >= config.testLimit.value)
-        // we've hit the test limit
-        Coverage.split(coverage, successes) match {
-          case (_, Nil) =>
-            Report(successes, discards, coverage, OK)
-          case _ =>
-            Report(successes, discards, coverage, Status.failed(ShrinkCount(0), List("Insufficient coverage.")))
-        }
+      // we've hit the test limit
+      Coverage.split(coverage, successes) match {
+        case (_, Nil) =>
+          M.point(Right(Report(successes, discards, coverage, OK)))
+        case _ =>
+          M.point(Right(Report(successes, discards, coverage, Status.failed(ShrinkCount(0), List("Insufficient coverage.")))))
+      }
       else if (discards.value >= config.discardLimit.value)
-        Report(successes, discards, coverage, GaveUp)
+        M.point(Right(Report(successes, discards, coverage, GaveUp)))
       else {
         val x =
           try {
@@ -193,30 +233,40 @@ trait PropertyTReporting {
             case e: Exception =>
               Property.error(e).run.run(size, seed)
           }
-        val t = x.map(_._2.map { case (l, r) => (l.logs, r) })
+
+        def reportSmallest: F[Either[Arguments, Report]] = {
+          val t = x.map(_._2.map { case (l, r) => (l.logs, r) })
+          val smallestF = takeSmallestF(ShrinkCount(0), config.shrinkLimit, t)
+          M.map(smallestF) { smallest =>
+            Right(Report(successes, discards, coverage, smallest))
+          }
+        }
+
         x.value._2 match {
           case None =>
-            loop(successes, discards.inc, size.incBy(sizeInc), x.value._1, coverage)
-
+            M.point(Left((successes, discards.inc, size.incBy(sizeInc), x.value._1, coverage)))
           case Some((_, None)) =>
-            Report(successes, discards, coverage, takeSmallest(ShrinkCount(0), config.shrinkLimit, t))
-
-          case Some((j, Some(r))) =>
-            if (!r.success){
-              Report(successes, discards, coverage, takeSmallest(ShrinkCount(0), config.shrinkLimit, t))
+            reportSmallest
+          case Some((j, Some(f))) => M.bind(f) { r =>
+            if (!r.success) {
+              reportSmallest
             } else
-              loop(successes.inc, discards, size.incBy(sizeInc), x.value._1,
-                Coverage.union(Coverage.count(j.coverage), coverage)(_ + _))
+              M.point(Left((successes.inc, discards, size.incBy(sizeInc), x.value._1,
+                Coverage.union(Coverage.count(j.coverage), coverage)(_ + _))))
+          }
         }
       }
-    loop(SuccessCount(0), DiscardCount(0), size0.getOrElse(sizeInit), seed0, Coverage.empty)
+    }
   }
 
   def recheck(config: PropertyConfig, size: Size, seed: Seed)(p: PropertyT[Result]): Report =
     report(config.copy(testLimit = SuccessCount(1)), Some(size), seed, p)
+
+  def recheckF[F[_] : Monad](config: PropertyConfig, size: Size, seed: Seed)(p: PropertyT[F[Result]]): F[Report] =
+    reportF(config.copy(testLimit = SuccessCount(1)), Some(size), seed, p)
 }
 
-/**********************************************************************/
+/** ********************************************************************/
 // Reporting
 
 /** The numbers of times a property was able to shrink after a failing test. */
@@ -256,8 +306,11 @@ case class DiscardCount(value: Int) {
  * number of shrinks, and the execution log.
  */
 sealed trait Status
+
 case class Failed(shrinks: ShrinkCount, log: List[Log]) extends Status
+
 case object GaveUp extends Status
+
 case object OK extends Status
 
 object Status {

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

@@ -69,6 +69,12 @@ object Tree extends TreeImplicits2 {
           y.value, fa.children.flatMap(x => y.children.map(ys => x.map(_.flatMap(f)) ++ ys))
         )
       }
+      // FIXME: This is not stack safe.
+      override def tailRecM[A, B](a: A)(f: A => Tree[Either[A, B]]): Tree[B] =
+        bind(f(a)) {
+          case Left(value) => tailRecM(value)(f)
+          case Right(value) => point(value)
+        }
     }
 
   def unfoldTree[A, B](f: B => A, g: B => List[B], x: B): Tree[A] =

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

@@ -40,5 +40,12 @@ object Identity {
 
       override def bind[A, B](fa: Identity[A])(f: A => Identity[B]): Identity[B] =
         Identity(f(fa.value).value)
+
+      // FIXME: This is not stack safe.
+      override def tailRecM[A, B](a: A)(f: A => Identity[Either[A, B]]): Identity[B] =
+        bind(f(a)) {
+          case Left(value) => tailRecM(value)(f)
+          case Right(value) => point(value)
+        }
     }
 }

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

@@ -59,6 +59,13 @@ object StateT extends StateTImplicits2 {
 
       override def bind[A, B](fa: StateT[M, S, A])(f: A => StateT[M, S, B]): StateT[M, S, B] =
         fa.flatMap(f)
+
+      // FIXME: This is not stack safe.
+      override def tailRecM[A, B](a: A)(f: A => StateT[M, S, Either[A, B]]): StateT[M, S, B] =
+        bind(f(a)) {
+          case Left(value) => tailRecM(value)(f)
+          case Right(value) => point(value)
+        }
     }
 
 }