Full-blown HKT for typescript.

hkt-ts.ts

/**
 * @see http://www.typescriptlang.org/play/?target=6#code/JYOwLgpgTgZghgYwgAgKoCUCSAmAEgaQBUAeVAGmQBkKBBAPmQG8AoAX2ebAE8AHFDTAGVkAXmQBrCFwD2MNFjxFicEFwoq1yDXQ7c+yQrwiksyCAA9IIACYBneUIrkqtBmIGKSz6snoBtAQBdDjgAI1swKEQwZAQAGzhbewISADEzSwgbewFBJwofeiZmZFLkAH0BAEIALmRUgG4SssratCayiso2yg6WmjaaJvZmAHoAKnGS8eQAAVsIFAALMDAeWxrR0YBzYDAlgFdQgDoEaQBbUYBZYAQoaVtZMFHDPkE74B5n4CSDiFtRgBGAAsAA5sABOADEP1sfzO53OWTAAFoAKwABmBWOwaOBADZpqNOEZkAA5aSYEAwaDEQhuZB+QiBJkZKx2LSqZAAfmQGOQdRAEAAbtBglsOKBILBEChUgcQAgwNIoMR0hZ2TksHk0AVXGyshyUmr8i5fAwWJ0oBA4NZpCA4lxkOc4Dw6sQAEJ0AAUMDq3rgdRoAEpRAwPaGRAxXsZUqafF62BwYAqlcB7c7XWqDdkHDrvLQKF7fYH6qnlaq47qzfQKH7kAG6hSqTTVfRI+Hg3UYybqwmLc1StawAcoCBkPBji6eL7g8NJeBoPAkL4eDxHdmNYatY4+-qt7n5YqK72C+bSpaytbbfbHVo3chPT74KFu0ZT3qG6WQ2HkF6OwY75VmeiYjCmx7puOWbqpkua5PGhZ-s+YRBmuG7AZ+ja+ABXp1t+aFcB+NZ0F2gF8ER-bFFaEAjmOE5wMcrolqEWj2BowZJsw4FphmCwAI5-IqEBpDmHLwXuBiifYNBQFEhE0ARFHqKodCqd6xwaXAUDbBskkAGRMHyqHroRGFmtoyCsKRPZmT4jCMvgyCgBIUiyAYgR1Eyfj4IEgRSYyNkIU51LQOafm8jQArIEKopQJZA6dGcIARBOKViFpOl+BiwSJfaKXSPs0D2Ol2m2McthxLcEDeoCHGdHENH0bpCkmUpviyXAhHaAyMARFOTFwL+fhwIEoaJJyXCDhOKoNklKXwMgbkFUsRWhpenSlPAxX0YxM5TRtZRbf1M7jVGX51Oxv7rQdN2JMcPAHLYSwBnVN1vcOo5QbY+03VZP2lGNbGqFN7DUbR45baxE2cVKS6yqu663HAYDAKKm6wWJ2pBUUB4ci16HYwlV42naDpOrI7rFqWEa-oF0UitAFAxYzSGcdxKMZrI6Oanm2NFshxmVQgyOo7GhMUK+f7WUBTMM1AsuxfzVHE+DO2yN6oQcSMsMyiuADCSxwKA3PbrzEk4xjyRKLZ+rXdepN3gghugJTz7+t+AF0yBJG0zLEmgcm5aQbEzsgCbcFY+b-MlnUBtG2HNvmnW7tBgBcfG4n-5vuRmdE0ONGfTtTvx76UPsTDi66ygVz2ra4eY7uZ4Wzz+NIyjaOJ7WyDpwnhPFNrlfLnK0hxNYYQNfXO75p+zem8and58g9u3k61rWAcSCu767sIAgdQeuoqe-gfyCSzTZ0evOXFBxma8b7G-niU30fwHUqQj2PoQTwvydfrv++H2wsfCW+9SIemVvnVWk475IF9BLLWC5pRDwMFEWKthx7GEII-SOhBnCEEKAwXG9gjxKhVHSCguCKEEIoO-UeGDyEGDwQQiBS8SYr2QPxQSm9HwwR5uJVIzhUgEO9PsH42dMEUKYbQNCbdRa9gETQghdAKAUwbGAUsPZCCSKoa4T2fsFH1B8Jo7RBglF6JzjQwRRj3xaMYTo80OgwI33HJwrISA6TYN3JQ0xNDPE6gMUI1wIjX4oLgGg+htjvH4OkYjYW7cxb1Csa4ZRi16wiI0TYkxgTzTmISQE6x5FIlSIcdLCxiTFEUMyXYnxDiWEfTosEwa412LlQgAJNx1VZAILGMSZgOtkEeGNE3ReAB5L4kE6hjI5mHegnF4iJHsIIC4xhZ65mNAAcimZBdZCsWbM3lueYA5x1wQCROAewNcQB102eM+0Oz6aKweSzLuhBUFFXoTc6Z9z9m7IOUUa6c1IgbwrN6ZeZMtBH2up0OEfAoDeleqUEYnQYAfyfN6e0FIhT+hwiokASykQpyARfMBLCwaF3tPi6qoiypwDnCDDgnRpxorSR7Y+pEtn2ifKSlWhchQAHdkCUt9CIpYPxGLBjpZ0JFZQszFhfJM25YcsI-gviRBV0yuVQp5XRF8xwUWj29PC38L4y6qHUCxM6-LBXLIDKEEVYraUSvpVNLmVNQHqsgpq-6rDVZWqFbSvoiKGVlGLsbOVhKVUMA5WHLOyBo2auQN6+pEN7U0oRZZYN+d17uPDX-Pef5AGRoLafd1f5uWQMLjADWFBqXiuddCtpXCH5ELNvkoJ1KPWctbnEuRVY20OJUWk9RnaZk+zOnTft8b6BqrInkpJcbFXEGneWn1hdU1Q0pUumRPaO6WIqSUxix1vSPCROm9g7BAUcOWaIR89BlXssXUUS1EABX+rpcweZSRyT2hWYQy2yANnRu+XLX5+ojknLOWAC5tdrDEE+ds0DTy-kpNeWE95X9jDwbuYhn555rr6tg8WDFP7sXAMWni5ZEacIkq1RWuixGhTwsDRmqaTLc33rZSOr170C50WpaargzHQZlCmrK5Ckt40cdVQ+jVXoV3JuQPx5pqghOZtSWi6mMnPVydo6uuifqbUBvrSG0OzKqO-njbGyzFpE08dVkpoGgnjNZvvmZvNACIVEvDCAqW+95O8fHKEVTU1XFCUnq2+dd6O0Lo1d2kWu7ymGOSYO-0w6YuevbL7Mpk7H2qVKXO-dU7VKGRE3Z8lVaQA-rPUmS9lWsXpc5fshkVrMXVXfXoFARWb2bqKAAH2-UKJdOgemILhiuQZShhksIAKJ7BWlAOos3CqqgIXMhIX7KAQBgGAYgzCW0bKW-N4DjzmHgYapB6DVzYPrMO9AY7LNqGhPCRhuDt2oD3YOcw+ypWQ15SBaQuFYK7xxDqJQNa3qYXQHhc56ao80X2k29t-0IOqA4vI+gYA2wVjmeJX53TCmEdbbAKm44cRqusbE9vc6SHqOLbm7SSi+OAuKdFWxRzwXOiup9GfUib3iC4Z00m5nVqMdY+J5rDnMqeDMpQsgPnPgpPhhnfLpWTOoFhD1ailXSEfRxGNWEAT5rfwOYmuTxKpn2OsrOtr2NNvF5kr46zgTkuXM5rdu54tVvvMlt82WtXhcgsw9C+43hpt+GRZ9NF7XcX4nyIjyk1R6S6fLd27orLBWkty-pyt5J+W4-7uj8V77pQheq3Vib8uUqat-eQA1bbN7ds3tw5FMQTXvQo7B8n+bqfzzPoFYj4nZOmgfvW-YUXKwe+rKNEoG72ePszwYGd05yJLvXLe-P4iFC3lQHQS92fy2N9famoCqAwKVSgrYeC1lunIdwrN4dVFRGQAD+R6DtH9px9gBx52PHpfyUgE-xJ1pRhzY3d0V19z5wF3t21XHBF0xxWGFVrUdRh0p3lSzxTwVy9yQl52zx70FzKx1Q1wI2IDt1131xYmU00ANz72QEALCCAIlXv1KC5w1lLUgJAyQn819RfVoPgPF0lTKGlVKFDRjTAKwLtxwIwNVz-x1QYJhxgWMEt3-k9yPgvh8wjF-wIJTVCBrVZ3FRdw4UbQ6XC3D33Si1Zy7wZxiSFniwz2yWnRSzUVLEL1yXz0z0LxnQnXnQ8JKxLy0LUSd3Gk-0n23VsLcPsLy0PWnFBT4OqwvRrygD4Ib0oCbw4JbyQx9A9ksJz17wYDgLFxemHw63QO72YTEAH0nwYH62CNWz6UHnhgmy8AXxYRkjkiDA6nkkcTqKQXhlaM6jpD-R5kuWuT6K4A31w3pC3zQx3w+VGPGI4PpH7mYBGVCAACsIAlRGIkhMcQBvRRj7p7hlQOsKBrpXQ6h2Zg4swaBo5osaA-BAg8JJZRjiBwDY0PR7jy0FNdVojqCGBa0fjNZgxjgFDDVEAEAJZbAAIwTTh7Q4l1INJwgnUpUyAXV6wNNQEhoRoUTzd45zjnEQ544l0biLDfB7jf5Xj7iwEPj-dHcxVoiYAgSQSAxd4ISoTd4YTFRkZ4TjhESz1sSyhg8IA8SIJeIjCwtQ8I5dx+1zCxF2o5It1Ykwi+149HCk85T+jMszoY9e091M87jAgZ1tSEtpT7joC6Nxxa0FCFSbDY9lSzDTSfQSxbA8IAJJwmIjofjioGBwC-ANItj1BRpAYJpB1vQPjxp9SkTBC2AOJL1QAEAb1vQQBBQDhzhQhoAAJxwABqZAQEDgLYCccsFUZgaIk9aqQEbAAAZmDAoDjI4hLJtXWXLIrPWWrOCgQDrKYjqwgBrMVA7JnD8EBAoGwAeLbL7NDMbPuXWWwHWRHNrOLKYkSIKKbNbLnOiMXIQMbMrJbJ7PbPnJnDr2J03ObJXN7LzNGHvBMmYCYlLO9FrIoBvOXI4mvJtTvOih-ShnjRABTLTKgBIivJnC7I-MXQ6zcjjJSQfMrKdU7J-SZiq3-OPRfN7PvIbKbJbKfP7LjJHIHMrNGngr8EwooD8CPJnPQpiIKNfPXOJ0fPgsouIAiESJAG2BrSMFAsVB9FfIPO9HWRRWkDQvgoPLosiFACYsUxYrkDAq4p4u3KXj4JqkgtIs4u4ukF4tbMUqkqgpnEotvKQpkoKOIqdUFMIAQqRBqlbJvKnL4sMuMrLNbK7I4isoEvouEqZm-OgB9CUukGAGktoqcsYpctTLcrkqrI4h6QvJtNFmYHVi7IoGXMiqrQgqrIoHWQrOwEBGPLitDJHNivVjUuUukuyqrS0uXKStQpCvzPOBgw-VDkTJgq0F-EAvGk-Nct-JjOqoStbMGjOhvMGmzI8r4pEJqqFAoCNS6ptWooGoHKHJHPHDOnwsVETODFGhRImonKSunOmqGjjIWtwpWsBEnPWuGqTOimaoAjmoQG2tapLlypUvUF-Guv6uqqKsgturOi0p6uQD6qdQGvutbJGoYCeuCrPNh0-gamYBBIavsCaoCt-OGrBPgV-DBOQGzJ0JzMgqaBBPathpZNPjZPjORpirRrBogGzWqnMtKqxvBJxoRt3iRtPgJqrOH3zMiGmN31BsFMGpQEasXT518pEq-OhtUgoEovsrFNgRvJ+tbOFuYHZpvK0s+sltiOltFuqkcqEr8oazDn5p-LUnWTyrMuWRFvaSEjIoQLsuQtPSVqNtgR8rVpEqhu1p9DNqvQtvZq0vMvUv1pduVtDMHOQGwAoArJHNLMNqbVDIfM9uqmwEWvNogBDo6TDrGtsp-SDoNqAA
 */

interface URI2HKT<U, L, A> {
}

type URIS = keyof URI2HKT<any, any, any>

type Type<URI extends URIS, U, L, A> = URI2HKT<U, L, A>[URI]

abstract class HKT<F extends URIS, U, L, A> {
    _URI!: F;
    _U!: U;
    _L!: L;
    _A!: A;
}

/**
 * @see https://github.com/Microsoft/TypeScript/issues/14829#issuecomment-504042546
 */
type NoInfer<T> = [T][T extends any ? 0 : never]
//

interface Functor<F extends URIS, U, L, A> extends HKT<F, U, L, A> {
    readonly map: <B>(f: (a: A) => B) => Type<F, U, L, B>
}

function map<F extends URIS, U, L, A, B>(fa: Functor<F, U, L, A>, f: (a: NoInfer<A>) => B): Type<F, U, L, B> {
    return fa.map(f);
}

interface Apply<F extends URIS, U, L, A> extends Functor<F, U, L, A>  {
    readonly ap: <B>(fab: Type<F, U, L, (a: A) => B>) => Type<F, U, L, B>
}

function ap<F extends URIS, U, L, A, B>(fab: Apply<F, U, L, (a: A) => B>, fa: Apply<F, U, L, A>): Type<F, U, L, B> {
    return fa.ap(fab as any)
}

function sequenceT<F extends URIS, U, L, T extends Array<Apply<F, U, L, any>>>(...args: T & { 0: Apply<F, U, L, any> }): Type<F, U, L, { [K in keyof T]: [T[K]] extends [Type<F, U, L, infer A>] ? A : never }> {
    const fst = args[0]
    const others = args.slice(1)
    let fas: Apply<F, U, L, Array<any>> = fst.map(a => [a]) as any
    for (const fa of others) {
        fas = fa.ap(
            fas.map(as => (a: any) => {
                as.push(a)
                return as
            })
        ) as any
    }
    return fas as any
}

interface Applicative<F extends URIS, U, L, A> extends Apply<F, U, L, A> {
    readonly of: <B>(a: B) => Type<F, never, never, B>
}

function of<F extends URIS, U, L, A, B>(fa: Applicative<F, U, L, A>, b: B): Type<F, never, never, B> {
    return fa.of(b)
}

interface Chain<F extends URIS, U, L, A> extends HKT<F, U, L, A> {
    readonly chain: <B>(f: (a: A) => Type<F, U, L, B>) => Type<F, U, L, B>
}

function chain<F extends URIS, U, L, A, B>(fa: Chain<F, U, L, A>, f: (a: A) => Chain<F, U, L, B>): Type<F, U, L, B> {
    return fa.chain(f as any)
}

interface Monad<F extends URIS, U, L, A> extends Applicative<F, U, L, A>, Chain<F, U, L, A> {
}

interface Foldable<F extends URIS, U, L, A> extends HKT<F, U, L, A> {
    readonly reduce: <B>(f: (acc: B, a: A) => B, b: B) => B;
}

function reduce<F extends URIS, U, L, A, B>(fa: Foldable<F, U, L, A>, f: (acc: B, a: A) => B, b: B): B {
    return fa.reduce(f, b)
}

interface Traversable<T extends URIS, TU, TL, A> extends Functor<T, TU, TL, A>, Foldable<T, TU, TL, A> {
    readonly sequence: <F extends URIS, FU, FL, A>(this: Type<T, TU, TL, Applicative<F, FU, FL, A>>, of: (ta: Type<T, TU, TL, A>) => Type<F, FU, FL, Type<T, TU, TL, A>>) => Type<F, FU, FL, Type<T, TU, TL, A>>
}

function sequence<T extends URIS, TU, TL, F extends URIS, FU, FL, A>(tfa: Traversable<T, TU, TL, Applicative<F, FU, FL, A>>, of: (ta: Type<T, TU, FL, A>) => Type<F, FU, FL, Type<T, TU, TL, A>>): Type<F, FU, FL, Type<T, TU, TL, A>> {
    return (tfa as any).sequence(of)
}

//

interface URI2HKT<U, L, A> {
    Option: Option<A>
}

class Some<A> extends HKT<'Option', never, never, A> implements Monad<'Option', never, never, A>, Traversable<'Option', never, never, A> {
    constructor(readonly a: A) {
        super()
    }

    fold<B>(onNone: () => B, onSome: (a: A) => B): B {
        return onSome(this.a);
    }

    map<B>(f: (a: A) => B): Option<B> {
        return new Some(f(this.a));
    }

    ap<B>(fab: Option<(a: A) => B>): Option<B> {
        return fab.fold(() => fab as any, ab => new Some(ab(this.a)))
    }

    of<B>(a: B): Option<B> {
        return new Some(a);
    }

    chain<B>(f: (a: A) => Option<B>): Option<B> { 
        return f(this.a)
    }

    reduce<B>(f: (acc: B, a: A) => B, b: B): B {
        return f(b, this.a)
    }

    sequence<F extends URIS, FU, FL, A>(this: Option<Applicative<F, FU, FL, A>>, of: (ta: Option<A>) => Type<F, FU, FL, Option<A>>): Type<F, FU, FL, Option<A>> {
        return (this as Some<Applicative<F, FU, FL, A>>).a.map(some)
    }
}
const some = <A>(a: A): Option<A> => new Some(a);

class None<A> extends HKT<'Option', never, never, A> implements Monad<'Option', never, never, A>, Traversable<'Option', never, never, A> {
    fold<B>(onNone: () => B, onSome: (a: A) => B): B {
        return onNone();
    }

    map<B>(f: (a: A) => B): Option<B> {
        return this as any;
    }
    
    ap<B>(fab: Option<(a: A) => B>): Option<B> {
        return this as any;
    }

    of<B>(a: B): Option<B> {
        return new Some(a);
    }

    chain<B>(f: (a: A) => Option<B>): Option<B> { 
        return this as any;
    }

    reduce<B>(f: (acc: B, a: A) => B, b: B): B {
        return b;
    }

    sequence<F extends URIS, FU, FL, A>(this: Option<Applicative<F, FU, FL, A>>, of: (ta: Option<A>) => Type<F, FU, FL, Option<A>>): Type<F, FU, FL, Option<A>> {    
        return of(none)
    }
}
const none: Option<never> = new None();

type Option<A> = Some<A> | None<A>

//

interface URI2HKT<U, L, A> {
    Either: Either<L, A>
}

class Left<L, A> extends HKT<'Either', never, L, A> implements Monad<'Either', never, L, A>, Traversable<'Either', never, L, A> {    
    constructor(readonly l: L) {
        super()
    }

    fold<B>(onLeft: (l: L) => B, onRight: (a: A) => B): B {
        return onLeft(this.l)
    }

    map<B>(f: (a: never) => B): Either<L, B> {
        return this as any;
    }

    of<B>(b: B): Either<never, B> {
        return new Right(b);
    }

    ap<B>(fab: Either<L, (a: A) => B>): Either<L, B> {
        return fab.fold<Either<L, B>>(l => fab as any, ab => this as any)
    }

    chain<B>(f: (a: A) => Either<L, B>): Either<L, B> {
        return this as any;
    }

    reduce<B>(f: (acc: B, a: A) => B, b: B): B {
        return b;
    }

    sequence<F extends URIS, FU, FL, A>(this: Either<L, Applicative<F, FU, FL, A>>, of: (ta: Either<L, A>) => Type<F, FU, FL, Either<L, A>>): Type<F, FU, FL, Either<L, A>> {    
        return of(this as any)
    }
}
const left = <L = never, A = never>(l: L): Either<L, A> => new Left(l);

class Right<L, A> extends HKT<'Either', never, L, A> implements Monad<'Either', never, L, A>, Traversable<'Either', never, L, A> {
    constructor(readonly a: A) {
        super()
    }

    fold<B>(onLeft: (l: L) => B, onRight: (a: A) => B): B {
        return onRight(this.a)
    }

    map<B>(f: (a: A) => B): Either<never, B> {
        return new Right(f(this.a))
    }

    ap<B>(fab: Either<L, (a: A) => B>): Either<L, B> {
        return fab.fold<Either<L, B>>(l => fab as any, ab => new Right(ab(this.a)))
    }

    of<B>(b: B): Either<never, B> {
        return new Right(b);
    }

    chain<B>(f: (a: A) => Either<L, B>): Either<L, B> {
        return f(this.a)
    }

    reduce<B>(f: (acc: B, a: A) => B, b: B): B {
        return f(b, this.a);
    }

    sequence<F extends URIS, FU, FL, A>(this: Either<L, Applicative<F, FU, FL, A>>, of: (ta: Either<L, A>) => Type<F, FU, FL, Either<L, A>>): Type<F, FU, FL, Either<L, A>> {    
        return (this as Right<L, Applicative<F, FU, FL, A>>).a.map(right)
    }
}
const right = <L = never, A = never>(a: A): Either<L, A> => new Right(a);

type Either<L, A> = Left<L, A> | Right<L, A>

interface URI2HKT<U, L, A> {
    Array: Array<A>
}
interface Array<T> extends Monad<'Array', never, never, T>, Traversable<'Array', never, never, T> {
}
Object.assign(Array.prototype, {
    ap: function ap<A, B>(this: A[], fab: Array<(a: A) => B>): B[] {
       return fab.map(ab => this.map(ab)).reduce((acc, bs) => acc.concat(...bs))
    },
    of: <B>(a: B) => [a],
    chain: function chain<A, B>(this: A[], f: (a: A) => B[]): B[] {
        return this.map(f).reduce((acc, bs) => acc.concat(...bs))
    },
    sequence: function sequence<F extends URIS, FU, FL, A>(this: Array<Applicative<F, FU, FL, A>>, of: (ta: Array<A>) => Applicative<F, FU, FL, A[]>): Applicative<F, FU, FL, A[]> {
        return this.reduce<Applicative<F, FU, FL, A[]>>((fas, fa) => fa.ap(fas.map(as => (a: A) => [...as, a])) as any, of([] as A[]))
    }
})
const inc = (n: number) => n + 1

// functor
map(some(123), inc)
map(some('123'), inc)
map(none, inc)
map([1, 2], inc)
map(['1', '2'], inc)
map(right(123), inc)
map(right('123'), inc)
map(left('123'), inc)

// apply
ap(some(inc), some(123))
ap(some(inc), none as Option<number>)
ap(none as Option<typeof inc>, some(123))
ap(none, none)
ap(some(inc), some('123'))
ap([inc], [123])
ap([inc], ['123'])
ap(right(inc), right(123))
ap(right<string, typeof inc>(inc), left('foo'))
ap(left<string, typeof inc>('foo'), right(123))
ap(left('foo'), left('foo'))
ap(right(inc), right('123'))
sequenceT(some(1), some('2'))
sequenceT(some(1), none)
sequenceT(left<string, number>('fooi'), right<string, number>(123))

// applicative
of(none, 123)
of(some(123), '3213')
of([], 123)
of(left('foo'), 123)
of(right(123), '123')

// monad
chain(none, a => none as Option<number>)
chain(some(123), a => some(a + 'foo'))
chain(none, () => some(123))
chain([1, 2], n => [inc(n)]),
chain(['1', '2'], n => [inc(n)])
chain(['1', '2'], (n: number) => [inc(n)])
chain(left('foo'), a => left('foo'))
chain(right(123), a => right(a + 'foo'))
chain(left('foo'), () => right(123))

// foldable
reduce(none as Option<number>, (acc, b) => acc + b, 123);
reduce(some(123), (acc, b) => acc + b, 123);
reduce(some('123'), (acc, b) => acc + b, 123);

// traversable
sequence(none as Option<Either<string, number>>, right)
sequence(some(left('foo')), right)
sequence(some(right('foo')), right)
sequence(left<string, Option<number>>('oo'), some)
sequence(right(none), some)
sequence(right<string, Option<number>>(none), some)
sequence(right(some('foo')), some)
sequence([1, 2, 3], some)
sequence([some(1), some(2)], some)
sequence([some(1), none], some)