Some basic optics [Kotlin]

optics.kt

package com.mkbernard.craps

interface PIso<S, T, A, B> {
    fun get(s: S): A
    fun reverseGet(b: B): T
    fun set(b: B): (S) -> T = { reverseGet(b) }
    fun set(s: S, b: B): T = set(b)(s)
    fun modify(f: (A) -> B): (S) -> T = { reverseGet(f(get(it))) }
    fun modify(s: S, f: (A) -> B): T = modify(f)(s)

    fun reverse(): PIso<B, A, T, S> =
        object : PIso<B, A, T, S> {
            override fun get(s: B): T = this@PIso.reverseGet(s)
            override fun reverseGet(b: S): A = this@PIso.get(b)
        }

    fun asLens(): PLens<S, T, A, B> =
        object : PLens<S, T, A, B> {
            override fun get(s: S): A = this@PIso.get(s)
            override fun set(b: B): (S) -> T = this@PIso.set(b)
        }

    fun asPrism(): PPrism<S, T, A, B> =
        object : PPrism<S, T, A, B> {
            override fun getOrModify(s: S): Either<T, A> = Either.right(this@PIso.get(s))
            override fun reverseGet(b: B): T = this@PIso.reverseGet(b)
            override fun getOption(s: S): A? = this@PIso.get(s)
        }

    fun asOptional(): POptional<S, T, A, B> =
        object : POptional<S, T, A, B> {
            override fun getOrModify(s: S): Either<T, A> = Either.right(this@PIso.get(s))
            override fun set(b: B): (S) -> T = this@PIso.set(b)
            override fun getOption(s: S): A? = this@PIso.get(s)
        }

    infix fun <C, D> composeIso(iso: PIso<A, B, C, D>): PIso<S, T, C, D> =
        object : PIso<S, T, C, D> {
            override fun get(s: S): C = iso.get(this@PIso.get(s))
            override fun reverseGet(b: D): T = this@PIso.reverseGet(iso.reverseGet(b))
        }

    infix fun <C, D> composeLens(lens: PLens<A, B, C, D>): PLens<S, T, C, D> =
        asLens() composeLens lens

    infix fun <C, D> composePrism(prism: PPrism<A, B, C, D>): PPrism<S, T, C, D> =
        asPrism() composePrism prism

    infix fun <C, D> composeOptional(opt: POptional<A, B, C, D>): POptional<S, T, C, D> =
        asOptional() composeOptional opt
}
interface Iso<S, A> : PIso<S, S, A, A> {
    companion object {
        fun <S, A> of(_get: (S) -> A, _reverseGet: (A) -> S): Iso<S, A> =
            object : Iso<S, A> {
                override fun get(s: S): A = _get(s)
                override fun reverseGet(b: A): S = reverseGet(b)
            }
    }
}

interface PLens<S, T, A, B> {
    fun get(s: S): A
    fun set(b: B): (S) -> T
    fun set(s: S, b: B): T = set(b)(s)
    fun modify(f: (A) -> B): (S) -> T = { set(f(get(it)))(it) }
    fun modify(s: S, f: (A) -> B): T = modify(f)(s)

    fun asOptional(): POptional<S, T, A, B> =
        object : POptional<S, T, A, B> {
            override fun getOrModify(s: S): Either<T, A> = Either.right(get(s))
            override fun set(b: B): (S) -> T = this@PLens.set(b)
            override fun getOption(s: S): A? = get(s)
        }

    infix fun <C, D> composeLens(lens: PLens<A, B, C, D>): PLens<S, T, C, D> =
        object : PLens<S, T, C, D> {
            override fun get(s: S): C = lens.get(this@PLens.get(s))
            override fun set(b: D): (S) -> T = this@PLens.modify { lens.set(b)(it) }
            override fun modify(f: (C) -> D): (S) -> T = this@PLens.modify { lens.modify(f)(it) }
        }

    infix fun <C, D> composeIso(iso: PIso<A, B, C, D>): PLens<S, T, C, D> =
        composeLens(iso.asLens())

    infix fun <C, D> composeOptional(opt: POptional<A, B, C, D>): POptional<S, T, C, D> =
        asOptional() composeOptional opt

    infix fun <C, D> composePrism(prism: PPrism<A, B, C, D>): POptional<S, T, C, D> =
        asOptional() composeOptional prism.asOptional()
}
interface Lens<S, A> : PLens<S, S, A, A> {
    companion object {
        fun <S, A> of(_get: (S) -> A, _set: (A, S) -> S): Lens<S, A> =
            object : Lens<S, A> {
                override fun get(s: S): A = _get(s)
                override fun set(b: A): (S) -> S  = { _set(b, it) }
            }
    }
}

interface PPrism<S, T, A, B> {
    fun getOrModify(s: S): Either<T, A>
    fun reverseGet(b: B): T
    fun getOption(s: S): A?
    fun set(b: B): (S) -> T = { reverseGet(b) }
    fun set(s: S, b: B): T = set(b)(s)
    fun modify(f: (A) -> B): (S) -> T = { s -> getOrModify(s).fold({ it }) { reverseGet(f(it)) } }
    fun modify(s: S, f: (A) -> B): T = modify(f)(s)

    fun asOptional(): POptional<S, T, A, B> =
        object : POptional<S, T, A, B> {
            override fun getOrModify(s: S): Either<T, A> = this@PPrism.getOrModify(s)
            override fun set(b: B): (S) -> T = this@PPrism.set(b)
            override fun getOption(s: S): A? = this@PPrism.getOption(s)
        }

    infix fun <C, D> composePrism(prism: PPrism<A, B, C, D>): PPrism<S, T, C, D> =
        object : PPrism<S, T, C, D> {
            override fun getOrModify(s: S): Either<T, C> =
                Either.flatMap(this@PPrism.getOrModify(s)) { a ->
                    prism.getOrModify(a).bimap({ this@PPrism.set(it)(s) }, { it })
                }
            override fun reverseGet(b: D): T = this@PPrism.reverseGet(prism.reverseGet(b))
            override fun getOption(s: S): C? = this@PPrism.getOption(s)?.let { prism.getOption(it) }
        }

    infix fun <C, D> composeIso(iso: PIso<A, B, C, D>): PPrism<S, T, C, D> =
        composePrism(iso.asPrism())

    infix fun <C, D> composeLens(lens: PLens<A, B, C, D>): POptional<S, T, C, D> =
        asOptional() composeOptional lens.asOptional()

    infix fun <C, D> composeOptional(opt: POptional<A, B, C, D>): POptional<S, T, C, D> =
        asOptional() composeOptional opt
}
interface Prism<S, A> : PPrism<S, S, A, A> {
    companion object {
        fun <S, A> of(_build: (A) -> S, _get: (S) -> Either<S, A>): Prism<S, A> =
            object : Prism<S, A> {
                override fun getOrModify(s: S): Either<S, A> = _get(s)
                override fun reverseGet(b: A): S = _build(b)
                override fun getOption(s: S): A? = getOrModify(s).foldRight(null, { it })
            }
    }
}

interface POptional<S, T, A, B> {
    fun getOrModify(s: S): Either<T, A>
    fun set(b: B): (S) -> T
    fun set(s: S, b: B): T = set(b)(s)
    fun getOption(s: S): A?
    fun modify(f: (A) -> B): (S) -> T =
        { s -> getOrModify(s).fold({ it }) { a -> set(f(a))(s) } }
    fun modify(s: S, f: (A) -> B): T = modify(f)(s)

    infix fun <C, D> composeOptional(opt: POptional<A, B, C, D>): POptional<S, T, C, D> =
        object : POptional<S, T, C, D> {
            override fun getOrModify(s: S): Either<T, C> =
                Either.flatMap(this@POptional.getOrModify(s)) { a ->
                    opt.getOrModify(a).bimap({ this@POptional.set(it)(s) }, { it })
                }
            override fun set(b: D): (S) -> T = this@POptional.modify { opt.set(b)(it) }
            override fun getOption(s: S): C? = this@POptional.getOption(s)?.let { opt.getOption(it) }
        }

    infix fun <C, D> composeIso(iso: PIso<A, B, C, D>): POptional<S, T, C, D> =
        composeOptional(iso.asOptional())

    infix fun <C, D> composeLens(lens: PLens<A, B, C, D>): POptional<S, T, C, D> =
        composeOptional(lens.asOptional())

    infix fun <C, D> composePrism(prism: PPrism<A, B, C, D>): POptional<S, T, C, D> =
        composeOptional(prism.asOptional())
}
interface Optional<S, A> : POptional<S, S, A, A> {
    companion object {
        fun <S, A> of(_get: (S) -> Either<S, A>, _set: (A, S) -> S): Optional<S, A> =
            object : Optional<S, A> {
                override fun getOrModify(s: S): Either<S, A> = _get(s)
                override fun set(b: A): (S) -> S = { _set(b, it) }
                override fun getOption(s: S): A? = getOrModify(s).foldRight(null, { it })
            }
    }
}