Add a short-circuiting implementation of foldLeftM

free/src/main/scala/cats/free/Free.scala

@@ -208,11 +208,14 @@ object Free {
    * Perform a stack-safe monadic fold from the source context `F`
    * into the target monad `G`.
    *
-   * This method can express short-circuiting semantics, but like
-   * other left folds will traverse the entire `F[A]` structure. This
-   * means it is not suitable for potentially infinite structures.
+   * This method can express short-circuiting semantics. Even when
+   * `fa` is an infinite structure, this method can potentially
+   * terminate if the `foldRight` implementation for `F` and the
+   * `tailRecM` implementation for `G` are sufficiently lazy.
    */
   def foldLeftM[F[_], G[_]: MonadRec, A, B](fa: F[A], z: B)(f: (B, A) => G[B])(implicit F: Foldable[F]): G[B] =
-    F.foldM[Free[G, ?], A, B](fa, z) { (b, a) => Free.liftF(f(b, a)) }.runTailRec
+    unsafeFoldLeftM[F, Free[G, ?], A, B](fa, z) { (b, a) => Free.liftF(f(b, a)) }.runTailRec
 
+  private def unsafeFoldLeftM[F[_], G[_], A, B](fa: F[A], z: B)(f: (B, A) => G[B])(implicit F: Foldable[F], G: Monad[G]): G[B] =
+    F.foldRight[A, B => G[B]](fa, Always(G.pure(_)))((a, lb) => Always((w: B) => G.flatMap(f(w, a))(lb.value))).value(z)
 }

free/src/test/scala/cats/free/FreeTests.scala

@@ -91,6 +91,14 @@ class FreeTests extends CatsSuite {
     }
     assert(res == Xor.left(3))
   }
+
+  test(".foldLeftM short-circuiting") {
+    val ns = Stream.continually(1)
+    val res = Free.foldLeftM[Stream, Xor[Int, ?], Int, Int](ns, 0) { (sum, n) =>
+      if (sum >= 100000) Xor.left(sum) else Xor.right(sum + n)
+    }
+    assert(res == Xor.left(100000))
+  }
 }
 
 object FreeTests extends FreeTestsInstances {