Composable applications with reasonably priced monads : in java !

Coproduct.java

public abstract class Coproduct<f, g, A> implements __3<Coproduct.µ, f, g, A> {
    private final Either<__<f, A>, __<g, A>> run;
    protected Coproduct(Either<__<f, A>, __<g, A>> run) {this.run = run;}

    public final Either<__<f, A>, __<g, A>> run() { return run; }

    public static <f, g, A> Coproduct<f, g, A> leftc(__<f, A> x) { return new Coproduct<f, g, A>(Left(x)) {}; }

    public static <f, g, A> Coproduct<f, g, A> rightc(__<g, A> x) { return new Coproduct<f, g, A>(Right(x)) {}; }

    public static <g> CoproductLeft<g> left() { return new CoproductLeft<>(); }

    public static <f> CoproductRight<f> right() { return new CoproductRight<>(); }

    public static final class CoproductLeft<g> {
        private CoproductLeft() {}
        public <f, A> Coproduct<f, g, A> of(__<f, A> fa) { return new Coproduct<f, g, A>(Left(fa)) {}; }
    }

    public static final class CoproductRight<f> {
        private CoproductRight() {}
        public <g, A> Coproduct<f, g, A> of(__<g, A> ga) { return new Coproduct<f, g, A>(Right(ga)) {}; }
    }

    public static <f, g, A> Coproduct<f, g, A> coerce(__<__<__<Coproduct.µ, f>, g>, A> c) {
        return (Coproduct<f, g, A>) c;
    }
    public static final class µ { private µ(){} }
}

Inject.java

public interface Inject<f, g> extends NF<f, g> {
    @Override
    default <A> __<g, A> f(__<f, A> fa) { return inj(fa); }
    <A> __<g, A> inj(__<f, A> fa);
    <A> Maybe<__<f, A>> prj(__<g, A> ga);

    static <f> Inject<f, f> reflexiveInstance() { return new Inject<f, f>() {
        @Override
        public <A> __<f, A> inj(__<f, A> fa) { return fa; }
        @Override
        public <A> Maybe<__<f, A>> prj(__<f, A> ga) { return Just(ga); }
    };}

    static <f, g> Inject<f, __<__<Coproduct.µ, f>, g>> leftInstance() { return new Inject<f, __<__<Coproduct.µ, f>, g>>() {
        @Override
        public <A> Coproduct<f, g, A> inj(__<f, A> fa) { return Coproduct.leftc(fa); }
        @Override
        public <A> Maybe<__<f, A>> prj(__<__<__<Coproduct.µ, f>, g>, A> ga) {
            return Coproduct.coerce(ga).run().fold(Maybes::Just, __ -> Maybes.Nothing());
        }
    };}

    static <f, g, h> Inject<f, __<__<Coproduct.µ, h>, g>> rightInstance(Inject<f, g> I) {
        return new Inject<f, __<__<Coproduct.µ, h>, g>>() {
            @Override
            public <A> Coproduct<h, g, A> inj(__<f, A> fa) { return Coproduct.rightc(I.inj(fa)); }
            @Override
            public <A> Maybe<__<f, A>> prj(__<__<__<Coproduct.µ, h>, g>, A> ga) {
                return Coproduct.coerce(ga).run().fold(__ -> Maybes.Nothing(), I::prj);
            }
        };
    }

    static <f, g, A> Free<g, A> lift(Inject<f, g> I, __<f, A> fa) { return Free.liftF(I.inj(fa)); }

    static <f, g, A> Free<f, A> inject(Inject<g, f> I, __<g, Free<f, A>> ga) { return Free.roll(I.inj(ga)); }

    static <f, g, A> Maybe<__<g, Free<f, A>>> match_(Functor<f> F, Inject<g, f> I, Free<f, A> fa) {
        return fa.resume(F).fold(I::prj, __ -> Maybes.Nothing());
    }
}

NF.java

/** Natural transformation */
public interface NF<f, g> {
    <A> __<g, A> f(__<f, A> fa);

    default  <e> NF<__<__<Coproduct.µ, f>, e>, g> or(NF<e, g> f) { return new NF<__<__<Coproduct.µ, f>, e>, g>() {
        public <A> __<g, A> f(__<__<__<Coproduct.µ, f>, e>, A> c) {
            return Eithers.<__<f, A>, __<e, A>>cases()
                .Right(f::f)
                .Left(NF.this::f)
                .f(Coproduct.coerce(c).run());
        }
    };}

     interface InR<f, g1, g2> {
        <A, G2A extends __<g2, A>> __<g1, G2A> f(Coerce<g2, A, G2A> C, __<f, A> fa);
    }
}

TestFree.java

public final class TestFree {
    private TestFree() {}

    // ################################ LANGUAGES ############

    // ## ResultSetOp (Doobie)

    @Data(value = @Derive(make = {constructors, patternMatching}), flavour = Flavour.FJ)
    static abstract class ResultSetOp<A> implements __<ResultSetOp.µ, A> {
        ResultSetOp() {}
        interface Cases<R, A> {
            R Next(F<Boolean, A> __);
            R GetInt(Integer i, F<Integer, A> __);
            R GetString(Integer i, F<String, A> __);
            R Close(F<Unit, A> __);
        }
        abstract <R> R match(Cases<R, A> cases);

        static <A> ResultSetOp<A> coerce(__<ResultSetOp.µ, A> r) { return (ResultSetOp<A>) r; }
        public static final class µ { private µ() {} }
    }

    // Smart constructors
    @FunctionalInterface
    interface ResultSetOpCs<f> {
        Inject<ResultSetOp.µ, f> I();

        default Free<f, Boolean> next() { return Inject.lift(I(), Next()); }
        default Free<f, Integer> getInt(Integer i) { return Inject.lift(I(), GetInt(i)); }
        default Free<f, String> getString(Integer i) { return Inject.lift(I(), GetString(i)); }
        default Free<f, Unit> close() { return Inject.lift(I(), Close()); }
    }


    // ## Interact

    @Data(value = @Derive(make = {constructors, patternMatching}), flavour = Flavour.FJ)
    static abstract class Interact<A> implements __<Interact.µ, A> {
        Interact() {}
        interface Cases<R, A> {
            R Ask(String prompt, F<String, A> __);
            R Tell(String msg, F<Unit, A> __);
        }
        abstract <R> R match(Cases<R, A> cases);

        static <A> Interact<A> coerce(__<Interact.µ, A> i) { return (Interact<A>) i;}
        static final class µ { private µ() {} }
    }

    // smart constructors
    @FunctionalInterface
    interface InteractCs<f> {
        Inject<Interact.µ, f> I();

        default Free<f, String> ask(String prompt) { return Inject.lift(I(), Ask(prompt)); }
        default Free<f, Unit> tell(String msg) { return Inject.lift(I(), Tell(msg)); }
    }

    // ################################ PROGRAM ############

    static <f> Free<f, Unit> prg(InteractCs<f> I, ResultSetOpCs<f> R) {
        return Do.$(Free.instances(), Free::coerce

            , () -> I.ask("String or Int ?")

            , __ -> I.ask("Row number ?").map(Integer::valueOf)

            , (r, i) -> r.equals("string")
                ? R.getString(i).map(Eithers::<String, Integer>Left)
                : R.getInt(i).map(Eithers::<String, Integer>Right)

            , __ -> Eithers.<String, Integer>cases()
                .Right(ri -> I.tell("Int found : " + ri))
                .Left(ls -> I.tell("String found : " + ls))
                .f(__._3())

            , __ -> unit());
    }

    // ################################ INTERPRETERS ############

    static final NF<Interact.µ, IO.µ> console = TestFree::consoleImpl;

    private static <A> IO<A> consoleImpl(__<Interact.µ, A> fa) {
        final IO<Console> cs = System::console;
        return Interacts.<A>cases()
            .Ask((prompt, __) -> cs.bind(c -> () -> __.f(c.readLine(prompt))))
            .Tell((msg, __) -> cs.bind(c -> () -> { c.printf(msg + "\n"); return unit(); }).map(__))
            .f(Interact.coerce(fa));
    }

    static final NF<ResultSetOp.µ, IO.µ> fakeDB = TestFree::fakeDBImpl;

    private static <A> IO<A> fakeDBImpl(__<ResultSetOp.µ, A> fa) {
        return ResultSetOps.<A>cases().<IO<A>>
            Next(__ -> () -> __.f(true))
            .GetInt((i, __) -> () -> __.f(33))
            .GetString((i, __) -> () -> __.f("toto"))
            .Close(__ -> () -> __.f(unit()))
            .f(ResultSetOp.coerce(fa));
    }

    // ################################ APPLICATION ############

    static final Free<__<__<Coproduct.µ, ResultSetOp.µ>, Interact.µ>, Unit> app =
        prg(() -> Inject.rightInstance(Inject.reflexiveInstance()), Inject::leftInstance);

    static IO<Unit> runApp()  {
        return IO.coerce(app.foldMap(IO.instances(), fakeDB.or(console)));
    }

    public static void main(String[] args) throws Throwable {
        runApp().run();
    }
}

and https://gist.github.com/gneuvill/ec3f7c434549a19eefe7697e9549a849#file-free-java for the Free datatype