|
| 1 | +package kategory |
| 2 | + |
| 3 | +@higherkind |
| 4 | +@deriving(Monad::class, Traverse::class, MonoidK::class) |
| 5 | +data class SequenceKW<out A> constructor(val sequence: Sequence<A>) : SequenceKWKind<A>, Sequence<A> by sequence { |
| 6 | + |
| 7 | + fun <B> flatMap(f: (A) -> SequenceKWKind<B>): SequenceKW<B> = this.ev().sequence.flatMap { f(it).ev().sequence }.k() |
| 8 | + |
| 9 | + fun <B> map(f: (A) -> B): SequenceKW<B> = this.ev().sequence.map(f).k() |
| 10 | + |
| 11 | + fun <B> foldL(b: B, f: (B, A) -> B): B = this.ev().fold(b, f) |
| 12 | + |
| 13 | + fun <B> foldR(lb: Eval<B>, f: (A, Eval<B>) -> Eval<B>): Eval<B> { |
| 14 | + fun loop(fa_p: SequenceKW<A>): Eval<B> = when { |
| 15 | + fa_p.sequence.none() -> lb |
| 16 | + else -> f(fa_p.ev().sequence.first(), Eval.defer { loop(fa_p.sequence.drop(1).k()) }) |
| 17 | + } |
| 18 | + return Eval.defer { loop(this.ev()) } |
| 19 | + } |
| 20 | + |
| 21 | + fun <G, B> traverse(f: (A) -> HK<G, B>, GA: Applicative<G>): HK<G, SequenceKW<B>> = |
| 22 | + foldR(Eval.always { GA.pure(emptySequence<B>().k()) }) { a, eval -> |
| 23 | + GA.map2Eval(f(a), eval) { (sequenceOf(it.a) + it.b).k() } |
| 24 | + }.value() |
| 25 | + |
| 26 | + fun <B, Z> map2(fb: SequenceKWKind<B>, f: (Tuple2<A, B>) -> Z): SequenceKW<Z> = |
| 27 | + this.ev().flatMap { a -> |
| 28 | + fb.ev().map { b -> |
| 29 | + f(Tuple2(a, b)) |
| 30 | + } |
| 31 | + }.ev() |
| 32 | + |
| 33 | + companion object { |
| 34 | + |
| 35 | + fun <A> pure(a: A): SequenceKW<A> = sequenceOf(a).k() |
| 36 | + |
| 37 | + fun <A> empty(): SequenceKW<A> = emptySequence<A>().k() |
| 38 | + |
| 39 | + private tailrec fun <A, B> go( |
| 40 | + buf: MutableList<B>, |
| 41 | + f: (A) -> HK<SequenceKWHK, Either<A, B>>, |
| 42 | + v: SequenceKW<Either<A, B>>) { |
| 43 | + if (!v.isEmpty()) { |
| 44 | + val head: Either<A, B> = v.first() |
| 45 | + when (head) { |
| 46 | + is Either.Right<A, B> -> { |
| 47 | + buf += head.b |
| 48 | + go(buf, f, v.drop(1).k()) |
| 49 | + } |
| 50 | + is Either.Left<A, B> -> go(buf, f, (f(head.a).ev() + v.drop(1)).k()) |
| 51 | + } |
| 52 | + } |
| 53 | + } |
| 54 | + |
| 55 | + fun <A, B> tailRecM(a: A, f: (A) -> HK<SequenceKWHK, Either<A, B>>): SequenceKW<B> { |
| 56 | + val buf = mutableListOf<B>() |
| 57 | + go(buf, f, f(a).ev()) |
| 58 | + return SequenceKW(buf.asSequence()) |
| 59 | + } |
| 60 | + |
| 61 | + fun functor(): SequenceKWHKMonadInstance = SequenceKW.monad() |
| 62 | + |
| 63 | + fun applicative(): SequenceKWHKMonadInstance = SequenceKW.monad() |
| 64 | + |
| 65 | + fun <A> semigroup(): SequenceKWMonoid<A> = object : SequenceKWMonoid<A> {} |
| 66 | + |
| 67 | + fun semigroupK(): SequenceKWHKMonoidKInstance = SequenceKW.monoidK() |
| 68 | + |
| 69 | + fun <A> monoid(): SequenceKWMonoid<A> = object : SequenceKWMonoid<A> {} |
| 70 | + |
| 71 | + fun foldable(): SequenceKWHKTraverseInstance = SequenceKW.traverse() |
| 72 | + } |
| 73 | +} |
| 74 | + |
| 75 | +fun <A> SequenceKW<A>.combineK(y: SequenceKWKind<A>): SequenceKW<A> = (this.sequence + y.ev().sequence).k() |
| 76 | + |
| 77 | +fun <A> Sequence<A>.k(): SequenceKW<A> = SequenceKW(this) |
0 commit comments