|
| 1 | +import { _0, _1 } from "./hkts.ts"; |
| 2 | +import * as SL from "./type-classes.ts"; |
| 3 | + |
| 4 | +/*************************************************************************************************** |
| 5 | + * @section Types |
| 6 | + **************************************************************************************************/ |
| 7 | + |
| 8 | +export type Left<L> = { tag: "Left"; left: L }; |
| 9 | +export type Right<R> = { tag: "Right"; right: R }; |
| 10 | +export type Either<L, R> = Left<L> | Right<R>; |
| 11 | + |
| 12 | +/*************************************************************************************************** |
| 13 | + * @section Constructors |
| 14 | + **************************************************************************************************/ |
| 15 | + |
| 16 | +export const left = <L>(left: L): Left<L> => ({ tag: "Left", left }); |
| 17 | +export const right = <R>(right: R): Right<R> => ({ tag: "Right", right }); |
| 18 | + |
| 19 | +/*************************************************************************************************** |
| 20 | + * @section Destructors |
| 21 | + **************************************************************************************************/ |
| 22 | + |
| 23 | +export const fold = <L, R, B>( |
| 24 | + onLeft: (left: L) => B, |
| 25 | + onRight: (right: R) => B |
| 26 | +) => (ma: Either<L, R>): B => { |
| 27 | + switch (ma.tag) { |
| 28 | + case "Left": |
| 29 | + return onLeft(ma.left); |
| 30 | + case "Right": |
| 31 | + return onRight(ma.right); |
| 32 | + } |
| 33 | +}; |
| 34 | + |
| 35 | +/*************************************************************************************************** |
| 36 | + * @section Guards |
| 37 | + **************************************************************************************************/ |
| 38 | + |
| 39 | +export const isLeft = <L, R>(m: Either<L, R>): m is Left<L> => m.tag === "Left"; |
| 40 | +export const isRight = <L, R>(m: Either<L, R>): m is Right<R> => |
| 41 | + m.tag === "Right"; |
| 42 | + |
| 43 | +/*************************************************************************************************** |
| 44 | + * @section Instances |
| 45 | + **************************************************************************************************/ |
| 46 | + |
| 47 | +export const Monad = SL.createMonad2<Either<_0, _1>>({ |
| 48 | + of: (a) => right(a), |
| 49 | + map: (fab, ta) => (isRight(ta) ? right(fab(ta.right)) : ta), |
| 50 | + join: (tta) => (isRight(tta) ? tta.right : tta), |
| 51 | +}); |
| 52 | + |
| 53 | +export const Foldable: SL.Foldable2<Either<_0, _1>> = { |
| 54 | + reduce: (faba, a, tb) => (isRight(tb) ? faba(a, tb.right) : a), |
| 55 | +}; |
| 56 | + |
| 57 | +export const Traversable: SL.Traversable2<Either<_0, _1>> = { |
| 58 | + map: Monad.map, |
| 59 | + reduce: Foldable.reduce, |
| 60 | + traverse: (F, faub, ta) => |
| 61 | + isLeft(ta) ? F.of(left(ta.left)) : F.map(right, faub(ta.right)), |
| 62 | +}; |
0 commit comments