From 1402219aad22f55c39ac448bff372474a17f5c00 Mon Sep 17 00:00:00 2001 From: rowan Date: Sat, 29 Mar 2025 06:09:49 -0500 Subject: [PATCH] overhaul monad impls --- package-lock.json | 2 +- src/either.js | 33 ---------- src/identity.js | 7 --- src/index.js | 142 ++++++++++++++++++++++++++++++++++++++++-- src/monad.js | 17 ----- src/option.js | 29 --------- src/result.js | 35 ----------- src/union.js | 44 ------------- src/utils.js | 3 - tests/index.js | 18 +++--- tests/units/index.js | 3 - tests/units/monad.js | 33 +++++----- tests/units/option.js | 26 -------- tests/units/result.js | 37 ----------- tests/units/union.js | 39 ------------ 15 files changed, 164 insertions(+), 304 deletions(-) delete mode 100644 src/either.js delete mode 100644 src/identity.js delete mode 100644 src/monad.js delete mode 100644 src/option.js delete mode 100644 src/result.js delete mode 100644 src/union.js delete mode 100644 src/utils.js delete mode 100644 tests/units/option.js delete mode 100644 tests/units/result.js delete mode 100644 tests/units/union.js diff --git a/package-lock.json b/package-lock.json index 25ef34f..230b43d 100644 --- a/package-lock.json +++ b/package-lock.json @@ -14,7 +14,7 @@ }, "node_modules/folktest": { "version": "1.0.0", - "resolved": "git+https://git.kitsu.cafe/rowan/folktest.git#1e03ea78b2fab14af89cfb7bd43ed9f384e513c6", + "resolved": "git+https://git.kitsu.cafe/rowan/folktest.git#b130e6fd1839a32ca62ffe9c96da58d8bdf39b38", "dev": true, "license": "GPL-3.0-or-later" } diff --git a/src/either.js b/src/either.js deleted file mode 100644 index 42d7391..0000000 --- a/src/either.js +++ /dev/null @@ -1,33 +0,0 @@ -import { toList } from './utils.js' - -/** - * @template L, R - * @typedef {Left | Right} Either - */ - -/** - * @template T - * @constructor - * @param {T} value - */ -export const Left = value => ({ - ...Monad(Left, value), - bind: _f => Left(value), - map: _f => Left(value), - isLeft: () => true, - isRight: () => false, - ...Tag('Left', toList(value)) -}) - -/** - * @template T - * @constructor - * @param {T} value - */ -export const Right = value => ({ - ...Monad(Right, value), - isLeft: () => false, - isRight: () => true, - ...Tag('Right', toList(value)) -}) - diff --git a/src/identity.js b/src/identity.js deleted file mode 100644 index 070a20b..0000000 --- a/src/identity.js +++ /dev/null @@ -1,7 +0,0 @@ -/** - * @template T - * @constructor - * @param {T} value - */ -export const Identity = value => Monad(Identity, value) - diff --git a/src/index.js b/src/index.js index acce0a2..782611d 100644 --- a/src/index.js +++ b/src/index.js @@ -1,7 +1,139 @@ -export { Union, UnmatchedTagError } from './union.js' -export { Identity } from './identity.js' -export { Left, Right } from './either.js' -export { Some, None } from './option.js' -export { Ok, Err } from './result.js' +export class MatchError extends Error { + constructor(name) { + super(`Pattern not matched: ${name}`) + } +} + +const ValueKey = Symbol() + +const create = (...args) => Object.freeze(Object.assign(...args)) + +function constant() { return this } +function extract() { return this[ValueKey] } +function extend(f) { return this.lift(f(this)) } +function bind(fn) { return fn(this[ValueKey]) } +function ap(other) { return other.map(this[ValueKey]) } +function map(fn) { + return this.lift(this.bind(fn)) +} + +function match(pattern) { + const name = this.of.name + + if (name in pattern) { + return this.bind(pattern[name]) + } else if ('_' in pattern) { + return pattern['_']() + } else { + throw new MatchError(name) + } +} + +const Value = v => ({ [ValueKey]: v }) + +const Functor = { + map +} + +const ConstantFunctor = { + map: constant +} + +const ConstantMonad = { + bind: constant +} + +const PointedFunctor = of => ({ + of +}) + +const Applicative = { + ...Functor, + ap +} + +const Monad = { + ...PointedFunctor, + bind +} + +const Comonad = { + extract, + extend +} + +export const Identity = value => create( + Value(value), + Functor, + PointedFunctor(Identity), + Monad +) + +export const Constant = value => create( + Value(value), + ConstantFunctor, + ConstantMonad, + PointedFunctor(constant) +) + +export const Ok = value => create( + Value(value), + Functor, + PointedFunctor(Ok), + Monad, + { + isOk: true, + isErr: false, + match + }) + +export const Err = value => create( + Value(value), + ConstantFunctor, + ConstantMonad, + PointedFunctor(Err), + { + isOk: false, + isErr: true, + match + } +) + +export const Some = value => create( + Value(value), + Functor, + PointedFunctor(Some), + Monad, + { + isSome: true, + isNone: false, + match + } +) + +export const None = () => NoneConstant + +const NoneConstant = create( + ConstantFunctor, + ConstantMonad, + PointedFunctor(None), + { + isSome: false, + isNone: true, + match + } +) + +export function curry(func) { + return function curried(...args) { + if (args.length >= func.length) { + return func.apply(this, args) + } else { + return function(...args2) { + return curried.apply(this, args.concat(args2)) + } + } + } +} diff --git a/src/monad.js b/src/monad.js deleted file mode 100644 index aabedcf..0000000 --- a/src/monad.js +++ /dev/null @@ -1,17 +0,0 @@ -/** - * @template M, T - * @constructor - * @param {(value: T) => M} lift - * @param {T} value - */ -export function Monad(lift, value) { - const name = lift.name - - return { - bind: f => f(value), - map(f) { return lift(this.bind(f)) }, - toString: () => `${name}(${value})` - } -} - - diff --git a/src/option.js b/src/option.js deleted file mode 100644 index 7f17c3d..0000000 --- a/src/option.js +++ /dev/null @@ -1,29 +0,0 @@ -import { Monad } from './monad.js' -import { Tag } from './union.js' -import { emptyList, toList } from './utils.js' - -/** - * @template T - * @typedef {Some | None} Option - */ -export const None = Object.freeze({ - bind: _f => None, - map: _f => None, - isSome: () => false, - isNone: () => true, - ...Tag('None', emptyList), - toString: () => 'None' -}) - -/** - * @template T - * @constructor - * @param {T} value - */ -export const Some = value => ({ - ...Monad(Some, value), - isSome: () => true, - isNone: () => false, - ...Tag('Some', toList(value)) -}) - diff --git a/src/result.js b/src/result.js deleted file mode 100644 index c495a95..0000000 --- a/src/result.js +++ /dev/null @@ -1,35 +0,0 @@ -import { Monad } from './monad.js' -import { Tag } from './union.js' -import { toList } from './utils.js' - -/** - * @template T, E - * @typedef {Ok | Err} Result - */ - -/** - * @template T - * @constructor - * @param {T} value - */ -export const Err = value => ({ - ...Monad(Err, value), - bind: _f => Err(value), - map: _f => Err(value), - isError: () => true, - isOk: () => false, - ...Tag('Err', toList(value)) -}) - -/** - * @template T - * @constructor - * @param {T} value - */ -export const Ok = value => ({ - ...Monad(Ok, value), - isError: () => false, - isOk: () => true, - ...Tag('Ok', toList(value)) -}) - diff --git a/src/union.js b/src/union.js deleted file mode 100644 index b8b86f1..0000000 --- a/src/union.js +++ /dev/null @@ -1,44 +0,0 @@ -export class UnmatchedTagError extends Error { - constructor(tag) { - super(`unmatched tag in union: ${tag}`) - } -} - -// TODO: verify patterns against union -/** - * @template Type, Value - * @constructor - * @param {Type} type - * @param {Iterable} values - */ -export const Tag = (type, values) => ({ - /** - * @template T - * @typedef {(...args: T[]) => void}) Pattern - * @param {Object.} patterns - * @throws {UnmatchedTagError} - */ - fold: patterns => { - if (type in patterns) { - return patterns[type](...values) - } else if ('_' in patterns) { - return patterns._() - } else { - throw new UnmatchedTagError(type) - } - }, - toString: () => `${type}(${values.join(', ')})` -}) - -export const Union = types => { - const result = {} - - const len = types.length - for (let i = 0; i < len; i++) { - const type = types[i] - result[type] = (...values) => Tag(type, values) - } - - return result -} - diff --git a/src/utils.js b/src/utils.js deleted file mode 100644 index a69a0a6..0000000 --- a/src/utils.js +++ /dev/null @@ -1,3 +0,0 @@ -export const emptyList = [] -export const toList = x => Array.isArray(x) ? x : [x] - diff --git a/tests/index.js b/tests/index.js index 5b5de71..d90cecb 100755 --- a/tests/index.js +++ b/tests/index.js @@ -4,19 +4,19 @@ import * as Tests from './units/index.js' const ap = f => f() const fmt = ({ success, description, error }) => { - if (success) { - return `${description}: PASS` - } else { - return `${description}: FAIL\n${error}` - } + if (success) { + return `${description}: PASS` + } else { + return `${description}: FAIL\n${error.stack}` + } } const results = Object.entries(Tests).map(([name, tests]) => ({ - name, - tests: tests.map(ap).map(fmt).join('\n') + name, + tests: tests.map(ap).map(fmt).join('\n') })) - .map(({ name, tests }) => `${name}\n${tests}`) - .join('\n') + .map(({ name, tests }) => `${name}\n${tests}`) + .join('\n') console.log(results) diff --git a/tests/units/index.js b/tests/units/index.js index 5b84eff..8e7f032 100644 --- a/tests/units/index.js +++ b/tests/units/index.js @@ -1,5 +1,2 @@ export { Tests as Monad } from './monad.js' -export { Tests as Option } from './option.js' -export { Tests as Result } from './result.js' -export { Tests as Union } from './union.js' diff --git a/tests/units/monad.js b/tests/units/monad.js index ce8b4b0..6959a53 100644 --- a/tests/units/monad.js +++ b/tests/units/monad.js @@ -1,33 +1,34 @@ import { it, assertEq } from 'folktest' -import { Monad } from '../../src/monad.js' +import { Identity, Constant, Ok, Err, Some, None } from '../../src/index.js' const leftIdentity = (M, a, f) => { - assertEq(M(a).bind(f), f(a)) + assertEq(M(a).bind(f), f(a)) } const rightIdentity = (M, m) => { - assertEq(m.bind(M), m) + assertEq(m.bind(M), m) } const associativity = (m, f, g) => { - assertEq(m.bind(f).bind(g), m.bind(x => f(x).bind(g))) + assertEq(m.bind(f).bind(g), m.bind(x => f(x).bind(g))) } export const prove = (M, m, a, f, g) => { - leftIdentity(M, a, f) - rightIdentity(M, m) - associativity(m, f, g) + leftIdentity(M, a, f) + rightIdentity(M, m) + associativity(m, f, g) } export const Tests = [ - it('should adhere to monadic laws', () => { - const ctr = Monad.bind(undefined, Monad) - prove( - ctr, - ctr(1), - 1, - x => ctr(x + 1), - x => ctr(x * 2) - ) + it('should adhere to monadic laws', () => { + [Identity, Constant, Ok, Err, Some, None].forEach(ctr => { + prove( + ctr, + ctr(1), + 1, + x => ctr(x + 1), + x => ctr(x * 2) + ) }) + }) ] diff --git a/tests/units/option.js b/tests/units/option.js deleted file mode 100644 index 06316e2..0000000 --- a/tests/units/option.js +++ /dev/null @@ -1,26 +0,0 @@ -import { it, assertEq } from 'folktest' -import { Some, None } from '../../src/option.js' -import { prove } from './monad.js' - -const id = x => () => x -export const Tests = [ - it('some should pass monadic laws', () => { - prove( - Some, - Some(1), - 1, - x => Some(x + 1), - x => Some(x * 2) - ) - }), - - it('should not bind none', () => { - const opt = Some(1) - .bind(id(None)) - .bind(id(Some(1))) - .map(x => x + 1) - - assertEq(opt, None) - }), -] - diff --git a/tests/units/result.js b/tests/units/result.js deleted file mode 100644 index 08ee55e..0000000 --- a/tests/units/result.js +++ /dev/null @@ -1,37 +0,0 @@ -import { it, assertEq } from 'folktest' -import { Ok, Err } from '../../src/result.js' -import { prove } from './monad.js' - -const id = x => () => x -export const Tests = [ - it('should pass monadic laws', () => { - prove( - Ok, - Ok(1), - 1, - x => Ok(x + 1), - x => Ok(x * 2) - ) - - const e = new Error() - prove( - Err, - Err(e), - e, - x => Err(new Error()), - x => Err(new Error()) - ) - }), - - it('should not bind err', () => { - const e = new Error() - const result = Ok(1) - .bind(id(Err(e))) - .bind(id(Ok(1))) - .map(x => x + 1) - - assertEq(result, Err(e)) - }), -] - - diff --git a/tests/units/union.js b/tests/units/union.js deleted file mode 100644 index 9cafac9..0000000 --- a/tests/units/union.js +++ /dev/null @@ -1,39 +0,0 @@ -import { it, assert, assertEq } from 'folktest' -import { Union } from '../../src/union.js' - -export const Tests = [ - it('should create a valid tagged union', () => { - const union = Union(['Nothing', 'Void']) - - assert(Object.hasOwn(union, 'Nothing')) - assert(Object.hasOwn(union, 'Void')) - }), - - it('can be matched', () => { - const union = Union(['Adrift', 'Nonextant', 'Dream']) - const dreaming = union.Dream('mercury') - const drifting = union.Adrift('19589') - const gone = union.Nonextant('rowan', Infinity) - - dreaming.fold({ - Dream(name) { - assertEq(name, 'mercury') - } - }) - - drifting.fold({ - Adrift(name) { - assertEq(name, '19589') - } - }) - - gone.fold({ - Nonextant(name, when) { - assertEq(name, 'rowan') - assertEq(when, Infinity) - } - }) - }) -] - -