feat: various monads and traversables

* implemented array monad and traversable
* ported decode_error from io-ts
* added indexed foldable and indexed traversable type classes
* added monad throw type class
* implemented getRightMonad and monad throw for either
* ported free semigroup from io-ts
* ported schemable from io-ts
* ported guard from io-ts
* added refinement to $ substitution

LICENSE

@@ -1,5 +1,6 @@
 The MIT License (MIT)
 
+Copyright (c) 2017 Giulio Canti
 Copyright (c) 2018 Tom Crockett
 Copyright (c) 2019 Brandon Blaylock
 

TODO.md

@@ -3,7 +3,8 @@
 - port io-ts (likely will need additional adts for this)
 - port monocle-ts (likely will need additional adts for this)
 - clean sequenceT and sequenceS implementations
-- implement tests for other 
+- implement tests for other algebraic modules
+- revisit getEitherM and getOptionM types
 - port hyper-ts to Deno
 
 # Version 1.0.0 features

array.ts

@@ -0,0 +1,74 @@
+import type * as TC from "./type_classes.ts";
+import type { _ } from "./hkts.ts";
+
+import * as D from "./derivations.ts";
+
+/***************************************************************************************************
+ * @section Optimizations
+ **************************************************************************************************/
+
+const _map = <A, B>(as: A[], fab: (a: A, i: number) => B): B[] => {
+  const out: B[] = new Array(as.length);
+  for (let i = 0; i < as.length; i++) {
+    out[i] = fab(as[i], i);
+  }
+  return out;
+};
+
+const _reduce = <A, B>(
+  as: A[],
+  fbab: (b: B, a: A, i: number) => B,
+  b: B,
+): B => {
+  let out = b;
+  for (let i = 0; i < as.length; i++) {
+    out = fbab(out, as[i], i);
+  }
+  return out;
+};
+
+/***************************************************************************************************
+ * @section Modules
+ **************************************************************************************************/
+
+export const Monad = D.createMonad<Array<_>>({
+  of: (a) => [a],
+  chain: (fatb, ta) => _map(ta, fatb).flat(),
+});
+
+export const IndexedFoldable: TC.IndexedFoldable<Array<_>> = {
+  reduce: (faba, a, tb) => _reduce(tb, (a, b, i) => faba(a, b, i), a),
+};
+
+export const IndexedTraversable: TC.IndexedTraversable<Array<_>> = {
+  map: Monad.map,
+  reduce: IndexedFoldable.reduce,
+  traverse: (A, faub, ta) =>
+    IndexedFoldable.reduce(
+      (fbs, a, i) =>
+        A.ap(
+          A.map((bs: any) => (b: any) => [...bs, b], fbs) as any,
+          faub(a, i),
+        ),
+      A.of([]),
+      ta,
+    ),
+};
+
+export const Foldable: TC.Foldable<Array<_>> = {
+  reduce: (faba, a, tb) => IndexedFoldable.reduce((a, b) => faba(a, b), a, tb),
+};
+
+export const Traversable: TC.Traversable<Array<_>> = {
+  map: Monad.map,
+  reduce: Foldable.reduce,
+  traverse: (A, faub, ta) => IndexedTraversable.traverse(A, (a) => faub(a), ta),
+};
+
+/***************************************************************************************************
+ * @section Pipeables
+ **************************************************************************************************/
+
+export const { of, ap, map, join, chain } = D.createPipeableMonad(Monad);
+
+export const { reduce, traverse } = D.createPipeableTraversable(Traversable);

decode_error.ts

@@ -0,0 +1,164 @@
+import { Semigroup } from "./type_classes.ts";
+import * as FS from "./free_semigroup.ts";
+
+/***************************************************************************************************
+ * @section DecodeError
+ * @from https://raw.githubusercontent.com/gcanti/io-ts/master/src/DecodeError.ts
+ **************************************************************************************************/
+
+/***************************************************************************************************
+ * @section Types
+ **************************************************************************************************/
+
+export type Leaf<E> = {
+  readonly tag: "Leaf";
+  readonly actual: unknown;
+  readonly error: E;
+};
+
+export const required: "required" = "required";
+export const optional: "optional" = "optional";
+
+export type Kind = "required" | "optional";
+
+export type Key<E> = {
+  readonly tag: "Key";
+  readonly key: string;
+  readonly kind: Kind;
+  readonly errors: FS.FreeSemigroup<DecodeError<E>>;
+};
+
+export type Index<E> = {
+  readonly tag: "Index";
+  readonly index: number;
+  readonly kind: Kind;
+  readonly errors: FS.FreeSemigroup<DecodeError<E>>;
+};
+
+export type Member<E> = {
+  readonly tag: "Member";
+  readonly index: number;
+  readonly errors: FS.FreeSemigroup<DecodeError<E>>;
+};
+
+export type Lazy<E> = {
+  readonly tag: "Lazy";
+  readonly id: string;
+  readonly errors: FS.FreeSemigroup<DecodeError<E>>;
+};
+
+export type Wrap<E> = {
+  readonly tag: "Wrap";
+  readonly error: E;
+  readonly errors: FS.FreeSemigroup<DecodeError<E>>;
+};
+
+export type DecodeError<E> =
+  | Leaf<E>
+  | Key<E>
+  | Index<E>
+  | Member<E>
+  | Lazy<E>
+  | Wrap<E>;
+
+/***************************************************************************************************
+ * @section Constructors
+ **************************************************************************************************/
+
+export const leaf = <E>(actual: unknown, error: E): DecodeError<E> => ({
+  tag: "Leaf",
+  actual,
+  error,
+});
+
+export const key = <E>(
+  key: string,
+  kind: Kind,
+  errors: FS.FreeSemigroup<DecodeError<E>>,
+): DecodeError<E> => ({
+  tag: "Key",
+  key,
+  kind,
+  errors,
+});
+
+export const index = <E>(
+  index: number,
+  kind: Kind,
+  errors: FS.FreeSemigroup<DecodeError<E>>,
+): DecodeError<E> => ({
+  tag: "Index",
+  index,
+  kind,
+  errors,
+});
+
+export const member = <E>(
+  index: number,
+  errors: FS.FreeSemigroup<DecodeError<E>>,
+): DecodeError<E> => ({
+  tag: "Member",
+  index,
+  errors,
+});
+
+export const lazy = <E>(
+  id: string,
+  errors: FS.FreeSemigroup<DecodeError<E>>,
+): DecodeError<E> => ({
+  tag: "Lazy",
+  id,
+  errors,
+});
+
+export const wrap = <E>(
+  error: E,
+  errors: FS.FreeSemigroup<DecodeError<E>>,
+): DecodeError<E> => ({
+  tag: "Wrap",
+  error,
+  errors,
+});
+
+/***************************************************************************************************
+ * @section Destructors
+ **************************************************************************************************/
+
+export const fold = <E, R>(patterns: {
+  Leaf: (input: unknown, error: E) => R;
+  Key: (key: string, kind: Kind, errors: FS.FreeSemigroup<DecodeError<E>>) => R;
+  Index: (
+    index: number,
+    kind: Kind,
+    errors: FS.FreeSemigroup<DecodeError<E>>,
+  ) => R;
+  Member: (index: number, errors: FS.FreeSemigroup<DecodeError<E>>) => R;
+  Lazy: (id: string, errors: FS.FreeSemigroup<DecodeError<E>>) => R;
+  Wrap: (error: E, errors: FS.FreeSemigroup<DecodeError<E>>) => R;
+}): ((e: DecodeError<E>) => R) => {
+  const f = (e: DecodeError<E>): R => {
+    switch (e.tag) {
+      case "Leaf":
+        return patterns.Leaf(e.actual, e.error);
+      case "Key":
+        return patterns.Key(e.key, e.kind, e.errors);
+      case "Index":
+        return patterns.Index(e.index, e.kind, e.errors);
+      case "Member":
+        return patterns.Member(e.index, e.errors);
+      case "Lazy":
+        return patterns.Lazy(e.id, e.errors);
+      case "Wrap":
+        return patterns.Wrap(e.error, e.errors);
+    }
+  };
+  return f;
+};
+
+/***************************************************************************************************
+ * @section Module Getters
+ **************************************************************************************************/
+
+export const getSemigroup = <E = never>(): Semigroup<
+  FS.FreeSemigroup<DecodeError<E>>
+> => FS.getSemigroup();

derivations.ts

@@ -73,6 +73,31 @@ export const createPipeableTraversable: CreatePipeableTraversable = <T>(
   traverse: (A, faub) => (ta) => T.traverse(A, faub, ta),
 });
 
+/**
+ * Derive Pipeable IndexedTraversable from IndexedTraversable.
+ */
+type CreatePipeableIndexedTraversable = {
+  <T, I>(M: TC.IndexedTraversable<T>): TC.IndexedTraversableP<T, 1, I>;
+  <T, L extends 1, I>(
+    M: TC.IndexedTraversable<T, L, I>,
+  ): TC.IndexedTraversableP<T, L, I>;
+  <T, L extends 2, I>(
+    M: TC.IndexedTraversable<T, L, I>,
+  ): TC.IndexedTraversableP<T, L, I>;
+  <T, L extends 3, I>(
+    M: TC.IndexedTraversable<T, L, I>,
+  ): TC.IndexedTraversableP<T, L, I>;
+};
+
+export const createPipeableIndexedTraversable:
+  CreatePipeableIndexedTraversable = <T>(
+    T: TC.IndexedTraversable<T>,
+  ): TC.IndexedTraversableP<T> => ({
+    map: (fab) => (ta) => T.map(fab, ta),
+    reduce: (faba, a) => (tb) => T.reduce(faba, a, tb),
+    traverse: (A, faub) => (ta) => T.traverse(A, faub, ta),
+  });
+
 /**
  * Derive Pipeable Bifunctor from Bifunctor.
  */

either.ts

@@ -1,5 +1,5 @@
 import type * as TC from "./type_classes.ts";
-import type { $, _0, _1, _2, _3 } from "./hkts.ts";
+import type { $, _0, _1, _2, _3, Fix } from "./hkts.ts";
 
 import { createSequenceStruct, createSequenceTuple } from "./sequence.ts";
 import { isNotNil, Lazy, Predicate, Refinement } from "./fns.ts";
@@ -175,6 +175,23 @@ export const getGroup = <E, A>(
     isLeft(ta) ? left(GE.invert(ta.left)) : right(GA.invert(ta.right)),
 });
 
+export const getRightMonad = <E>(
+  S: TC.Semigroup<E>,
+): TC.Monad<Either<Fix<E>, _0>> => ({
+  of: right,
+  ap: (tfab, ta) =>
+    isLeft(tfab)
+      ? (isLeft(ta) ? left(S.concat(tfab.left, ta.left)) : tfab)
+      : (isLeft(ta) ? ta : right(tfab.right(ta.right))),
+  map: (fab, ta) => isLeft(ta) ? ta : right(fab(ta.right)),
+  join: (tta) => isLeft(tta) ? tta : tta.right,
+  chain: (fatb, ta) => isLeft(ta) ? ta : fatb(ta.right),
+});
+
+export const getRightBifunctor = <E>(): TC.Bifunctor<Either<Fix<E>, _0>> => ({
+  bimap: Bifunctor.bimap,
+});
+
 /***************************************************************************************************
  * @section Modules
  **************************************************************************************************/
@@ -193,6 +210,11 @@ export const Monad = D.createMonad<Either<_0, _1>, 2>({
   chain: (fatb, ta) => (isRight(ta) ? fatb(ta.right) : ta),
 });
 
+export const MonadThrow: TC.MonadThrow<Either<_0, _1>, 2> = ({
+  ...Monad,
+  throwError: left,
+});
+
 export const Alt: TC.Alt<Either<_0, _1>, 2> = {
   map: Functor.map,
   alt: (ta, tb) => isLeft(ta) ? tb : ta,
@@ -237,7 +259,7 @@ export const Traversable: TC.Traversable<Either<_0, _1>, 2> = {
 
 type GetEitherMonad = {
   <T, L extends 1>(M: TC.Monad<T, L>): TC.Monad<$<T, [Either<_0, _1>]>, 2>;
-  <T, L extends 2>(M: TC.Monad<T, L>): TC.Monad<$<T, [Either<_1, _2>]>, 3>;
+  <T, L extends 2>(M: TC.Monad<T, L>): TC.Monad<$<T, [_0, Either<_1, _2>]>, 3>;
 };
 
 /**