syntax.ts

import {Monad} from "fp-ts/lib/Monad"
import {HKT as _, HKTAs as __, HKTS} from "fp-ts/lib/HKT"
import {
    Function1 as F,
    Function2,
    Function3,
    Function4,
    Function5,
    Function6,
    Function7,
    Function8,
    Function9,
    Lazy as l
} from "fp-ts/lib/function"

export namespace Do {
    type F2<A, B, C> = Function2<A, B, C> | F<[A, B], C>
    type F3<A, B, C, D> = Function3<A, B, C, D> | F<[A, B, C], D>
    type F4<A, B, C, D, E> = Function4<A, B, C, D, E> | F<[A, B, C ,D], E>
    type F5<A, B, C, D, E, F_> = Function5<A, B, C, D, E, F_> | F<[A, B, C ,D, E], F_>
    type F6<A, B, C, D, E, F_, G> = Function6<A, B, C, D, E, F_, G> | F<[A, B, C ,D, E, F_], G>
    type F7<A, B, C, D, E, F_, G, H> = Function7<A, B, C, D, E, F_, G, H> | F<[A, B, C ,D, E, F_, G], H>
    type F8<A, B, C, D, E, F_, G, H, I> = Function8<A, B, C, D, E, F_, G, H, I> | F<[A, B, C ,D, E, F_, G, H], I>
    type F9<A, B, C, D, E, F_, G, H, I, J> = Function9<A, B, C, D, E, F_, G, H, I, J> | F<[A, B, C ,D, E, F_, G, H, I], J>

    type Fn<f, A, B = never, C = never, D = never, E = never, F_= never, G = never, H = never, I = never, J = never> =
        | l<_<f, A>>
        | F<A, _<f, B>>
        | F2<A, B, _<f, C>>
        | F3<A, B, C, _<f, D>>
        | F4<A, B, C, D, _<f, E>>
        | F5<A, B, C, D, E, _<f, F_>>
        | F6<A, B, C, D, E, F_, _<f, G>>
        | F7<A, B, C, D, E, F_, G, _<f, H>>
        | F8<A, B, C, D, E, F_, G, H, _<f, I>>
        | F9<A, B, C, D, E, F_, G, H, I, _<f, J>>

    type Tc<f, A, B = never, C = never, D = never, E = never, F_= never, G = never, H = never, I = never, J = never> =
        | _<f, A>
        | _<f, B>
        | _<f, C>
        | _<f, D>
        | _<f, E>
        | _<f, F_>
        | _<f, G>
        | _<f, H>
        | _<f, I>
        | _<f, J>

    export function _<f extends HKTS, A, B>(M: Monad<f>
        , _0: l<_<f, A>>
        , _1: F<A, _<f, B>>): __<f, B>

    export function _<f extends HKTS, A, B, C>(M: Monad<f>
        , _0: l<_<f, A>>
        , _1: F<A, _<f, B>>
        , _2: F2<A, B, _<f, C>>): __<f, C>

    export function _<f extends HKTS, A, B, C, D>(M: Monad<f>
        , _0: l<_<f, A>>
        , _1: F<A, _<f, B>>
        , _2: F2<A, B, _<f, C>>
        , _3: F3<A, B, C, _<f, D>>): __<f, D>

    export function _<f extends HKTS, A, B, C, D, E>(M: Monad<f>
        , _0: l<_<f, A>>
        , _1: F<A, _<f, B>>
        , _2: F2<A, B, _<f, C>>
        , _3: F3<A, B, C, _<f, D>>
        , _4: F4<A, B, C, D, _<f, E>>): __<f, E>

    export function _<f extends HKTS, A, B, C, D, E, F_>(M: Monad<f>
        , _0: l<_<f, A>>
        , _1: F<A, _<f, B>>
        , _2: F2<A, B, _<f, C>>
        , _3: F3<A, B, C, _<f, D>>
        , _4: F4<A, B, C, D, _<f, E>>
        , _5: F5<A, B, C, D, E, _<f, F_>>): __<f, F_>

    export function _<f extends HKTS, A, B, C, D, E, F_, G>(M: Monad<f>
        , _0: l<_<f, A>>
        , _1: F<A, _<f, B>>
        , _2: F2<A, B, _<f, C>>
        , _3: F3<A, B, C, _<f, D>>
        , _4: F4<A, B, C, D, _<f, E>>
        , _5: F5<A, B, C, D, E, _<f, F_>>
        , _6: F6<A, B, C, D, E, F_, _<f, G>>): __<f, G>

    export function _<f extends HKTS, A, B, C, D, E, F_, G, H>(M: Monad<f>
        , _0: l<_<f, A>>
        , _1: F<A, _<f, B>>
        , _2: F2<A, B, _<f, C>>
        , _3: F3<A, B, C, _<f, D>>
        , _4: F4<A, B, C, D, _<f, E>>
        , _5: F5<A, B, C, D, E, _<f, F_>>
        , _6: F6<A, B, C, D, E, F_, _<f, G>>
        , _7: F7<A, B, C, D, E, F_, G, _<f, H>>): __<f, H>

    export function _<f extends HKTS, A, B, C, D, E, F_, G, H, I>(M: Monad<f>
        , _0: l<_<f, A>>
        , _1: F<A, _<f, B>>
        , _2: F2<A, B, _<f, C>>
        , _3: F3<A, B, C, _<f, D>>
        , _4: F4<A, B, C, D, _<f, E>>
        , _5: F5<A, B, C, D, E, _<f, F_>>
        , _6: F6<A, B, C, D, E, F_, _<f, G>>
        , _7: F7<A, B, C, D, E, F_, G, _<f, H>>
        , _8: F8<A, B, C, D, E, F_, G, H, _<f, I>>): __<f, I>

    export function _<f extends HKTS, A, B, C, D, E, F_, G, H, I, J>(M: Monad<f>
        , _0: l<_<f, A>>
        , _1: F<A, _<f, B>>
        , _2: F2<A, B, _<f, C>>
        , _3: F3<A, B, C, _<f, D>>
        , _4: F4<A, B, C, D, _<f, E>>
        , _5: F5<A, B, C, D, E, _<f, F_>>
        , _6: F6<A, B, C, D, E, F_, _<f, G>>
        , _7: F7<A, B, C, D, E, F_, G, _<f, H>>
        , _8: F8<A, B, C, D, E, F_, G, H, _<f, I>>
        , _9: F9<A, B, C, D, E, F_, G, H, I, _<f, J>>): __<f, J>

    export function _<f, A, B = never, C = never, D = never, E = never, F_= never, G = never, H = never, I = never, J = never>
    (M: Monad<f>, ...fns: Array<Fn<f, A, B, C, D, E, F_, G, H, I, J>>): Tc<f, A, B, C, D, E, F_, G, H, I, J> {
        const _0 = fns[0] as l<_<f, A>>
        const _1 = fns[1] as F<A, _<f, B>>

        switch (fns.length) {
            case 2: return M.chain(_1, _0())

            case 3 : {
                const _2 = untuple2(fns[2] as F2<A, B, _<f, C>>)

                return M.chain(a => M.chain(b => _2(a, b), _1(a)), _0())
            }

            case 4 : {
                const _2 = untuple2(fns[2] as F2<A, B, _<f, C>>)
                const _3 = untuple3(fns[3] as F3<A, B, C, _<f, D>>)

                return M.chain(a => M.chain(b => M.chain(c => _3(a, b, c), _2(a, b)), _1(a)), _0())
            }

            default: throw Error("Pb")
        }
    }

    function untuple2<f, A, B, C> (f2: F2<A, B, C>): (a: A, b: B) => C {
        return f2.length === 1
            ? (a, b) => (<F<[A, B], C>>f2)([a, b])
            : (a, b) => (<Function2<A, B, C>>f2)(a, b);
    }

    function untuple3<f, A, B, C, D> (f: F3<A, B, C, D>): (a: A, b: B, c: C) => D {
        return f.length === 1
            ? (a, b, c) => (<F<[A, B, C], D>>f)([a, b, c])
            : (a, b, c) => (<Function3<A, B, C, D>> f)(a, b, c);
    }
}