oa-ftl-demo.ts

// Algebra 1
interface ExprAlg1<E> {
    lit(x: number): E;
    add(a: E, b: E): E;
}
const Eval: ExprAlg1<number> = {
    lit: x => x,
    add: (a, b) => a + b
};
interface Expr1 extends Expr2 {
    // Yes, really, Expr1 <: Expr2, since function parameters
    // are contravariant
    apply<E, A extends ExprAlg1<E>>(alg: A): E;
}

// Algebra 2
interface ExprAlg2<E> extends ExprAlg1<E> {
    sub(a: E, b: E): E;
}
const EvalSub: ExprAlg2<number> = {
    ...Eval,
    sub: (a, b) => a - b
};
interface Expr2 {
    apply<E, A extends ExprAlg2<E>>(alg: A): E;
}

// Initials
class LIT implements Expr1 {
    constructor(private readonly x: number) {}
    public apply<E, A extends ExprAlg1<E>>(alg: A) {
        return alg.lit(this.x);
    }
}
class ADD implements Expr1 {
    constructor(private readonly a: Expr1, private readonly b: Expr1) {}
    public apply<E, A extends ExprAlg1<E>>(alg: A) {
        return alg.add(this.a.apply(alg), this.b.apply(alg));
    }
}
class SUB implements Expr2 {
    constructor(private readonly a: Expr2, private readonly b: Expr2) {}
    public apply<E, A extends ExprAlg2<E>>(alg: A) {
        return alg.sub(this.a.apply(alg), this.b.apply(alg));
    }
}

// Test cases
const FIVE = new ADD(new LIT(2), new LIT(3));
console.log(FIVE.apply(Eval));
console.log(FIVE.apply(EvalSub));

// Extension test
const FOUR = new SUB(new ADD(new LIT(2), new LIT(3)), new LIT(1));
// const FIVE_2 = new ADD(FOUR, new LIT(3)); // Should not compile
// console.log(FOUR.apply(Eval));            // Should not compile
console.log(FOUR.apply(EvalSub));

// Haskell-like finally tagless
const FOUR_2 = <E, A extends ExprAlg2<E>>(alg: A) => alg.sub(alg.add(alg.lit(2), alg.lit(3)), alg.lit(1));
console.log(FOUR.apply(EvalSub));