Free.java

@Data(flavour = Flavour.FJ)
public abstract class Free<f, A> implements __2<Free.µ, f, A> {
    Free() {}
    interface Cases<f, A, R> {
        R Return(A a);
        R Suspend(__<f, A> fa);
        R Gosub(Sub<f, A, ?> sub);
    }
    abstract <R> R match(Cases<f, A, R> cases);

    static final class Sub<f, B, C> {
        final Free<f, C> a;
        final F<C, Free<f, B>> f;

        Sub(Free<f, C> a, F<C, Free<f, B>> f) {
            this.a = a;
            this.f = f;
        }
    }

    public <B> Free<f, B> map(F<A, B> f) { return bind(f.andThen(Frees::Return)); }

    public <B> Free<f, B> bind(F<A, Free<f, B>> f) { return Gosub(new Sub<>(this, f)); }

    public <B> B fold(Functor<f> F, F<A, B> r, F<__<f, Free<f, A>>, B> s) { return resume(F).fold(s, r); }

    public Either<__<f, Free<f, A>>, A> resume(Functor<f> F) {
        Free<f, A> self = this;

        while (true) {
            final Either<Free<f, A>, Either<__<f, Free<f, A>>, A>> either =
                self.match(Frees.
                    cases(a -> Right(Right(a))
                        , fa -> Right(Left(F.fmap(fa, Frees::Return)))
                        , sub -> resumeGosub(F, sub)));

            if (either.isLeft()) self = either.left();
            else return either.right();
        }
    }
    private static <f, A, C> Either<Free<f, A>, Either<__<f, Free<f, A>>, A>> resumeGosub
        (Functor<f> F, Sub<f, A, C> b) {
        return b.a.match(Frees.
            cases(a -> Left(b.f.f(a))
                , fa -> Right(Left(F.fmap(fa, b.f)))
                , c -> resumeSubGosub(b, c)));
    }
    private static <f, A, C, D> Either<Free<f, A>, Either<__<f, Free<f, A>>, A>> resumeSubGosub
        (Sub<f, A, C> b, Sub<f, C, D> c) {
        return Left(c.a.bind(z -> c.f.f(z).bind(b.f)));
    }

    public Free<f, A> step() {
        Free<f, A> self = this;

        while (true) {
            final Free<f, A> fSelf = self;
            final Either<Free<f, A>, Free<f, A>> either = Frees.<f, A>cases()
                .Gosub(x -> stepGosub(fSelf, x))
                .otherwise(() -> Right(fSelf))
                .f(self);

            if (either.isLeft()) self = either.left();
            else return either.right();
        }
    }
    private static <f, A, C> Either<Free<f, A>, Free<f, A>> stepGosub(Free<f, A> self, Sub<f, A, C> x) {
        return Frees.<f, C>cases().<Either<Free<f, A>, Free<f, A>>>
            Return(b -> Left(x.f.f(b)))
            .Gosub(sub -> stepSubGosub(x, sub))
            .otherwise(() -> Right(self))
            .f(x.a);
    }
    private static <f, A, C, D> Either<Free<f, A>, Free<f, A>> stepSubGosub(Sub<f, A, C> x, Sub<f, C, D> b) {
        return Left(b.a.bind(a -> b.f.f(a).bind(x.f)));
    }

    public A go(Functor<f> F, F<__<f, Free<f, A>>, Free<f, A>> f) {
        Free<f, A> self = this;

        while (true) {
            final Either<__<f, Free<f, A>>, A> res = self.resume(F);

            if (res.isLeft()) self = f.f(res.left());
            else return res.right();
        }
    }

    public <m> __<m, A> foldMap(Monad<m> M, NF<f, m> f) {
        return Frees.<f, A>cases()
            .Return(a -> M.pure(() -> a))
            .Suspend(f::f)
            .Gosub(a -> foldMapGosub(M, f, a))
            .f(step());
    }
    private static <m, f, A, C> __<m, A> foldMapGosub(Monad<m> M, NF<f, m> f, Sub<f, A, C> a) {
        return M.bind(a.a.foldMap(M, f), c -> a.f.f(c).foldMap(M, f));
    }

    public static <f, A> Free<f, A> point(A a) { return Return(a); }

    public static <f, A> Free<f, A> liftF(__<f, A> fa) { return Suspend(fa); }

    public static <f, A> Free<f, A> suspend(Applicative<f> A, F0<Free<f, A>> f0) {
        return liftF(A.pure(Unit::unit)).bind(__ -> f0.f());
    }

    @SuppressWarnings("unchecked")
    public static <f> Instances<f> instances() { return (Instances<f>) Instances.self; }

    public static class Instances<f> implements Monad<__<Free.µ, f>> {
        private static final Instances<?> self = new Instances<>();
        private Instances() {}
        @Override
        public <A> Free<f, A> pure(F0<A> a) { return Free.point(a.f()); }
        @Override
        public <A, B> Free<f, B> bind(__<__<Free.µ, f>, A> fa, F<A, __<__<Free.µ, f>, B>> f) {
            return coerce(fa).bind(a -> coerce(f.f(a)));
        }
    }

    public static <f, R> Free<f, R> coerce(__2<Free.µ, f, R> free) { return (Free<f, R>) free; }
    public static <f, R> Free<f, R> coerce(__<__<Free.µ, f>, R> free) { return (Free<f, R>) free; }
    public static final class µ {}
}