PageRenderTime 63ms CodeModel.GetById 2ms app.highlight 51ms RepoModel.GetById 1ms app.codeStats 0ms

/core/src/main/scala/scalaz/Free.scala

http://github.com/scalaz/scalaz
Scala | 530 lines | 360 code | 84 blank | 86 comment | 0 complexity | c80122a8595f25b3958a4b855414c66b MD5 | raw file
  1package scalaz
  2
  3import annotation.tailrec
  4import Free._
  5// See explanation in comments on function1CovariantByName
  6import std.function.{function1Covariant => _, function1CovariantByName, _}
  7import std.tuple._
  8
  9object Free extends FreeInstances {
 10
 11  /** Collapse a trampoline to a single step. */
 12  def reset[A](r: Trampoline[A]): Trampoline[A] = { val a = r.run; return_(a) }
 13
 14  /** Suspend the given computation in a single step. */
 15  def return_[S[_], A](value: => A)(implicit S: Applicative[S]): Free[S, A] =
 16    liftF[S, A](S.point(value))
 17
 18  /** Alias for `point` */
 19  def pure[S[_], A](value: A): Free[S, A] = point(value)
 20
 21  /** Absorb a step into the free monad. */
 22  def roll[S[_], A](value: S[Free[S, A]]): Free[S, A] =
 23    liftF(value).flatMap(x => x)
 24
 25  private[this] val pointUnitCache: Free[Id.Id, Unit] = point[Id.Id, Unit](())
 26
 27  // Cache `point(())` to avoid frequent allocation
 28  @inline private def pointUnit[S[_]]: Free[S, Unit] = pointUnitCache.asInstanceOf[Free[S, Unit]]
 29
 30  /** Suspend a computation in a pure step of the applicative functor `S` */
 31  def suspend[S[_], A](value: => Free[S, A]): Free[S, A] =
 32    pointUnit.flatMap(_ => value)
 33
 34  /** A version of `liftF` that infers the nested type constructor. */
 35  def liftFU[MA](value: => MA)(implicit MA: Unapply[Functor, MA]): Free[MA.M, MA.A] =
 36    liftF(MA(value))
 37
 38  /** Monadic join for the higher-order monad `Free` */
 39  def joinF[S[_], A](value: Free[Free[S, *], A]): Free[S, A] =
 40    value.flatMapSuspension(NaturalTransformation.refl[Free[S, *]])
 41
 42  /** A trampoline step that doesn't do anything. */
 43  def pause: Trampoline[Unit] =
 44    return_(())
 45
 46  /** A source that produces the given value. */
 47  def produce[A](a: A): Source[A, Unit] =
 48    liftF[(A, *), Unit]((a, ()))
 49
 50  /** A sink that waits for a single value and returns it. */
 51  def await[A]: Sink[A, A] = liftF[(=> A) => *, A](a => a)
 52
 53  /** Absorb a step in `S` into the free monad for `S` */
 54  def apply[S[_], A](s: S[Free[S, A]]): Free[S, A] =
 55    roll(s)
 56
 57  /** Return from the computation with the given value. */
 58  private case class Return[S[_], A](a: A) extends Free[S, A]
 59
 60  /** Suspend the computation with the given suspension. */
 61  private case class Suspend[S[_], A](a: S[A]) extends Free[S, A]
 62
 63  /** Call a subroutine and continue with the given function. */
 64  private case class Gosub[S[_], A0, B](a0: Free[S, A0], f0: A0 => Free[S, B]) extends Free[S, B] {
 65    type A = A0
 66    def a: Free[S, A] = a0
 67    def f: A => Free[S, B] = f0
 68  }
 69
 70  /** A computation that can be stepped through, suspended, and paused
 71    *
 72    * @template
 73    */
 74  type Trampoline[A] = Free[Function0, A]
 75
 76  /** A computation that produces values of type `A`, eventually resulting in a value of type `B`.
 77    *
 78    * @template
 79    */
 80  type Source[A, B] = Free[(A, *), B]
 81
 82  /** A computation that accepts values of type `A`, eventually resulting in a value of type `B`.
 83    * Note the similarity to an [[scalaz.iteratee.Iteratee]].
 84    *
 85    * @template
 86    */
 87  type Sink[A, B] = Free[(=> A) => *, B]
 88
 89  /** Suspends a value within a functor in a single step. Monadic unit for a higher-order monad. */
 90  def liftF[S[_], A](value: S[A]): Free[S, A] =
 91    Suspend(value)
 92
 93  /** Return the given value in the free monad. */
 94  def point[S[_], A](value: A): Free[S, A] = Return[S, A](value)
 95
 96}
 97
 98/**
 99 * A free monad for a type constructor `S`.
100 * Binding is done using the heap instead of the stack, allowing tail-call elimination.
101 */
102sealed abstract class Free[S[_], A] {
103  final def map[B](f: A => B): Free[S, B] =
104    flatMap(a => Return(f(a)))
105
106  /** Alias for `flatMap` */
107  final def >>=[B](f: A => Free[S, B]): Free[S, B] = this flatMap f
108
109  /** Binds the given continuation to the result of this computation. */
110  final def flatMap[B](f: A => Free[S, B]): Free[S, B] = Gosub(this, f)
111
112  /** Catamorphism. Run the first given function if Return, otherwise, the second given function. */
113  final def fold[B](r: A => B, s: S[Free[S, A]] => B)(implicit S: Functor[S]): B =
114    resume.fold(s, r)
115
116  /** Evaluates a single layer of the free monad **/
117  final def resume(implicit S: Functor[S]): (S[Free[S,A]] \/ A) =
118    resumeC.leftMap(_.run)
119
120  /** Evaluates a single layer of the free monad **/
121  @tailrec final def resumeC: (Coyoneda[S, Free[S,A]] \/ A) =
122    this match {
123      case Return(a) => \/-(a)
124      case Suspend(t) => -\/(Coyoneda(t)(Return(_)))
125      case b @ Gosub(_, _) => b.a match {
126        case Return(a) => b.f(a).resumeC
127        case Suspend(t) => -\/(Coyoneda(t)(b.f))
128        case c @ Gosub(_, _) => c.a.flatMap(z => c.f(z).flatMap(b.f)).resumeC
129      }
130    }
131
132  /** Changes the suspension functor by the given natural transformation. */
133  final def mapSuspension[T[_]](f: S ~> T): Free[T, A] =
134    flatMapSuspension(λ[S ~> Free[T,*]](s => Suspend(f(s))))
135
136  /** Modifies the first suspension with the given natural transformation. */
137  final def mapFirstSuspension(f: S ~> S): Free[S, A] =
138    step match {
139      case Suspend(s) => Suspend(f(s))
140      case a@Gosub(_, _) => a.a match {
141        case Suspend(s) => Suspend(f(s)).flatMap(a.f)
142        case _ => a.a.mapFirstSuspension(f).flatMap(a.f)
143      }
144      case x => x
145    }
146
147  /**
148   * Substitutes a free monad over the given functor into the suspension functor of this program.
149   * `Free` is a monad in an endofunctor category and this is its monadic bind.
150   */
151  final def flatMapSuspension[T[_]](f: S ~> Free[T, *]): Free[T, A] =
152    foldMap[Free[T,*]](f)(freeMonad[T])
153
154  /** Applies a function `f` to a value in this monad and a corresponding value in the dual comonad, annihilating both. */
155  final def zapWith[G[_], B, C](bs: Cofree[G, B])(f: (A, B) => C)(implicit d: Zap[S, G]): C =
156    Zap.monadComonadZap.zapWith(this, bs)(f)
157
158  /** Applies a function in a comonad to the corresponding value in this monad, annihilating both. */
159  final def zap[G[_], B](fs: Cofree[G, A => B])(implicit d: Zap[S, G]): B =
160    zapWith(fs)((a, f) => f(a))
161
162  /** Runs a single step, using a function that extracts the resumption from its suspension functor. */
163  final def bounce(f: S[Free[S, A]] => Free[S, A])(implicit S: Functor[S]): Free[S, A] = resume match {
164    case -\/(s) => f(s)
165    case \/-(r) => Return(r)
166  }
167
168  /** Runs to completion, using a function that extracts the resumption from its suspension functor. */
169  final def go(f: S[Free[S, A]] => Free[S, A])(implicit S: Functor[S]): A = {
170    @tailrec def go2(t: Free[S, A]): A = t.resume match {
171      case -\/(s) => go2(f(s))
172      case \/-(r) => r
173    }
174    go2(this)
175  }
176
177  /**
178   * Runs to completion, using a function that maps the resumption from `S` to a monad `M`.
179   * @since 7.0.1
180   */
181  final def runM[M[_]](f: S[Free[S, A]] => M[Free[S, A]])(implicit S: Functor[S], M: Monad[M]): M[A] = {
182    def runM2(t: Free[S, A]): M[A] = t.resume match {
183      case -\/(s) => Monad[M].bind(f(s))(runM2)
184      case \/-(r) => Monad[M].pure(r)
185    }
186    runM2(this)
187  }
188
189  /**
190    * Run Free using constant stack.
191    */
192  final def runRecM[M[_]](f: S[Free[S, A]] => M[Free[S, A]])(implicit S: Functor[S], M: Applicative[M], B: BindRec[M]): M[A] = {
193    B.tailrecM(this)(_.resume match {
194      case -\/(sf) => M.map(f(sf))(\/.left)
195      case a @ \/-(_) => M.point(a.coerceLeft)
196    })
197  }
198
199  /**
200   * Evaluate one layer in the free monad, re-associating any left-nested binds to the right
201   * and pulling the first suspension to the top.
202   */
203  @tailrec final def step: Free[S, A] = this match {
204    case x@Gosub(_, _) => x.a match {
205      case b@Gosub(_, _) =>
206        b.a.flatMap(a => b.f(a).flatMap(x.f)).step
207      case Return(b)=>
208        x.f(b).step
209      case _ =>
210        x
211    }
212    case x => x
213  }
214
215  /**
216   * Re-associate any left-nested binds to the right, pull the first suspension to the top
217   * and then pass the result to one of the callbacks.
218   */
219  @tailrec private[scalaz] final def foldStep[B](
220    onReturn: A => B,
221    onSuspend: S[A] => B,
222    onGosub: ((S[X], X => Free[S, A]) forSome { type X }) => B
223  ): B = this match {
224    case Gosub(fz, f) => fz match {
225      case Gosub(fy, g) => fy.flatMap(y => g(y).flatMap(f)).foldStep(onReturn, onSuspend, onGosub)
226      case Suspend(sz) => onGosub((sz, f))
227      case Return(z) => f(z).foldStep(onReturn, onSuspend, onGosub)
228    }
229    case Suspend(sa) => onSuspend(sa)
230    case Return(a) => onReturn(a)
231  }
232
233  /**
234   * Catamorphism for `Free`.
235   * Runs to completion, mapping the suspension with the given transformation at each step and
236   * accumulating into the monad `M`.
237   */
238  final def foldMap[M[_]](f: S ~> M)(implicit M: Monad[M]): M[A] =
239    step match {
240      case Return(a) => M.pure(a)
241      case Suspend(s) => f(s)
242      // This is stack safe because `step` ensures right-associativity of Gosub
243      case a@Gosub(_, _) => M.bind(a.a foldMap f)(c => a.f(c) foldMap f)
244    }
245
246  final def foldMapRec[M[_]](f: S ~> M)(implicit M: Applicative[M], B: BindRec[M]): M[A] =
247    B.tailrecM(this){
248      _.step match {
249        case Return(a) => M.point(\/-(a))
250        case Suspend(t) => M.map(f(t))(\/.right)
251        case b @ Gosub(_, _) => (b.a: @unchecked) match {
252          case Suspend(t) => M.map(f(t))(a => -\/(b.f(a)))
253        }
254      }
255    }
256
257  import Id._
258
259  /**
260   * Folds this free recursion to the right using the given natural transformations.
261   */
262  final def foldRight[G[_]](z: Id ~> G)(f: λ[α => S[G[α]]] ~> G)(implicit S: Functor[S]): G[A] =
263    this.resume match {
264      case -\/(s) => f(S.map(s)(_.foldRight(z)(f)))
265      case \/-(r) => z(r)
266    }
267
268  /** Runs to completion, allowing the resumption function to thread an arbitrary state of type `B`. */
269  @tailrec final def foldRun[B](b: B)(f: λ[α => (B, S[α])] ~> (B, *)): (B, A) =
270    step match {
271      case Return(a) => (b, a)
272      case Suspend(sa) => f((b, sa))
273      case g @ Gosub(_, _) => g.a match {
274        case Suspend(sz) =>
275          val (b1, z) = f((b, sz))
276          g.f(z).foldRun(b1)(f)
277        case _ => sys.error("Unreachable code: `Gosub` returned from `step` must have `Suspend` on the left")
278      }
279    }
280
281  /** Variant of `foldRun` that allows to interleave effect `M` at each step. */
282  final def foldRunM[M[_], B](b: B)(f: λ[α => (B, S[α])] ~> λ[α => M[(B, α)]])(implicit M0: Applicative[M], M1: BindRec[M]): M[(B, A)] =
283    M1.tailrecM((b, this)) { case (b, fa) =>
284      fa.step match {
285        case Return(a) => M0.point(\/-((b, a)))
286        case Suspend(sa) => M0.map(f((b, sa)))(\/.right)
287        case g @ Gosub(_, _) => g.a match {
288          case Suspend(sz) =>
289            M0.map(f((b, sz))) { case (b, z) => -\/((b, g.f(z))) }
290          case _ => sys.error("Unreachable code: `Gosub` returned from `step` must have `Suspend` on the left")
291        }
292      }
293    }
294
295  /** Runs a trampoline all the way to the end, tail-recursively. */
296  final def run(implicit ev: Free[S, A] === Trampoline[A]): A =
297    ev(this).go(_())
298
299  /** Interleave this computation with another, combining the results with the given function. */
300  final def zipWith[B, C](tb: Free[S, B])(f: (A, B) => C): Free[S, C] = {
301    (step, tb.step) match {
302      case (Return(a), Return(b)) => Return(f(a, b))
303      case (a@Suspend(_), Return(b)) => a.flatMap(x => Return(f(x, b)))
304      case (Return(a), b@Suspend(_)) => b.flatMap(x => Return(f(a, x)))
305      case (a@Suspend(_), b@Suspend(_)) => a.flatMap(x => b.map(y => f(x, y)))
306      case (a@Gosub(_, _), Return(b)) => a.a.flatMap(x => a.f(x).map(f(_, b)))
307      case (a@Gosub(_, _), b@Suspend(_)) => a.a.flatMap(x => b.flatMap(y => a.f(x).map(f(_, y))))
308      case (a@Gosub(_, _), b@Gosub(_, _)) => a.a.zipWith(b.a)((x, y) => a.f(x).zipWith(b.f(y))(f)).flatMap(x => x)
309      case (a, b@Gosub(_, _)) => a.flatMap(x => b.a.flatMap(y => b.f(y).map(f(x, _))))
310    }
311  }
312
313  /** Runs a `Source` all the way to the end, tail-recursively, collecting the produced values. */
314  def collect[B](implicit ev: Free[S, A] === Source[B, A]): (Vector[B], A) = {
315    @tailrec def go(c: Source[B, A], v: Vector[B] = Vector()): (Vector[B], A) =
316      c.resume match {
317        case -\/((b, cont)) => go(cont, v :+ b)
318        case \/-(r)         => (v, r)
319      }
320    go(ev(this))
321  }
322
323  /** Drive this `Source` with the given Sink. */
324  def drive[E, B](sink: Sink[Option[E], B])(implicit ev: Free[S, A] === Source[E, A]): (A, B) = {
325    @tailrec def go(src: Source[E, A], snk: Sink[Option[E], B]): (A, B) =
326      (src.resume, snk.resume) match {
327        case (-\/((e, c)), -\/(f)) => go(c, f(Some(e)))
328        case (-\/((e, c)), \/-(y)) => go(c, Monad[Sink[Option[E], *]].pure(y))
329        case (\/-(x), -\/(f))      => go(Monad[Source[E, *]].pure(x), f(None))
330        case (\/-(x), \/-(y))      => (x, y)
331      }
332    go(ev(this), sink)
333  }
334
335  /** Feed the given stream to this `Source`. */
336  def feed[E](ss: Stream[E])(implicit ev: Free[S, A] === Sink[E, A]): A = {
337    @tailrec def go(snk: Sink[E, A], rest: Stream[E]): A = (rest, snk.resume) match {
338      case (x #:: xs, -\/(f)) => go(f(x), xs)
339      case (Stream(), -\/(f)) => go(f(sys.error("No more values.")), Stream())
340      case (_, \/-(r))        => r
341    }
342    go(ev(this), ss)
343  }
344
345  /** Feed the given source to this `Sink`. */
346  def drain[E, B](source: Source[E, B])(implicit ev: Free[S, A] === Sink[E, A]): (A, B) = {
347    @tailrec def go(src: Source[E, B], snk: Sink[E, A]): (A, B) = (src.resume, snk.resume) match {
348      case (-\/((e, c)), -\/(f)) => go(c, f(e))
349      case (-\/((e, c)), \/-(y)) => go(c, Monad[Sink[E, *]].pure(y))
350      case (\/-(x), -\/(f))      => sys.error("Not enough values in source.")
351      case (\/-(x), \/-(y))      => (y, x)
352    }
353    go(source, ev(this))
354  }
355
356  /** Duplication in `Free` as a comonad in the endofunctor category. */
357  def duplicateF: Free[Free[S, *], A] = extendF[Free[S,*]](NaturalTransformation.refl[Free[S,*]])
358
359  /** Extension in `Free` as a comonad in the endofunctor category. */
360  def extendF[T[_]](f: Free[S, *] ~> T): Free[T, A] = mapSuspension(λ[S ~> T](x => f(liftF(x))))
361
362  /** Extraction from `Free` as a comonad in the endofunctor category. */
363  def extractF(implicit S: Monad[S]): S[A] = foldMap(NaturalTransformation.refl[S])
364
365  def toFreeT: FreeT[S, Id, A] =
366    this match {
367      case Return(a) =>
368        FreeT.point(a)
369      case Suspend(a) =>
370        FreeT.liftF(a)
371      case a @ Gosub(_, _) =>
372        a.a.toFreeT.flatMap(a.f.andThen(_.toFreeT))
373    }
374}
375
376object Trampoline {
377
378  def done[A](a: A): Trampoline[A] =
379    Free.pure[Function0,A](a)
380
381  def delay[A](a: => A): Trampoline[A] =
382    suspend(done(a))
383
384  def suspend[A](a: => Trampoline[A]): Trampoline[A] =
385    Free.suspend(a)
386}
387
388sealed abstract class FreeInstances4 {
389  implicit val trampolineInstance: Comonad[Trampoline] =
390    new Comonad[Trampoline] {
391      override def map[A, B](fa: Trampoline[A])(f: A => B) = fa map f
392      def copoint[A](fa: Trampoline[A]) = fa.run
393      def cobind[A, B](fa: Trampoline[A])(f: Trampoline[A] => B) = return_(f(fa))
394      override def cojoin[A](fa: Trampoline[A]) = Free.point(fa)
395    }
396}
397
398sealed abstract class FreeInstances3 extends FreeInstances4 {
399  implicit def freeFoldable[F[_]: Foldable]: Foldable[Free[F, *]] =
400    new FreeFoldable[F] {
401      def F = implicitly
402    }
403}
404
405sealed abstract class FreeInstances2 extends FreeInstances3 {
406  implicit def freeFoldable1[F[_]: Foldable1]: Foldable1[Free[F, *]] =
407    new FreeFoldable1[F] {
408      def F = implicitly
409    }
410}
411
412sealed abstract class FreeInstances1 extends FreeInstances2 {
413  implicit def freeTraverse[F[_]: Traverse]: Traverse[Free[F, *]] =
414    new FreeTraverse[F] {
415      def F = implicitly
416    }
417}
418
419sealed abstract class FreeInstances0 extends FreeInstances1 {
420  implicit def freeTraverse1[F[_]: Traverse1]: Traverse1[Free[F, *]] =
421    new FreeTraverse1[F] {
422      def F = implicitly
423    }
424
425  implicit def freeSemigroup[S[_], A: Semigroup]: Semigroup[Free[S, A]] =
426    Semigroup.liftSemigroup[Free[S, *], A]
427}
428
429sealed abstract class FreeInstances extends FreeInstances0 {
430  implicit def freeMonad[S[_]]: Monad[Free[S, *]] with BindRec[Free[S, *]] =
431    new Monad[Free[S, *]] with BindRec[Free[S, *]] {
432      override def map[A, B](fa: Free[S, A])(f: A => B) = fa map f
433      def bind[A, B](a: Free[S, A])(f: A => Free[S, B]) = a flatMap f
434      def point[A](a: => A) = Free.point(a)
435      // Free trampolines, should be alright to just perform binds.
436      def tailrecM[A, B](a: A)(f: A => Free[S, A \/ B]): Free[S, B] =
437        f(a).flatMap(_.fold(tailrecM(_)(f), point(_)))
438    }
439
440  implicit def freeZip[S[_]](implicit Z: Zip[S]): Zip[Free[S, *]] =
441    new Zip[Free[S, *]] {
442      override def zip[A, B](aa: => Free[S, A], bb: => Free[S, B]) =
443        (aa.resumeC, bb.resumeC) match {
444          case (-\/(a), -\/(b)) => liftF(Z.zip(a.fi, b.fi)).flatMap(ab => zip(a.k(ab._1), b.k(ab._2)))
445          case (-\/(a), \/-(b)) => liftF(a.fi).flatMap(i => a.k(i).map((_, b)))
446          case (\/-(a), -\/(b)) => liftF(b.fi).flatMap(i => b.k(i).map((a, _)))
447          case (\/-(a), \/-(b)) => point((a, b))
448        }
449    }
450
451  implicit def freeMonoid[S[_], A: Monoid]: Monoid[Free[S, A]] =
452    Monoid.liftMonoid[Free[S, *], A]
453}
454
455private sealed trait FreeBind[F[_]] extends Bind[Free[F, *]] {
456  override def map[A, B](fa: Free[F, A])(f: A => B) = fa map f
457  def bind[A, B](a: Free[F, A])(f: A => Free[F, B]) = a flatMap f
458}
459
460private sealed trait FreeFoldable[F[_]] extends Foldable[Free[F, *]] {
461  def F: Foldable[F]
462
463  override final def foldMap[A, B: Monoid](fa: Free[F, A])(f: A => B): B =
464    fa.foldStep(
465      f,
466      fa => F.foldMap(fa)(f),
467      { case (fx, g) => F.foldMap(fx)(x => foldMap(g(x))(f)) }
468    )
469
470  override final def foldLeft[A, B](fa: Free[F, A], z: B)(f: (B, A) => B): B =
471    fa.foldStep(
472      a => f(z, a),
473      fa => F.foldLeft(fa, z)(f),
474      { case (fx, g) => F.foldLeft(fx, z)((b, x) => foldLeft(g(x), b)(f)) }
475    )
476
477  override final def foldRight[A, B](fa: Free[F, A], z: => B)(f: (A, => B) => B): B =
478    fa.foldStep(
479      a => f(a, z),
480      fa => F.foldRight(fa, z)(f),
481      { case (fx, g) => F.foldRight(fx, z)((x, b) => foldRight(g(x), b)(f)) }
482    )
483}
484
485private sealed trait FreeFoldable1[F[_]] extends Foldable1[Free[F, *]] {
486  def F: Foldable1[F]
487
488  override final def foldMap1[A, B: Semigroup](fa: Free[F, A])(f: A => B): B =
489    fa.foldStep(
490      f,
491      fa => F.foldMap1(fa)(f),
492      { case (fx, g) => F.foldMap1(fx)(x => foldMap1(g(x))(f)) }
493    )
494
495  override final def foldMapRight1[A, B](fa: Free[F, A])(z: A => B)(f: (A, => B) => B): B =
496    fa.foldStep(
497      z,
498      fa => F.foldMapRight1(fa)(z)(f),
499      { case (fx, g) => F.foldMapRight1(fx)(x => foldMapRight1(g(x))(z)(f))((x, b) => foldRight(g(x), b)(f)) }
500    )
501
502  override final def foldMapLeft1[A, B](fa: Free[F, A])(z: A => B)(f: (B, A) => B): B =
503    fa.foldStep(
504      z,
505      fa => F.foldMapLeft1(fa)(z)(f),
506      { case (fx, g) => F.foldMapLeft1(fx)(x => foldMapLeft1(g(x))(z)(f))((b, x) => foldLeft(g(x), b)(f)) }
507    )
508}
509
510private sealed trait FreeTraverse[F[_]] extends Traverse[Free[F, *]] with FreeFoldable[F]{
511  implicit def F: Traverse[F]
512
513  override final def map[A, B](fa: Free[F, A])(f: A => B) = fa map f
514
515  override final def traverseImpl[G[_], A, B](fa: Free[F, A])(f: A => G[B])(implicit G: Applicative[G]): G[Free[F, B]] =
516    fa.resume match {
517      case -\/(s) => G.map(F.traverseImpl(s)(traverseImpl[G, A, B](_)(f)))(roll)
518      case \/-(r) => G.map(f(r))(point)
519    }
520}
521
522private sealed abstract class FreeTraverse1[F[_]] extends Traverse1[Free[F, *]] with FreeTraverse[F] with FreeFoldable1[F]{
523  implicit def F: Traverse1[F]
524
525  override final def traverse1Impl[G[_], A, B](fa: Free[F, A])(f: A => G[B])(implicit G: Apply[G]): G[Free[F, B]] =
526    fa.resume match {
527      case -\/(s) => G.map(F.traverse1Impl(s)(traverse1Impl[G, A, B](_)(f)))(roll)
528      case \/-(r) => G.map(f(r))(point)
529    }
530}