fp-ts Monad, Foldable & Setoid Queue

fp-ts-queue.ts

//BatchedQueue implementation from Chirs Okasaki's "Purely Functional Data Structures"

import { fromNullable } from "fp-ts/lib/Either";
import { Foldable1 } from "fp-ts/lib/Foldable";
import { Monad1 } from "fp-ts/lib/Monad";
import { getArraySetoid, Setoid } from "fp-ts/lib/Setoid";

const URI = "Queue";
type URI = typeof URI;

declare module "fp-ts/lib/HKT" {
    interface URI2HKT<A> {
        Queue: Queue<A>;
    }
}

export class Queue<A> {
    readonly _URI: URI = URI;
    constructor(public readonly f: A[], public readonly t: A[]) {}
}

/**
 * Maintain the invariant: If f is empty, so is t
 */
const checkf = <A>(q: Queue<A>) => {
    if (q.f.length > 0) return q;

    const f = [...q.t].reverse();
    return new Queue(f, []);
};

export const snoc = <A>(a: A) => (q: Queue<A>) => checkf(new Queue(q.f, [a, ...q.t]));
export const head = <A>(q: Queue<A>) => fromNullable(q.f[0]);
export const tail = <A>(q: Queue<A>) => checkf(new Queue(q.f.slice(1), q.t));

export const empty = new Queue([], []);
export const isEmpty = <A>(q: Queue<A>) => q.f.length === 0;

export const flatten = <A>(q: Queue<Queue<A>>): Queue<A> => {
    const f = q.f.reduce<A[]>((acc, q_) => acc.concat(q_.f).concat(q_.t), []);
    const t = q.t.reduce<A[]>((acc, q_) => acc.concat(q_.f).concat(q_.t), []);

    return new Queue(f, t);
};

export const reduce = <A, B>(fa: Queue<A>, b: B, f: (b: B, a: A) => B): B =>
    fa.t.reduce(f, fa.f.reduce(f, b));

export const of = <A>(a: A) => new Queue([a], []);

export const map = <A, B>(fa: Queue<A>, f: (a: A) => B): Queue<B> =>
    new Queue(fa.f.map(f), fa.t.map(f));

export const ap = <A, B>(fab: Queue<(a: A) => B>, fa: Queue<A>): Queue<B> =>
    flatten(map(fab, f => map(fa, f)));

export const chain = <A, B>(fa: Queue<A>, f: (a: A) => Queue<B>): Queue<B> => flatten(map(fa, f));

export const queue: Monad1<URI> & Foldable1<URI> = {
    URI,
    of,
    map,
    ap,
    chain,
    reduce
};

export const getSetoid = <A>(S: Setoid<A>): Setoid<Queue<A>> => {
    const arrS = getArraySetoid(S);
    const equals = (a: Queue<A>, b: Queue<A>) => arrS.equals(a.f, b.f) && arrS.equals(a.t, b.t);
    return { equals };
};