initial commit

.gitignore

@@ -0,0 +1,2 @@
+node_modules/
+

package-lock.json

@@ -0,0 +1,22 @@
+{
+  "name": "kojima",
+  "version": "1.0.0",
+  "lockfileVersion": 3,
+  "requires": true,
+  "packages": {
+    "": {
+      "name": "kojima",
+      "version": "1.0.0",
+      "license": "GPL-3.0-or-later",
+      "devDependencies": {
+        "folktest": "git+https://git.kitsu.cafe/rowan/folktest.git"
+      }
+    },
+    "node_modules/folktest": {
+      "version": "1.0.0",
+      "resolved": "git+https://git.kitsu.cafe/rowan/folktest.git#1e03ea78b2fab14af89cfb7bd43ed9f384e513c6",
+      "dev": true,
+      "license": "GPL-3.0-or-later"
+    }
+  }
+}

package.json

@@ -0,0 +1,16 @@
+{
+  "name": "kojima",
+  "type": "module",
+  "author": "Rowan <rowan@kitsu.cafe> (https://kitsu.cafe)",
+  "version": "1.0.0",
+  "description": "",
+  "main": "src/index.js",
+  "scripts": {
+    "test": "./tests/index.js"
+  },
+  "keywords": ["functional", "functional programming", "fp", "monad"],
+  "license": "GPL-3.0-or-later",
+  "devDependencies": {
+    "folktest": "git+https://git.kitsu.cafe/rowan/folktest.git"
+  }
+}

src/either.js

@@ -0,0 +1,33 @@
+import { toList } from './utils.js'
+
+/**
+ * @template L, R
+ * @typedef {Left<L> | Right<R>} 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))
+})
+

src/identity.js

@@ -0,0 +1,7 @@
+/**
+ * @template T
+ * @constructor
+ * @param {T} value
+ */
+export const Identity = value => Monad(Identity, value)
+

src/index.js

@@ -0,0 +1,7 @@
+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'
+
+

src/monad.js

@@ -0,0 +1,17 @@
+/**
+ * @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})`
+    }
+}
+
+

src/option.js

@@ -0,0 +1,29 @@
+import { Monad } from './monad.js'
+import { Tag } from './union.js'
+import { emptyList, toList } from './utils.js'
+
+/**
+ * @template T
+ * @typedef {Some<T> | 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))
+})
+

src/result.js

@@ -0,0 +1,35 @@
+import { Monad } from './monad.js'
+import { Tag } from './union.js'
+import { toList } from './utils.js'
+
+/**
+ * @template T, E
+ * @typedef {Ok<T> | Err<E>} 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))
+})
+

src/union.js

@@ -0,0 +1,44 @@
+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<Value>} values
+ */
+export const Tag = (type, values) => ({
+    /**
+     * @template T
+     * @typedef {(...args: T[]) => void}) Pattern
+     * @param {Object.<string, Pattern>} 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
+}
+

src/utils.js

@@ -0,0 +1,3 @@
+export const emptyList = []
+export const toList = x => Array.isArray(x) ? x : [x]
+

tests/index.js

@@ -0,0 +1,22 @@
+#!/usr/bin/env node
+
+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}`
+    }
+}
+
+const results = Object.entries(Tests).map(([name, tests]) => ({
+    name,
+    tests: tests.map(ap).map(fmt).join('\n')
+}))
+    .map(({ name, tests }) => `${name}\n${tests}`)
+    .join('\n')
+
+console.log(results)
+

tests/units/index.js

@@ -0,0 +1,5 @@
+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'
+

tests/units/monad.js

@@ -0,0 +1,33 @@
+import { it, assertEq } from 'folktest'
+import { Monad } from '../../src/monad.js'
+
+const leftIdentity = (M, a, f) => {
+    assertEq(M(a).bind(f), f(a))
+}
+
+const rightIdentity = (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)))
+}
+
+export const prove = (M, m, a, 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)
+        )
+    })
+]

tests/units/option.js

@@ -0,0 +1,26 @@
+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)
+    }),
+]
+

tests/units/result.js

@@ -0,0 +1,37 @@
+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))
+    }),
+]
+
+

tests/units/union.js

@@ -0,0 +1,39 @@
+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)
+            }
+        })
+    })
+]
+
+