lerna setup

.gitignore

@@ -0,0 +1,6 @@
+*.log
+node_modules
+lib
+dev
+coverage
+__tests__

lerna.json

@@ -1,6 +1,5 @@
 {
-  "packages": [
-    "packages/*"
-  ],
+  "name": "morphic-ts",
+  "packages": ["packages/*"],
   "version": "0.0.0"
 }

package.json

@@ -2,6 +2,25 @@
   "name": "root",
   "private": true,
   "devDependencies": {
-    "lerna": "^3.19.0"
+    "fp-ts": "2.2.0",
+    "lerna": "^3.19.0",
+    "@types/jest": "24.0.23",
+    "@types/node": "12.12.8",
+    "docs-ts": "^0.2.1",
+    "dtslint": "github:gcanti/dtslint",
+    "jest": "^24.9.0",
+    "mocha": "^6.2.2",
+    "rimraf": "^3.0.0",
+    "ts-jest": "^24.1.0",
+    "ts-node": "^8.5.2",
+    "tslint": "5.20.1",
+    "tslint-config-standard": "^9.0.0",
+    "yarn-deduplicate": "1.1.1",
+    "monocle-ts": "2.0.0"
+  },
+  "workspaces": {
+    "packages": [
+      "./packages/*"
+    ]
   }
 }

packages/adt/.gitignore

@@ -0,0 +1,5 @@
+*.log
+node_modules
+lib
+dev
+coverage

packages/adt/README.md

@@ -0,0 +1,11 @@
+# `adt`
+
+> TODO: description
+
+## Usage
+
+```
+const adt = require('adt');
+
+// TODO: DEMONSTRATE API
+```

packages/adt/package.json

@@ -0,0 +1,40 @@
+{
+  "name": "adt",
+  "version": "0.0.0",
+  "description": "> TODO: description",
+  "author": "Stéphane Le Dorze <[email protected]>",
+  "homepage": "",
+  "license": "ISC",
+  "main": "lib/adt.js",
+  "directories": {
+    "lib": "lib",
+    "test": "__tests__"
+  },
+  "files": [
+    "lib"
+  ],
+  "devDependencies": {
+    "typescript": "3.7.3",
+    "prettier": "1.19.1"
+  },
+  "peerDependencies": {
+    "monocle-ts": "2.0.0"
+  },
+  "scripts": {
+    "lint": "tslint -p tsconfig.tslint.json src/**/*.ts test/**/*.ts",
+    "jest": "jest",
+    "jest-coverage": "jest --ci --coverage",
+    "prettier": "prettier --no-semi --single-quote --print-width 120 --parser typescript --list-different \"{src,test,examples}/**/*.ts\"",
+    "fix-prettier": "prettier --no-semi --single-quote --print-width 120 --parser typescript --write \"{src,test,examples}/**/*.ts\"",
+    "test": "yarn run prettier && yarn run lint && yarn run jest && yarn run docs",
+    "test-old": "yarn run prettier && yarn run lint && yarn run dtslint && yarn run jest && yarn run docs",
+    "clean": "rm -rf lib/*",
+    "build": "yarn run clean && tsc --build tsconfig.build.json",
+    "prepublish": "yarn run build",
+    "docs-fix-prettier": "prettier --no-semi --single-quote --print-width 120 --parser markdown --write \"README.md\"",
+    "dtslint": "dtslint dtslint",
+    "mocha": "TS_NODE_CACHE=false mocha -r ts-node/register test/*.ts",
+    "docs": "docs-ts",
+    "prepare": "./ensure-deduplicate.sh"
+  }
+}

packages/adt/src/adt/common.ts

@@ -0,0 +1,27 @@
+export type IfStringLiteral<T, IfLiteral, IfString, IfNotString> = T extends string
+  ? string extends T
+    ? IfString
+    : IfLiteral
+  : IfNotString
+
+export type Remove<A, Tag> = { [k in Exclude<keyof A, Tag>]: A[k] }
+export type ElemType<A> = A extends Array<infer E> ? E : never
+
+/**
+ * Keeps the common key in a union that are discriminants (Holds values which *are* literals)
+ */
+type TagsInKeys<T, K extends keyof T> = NonNullable<
+  {
+    [k in K]: undefined extends T[k] ? undefined : IfStringLiteral<T[k], k, never, never>
+  }[K]
+>
+export type TagsOf<T> = TagsInKeys<T, keyof T> // this indirection is necessary
+
+export type ExtractUnion<A, Tag extends keyof A & string, Tags extends string> = Extract<A, Record<Tag, Tags>>
+
+export type ExcludeUnion<A, Tag extends keyof A & string, Tags extends string> = Exclude<A, Record<Tag, Tags>>
+
+export const assignFunction = <F extends Function, C>(ab: F, c: C): F & C => {
+  const newF: typeof ab = ((...x: any[]) => ab(...x)) as any
+  return Object.assign(newF, c)
+}

packages/adt/src/adt/ctors.ts

@@ -0,0 +1,32 @@
+import { Remove, ExtractUnion } from './common'
+import { identity } from 'fp-ts/lib/function'
+import { KeysDefinition } from '.'
+import { record } from 'fp-ts'
+
+export type CtorType<C extends Ctors<any, any>> = C extends Ctors<infer A, any> ? A : never
+
+export type Of<A, Tag extends keyof A & string> = {
+  [key in A[Tag] & string]: (a: Remove<ExtractUnion<A, Tag, key>, Tag>) => A
+}
+
+export type As<A, Tag extends keyof A & string> = {
+  [key in A[Tag] & string]: (a: Remove<ExtractUnion<A, Tag, key>, Tag>) => ExtractUnion<A, Tag, key>
+}
+
+export interface Ctors<A, Tag extends keyof A & string> {
+  of: Of<A, Tag>
+  as: As<A, Tag>
+  make: (a: A) => A
+}
+
+export const Ctors = <A, Tag extends keyof A & string>(tag: Tag) => (keys: KeysDefinition<A, Tag>): Ctors<A, Tag> => {
+  const ctors = record.mapWithIndex((key, _) => (props: any) => ({
+    [tag]: key,
+    ...props
+  }))(keys)
+  return {
+    of: ctors as Ctors<A, Tag>['of'],
+    as: ctors as Ctors<A, Tag>['as'],
+    make: identity
+  }
+}

packages/adt/src/adt/index.ts

@@ -0,0 +1,104 @@
+import { ElemType, TagsOf, ExtractUnion, ExcludeUnion } from './common'
+import * as M from './monocle'
+import * as Ma from './matcher'
+import * as PU from './predicates'
+import * as CU from './ctors'
+import { intersection, difference } from 'fp-ts/lib/Array'
+import { eqString } from 'fp-ts/lib/Eq'
+import { record, array } from 'fp-ts'
+import { tuple, identity } from 'fp-ts/lib/function'
+
+export interface ADT<A, Tag extends keyof A & string>
+  extends Ma.Matchers<A, Tag>,
+    PU.Predicates<A, Tag>,
+    CU.Ctors<A, Tag>,
+    M.MonocleFor<A> {
+  select: <Keys extends (A[Tag] & string)[]>(...keys: Keys) => ADT<ExtractUnion<A, Tag, ElemType<Keys>>, Tag>
+  exclude: <Keys extends (A[Tag] & string)[]>(...keys: Keys) => ADT<ExcludeUnion<A, Tag, ElemType<Keys>>, Tag>
+  tag: Tag
+  keys: KeysDefinition<A, Tag>
+}
+
+export type ADTType<A extends ADT<any, any>> = CU.CtorType<A>
+
+const mergeKeys = <A, B, Tag extends (keyof A & keyof B) & string>(
+  a: KeysDefinition<A, Tag>,
+  b: KeysDefinition<B, Tag>
+): KeysDefinition<A | B, Tag> => ({ ...a, ...b } as any)
+
+const recordFromArray = record.fromFoldable({ concat: identity }, array.array)
+const toTupleNull = (k: string) => tuple(k, null)
+
+const intersectKeys = <A, B, Tag extends (keyof A & keyof B) & string>(
+  a: KeysDefinition<A, Tag>,
+  b: KeysDefinition<B, Tag>
+): KeysDefinition<Extract<A, B>, Tag> =>
+  recordFromArray(intersection(eqString)(Object.keys(a), Object.keys(b)).map(toTupleNull)) as KeysDefinition<
+    Extract<A, B>,
+    Tag
+  >
+
+const excludeKeys = <A, B, Tag extends (keyof A & keyof B) & string>(
+  a: KeysDefinition<A, Tag>,
+  toRemove: Array<string>
+): object => recordFromArray(difference(eqString)(Object.keys(a), toRemove).map(toTupleNull))
+
+const keepKeys = <A, B, Tag extends (keyof A & keyof B) & string>(
+  a: KeysDefinition<A, Tag>,
+  toKeep: Array<string>
+): object => recordFromArray(intersection(eqString)(Object.keys(a), toKeep).map(toTupleNull))
+
+export const unionADT = <AS extends [ADT<any, any>, ADT<any, any>, ...Array<ADT<any, any>>]>(
+  as: AS
+): ADT<ADTType<AS[number]>, AS[number]['tag']> => {
+  const newKeys = array.reduceRight(as[0].keys, (x: AS[number], y) => mergeKeys(x.keys, y))(as)
+  return makeADT(as[0].tag)(newKeys)
+}
+
+export const intersectADT = <A, B, Tag extends (keyof A & keyof B) & string>(
+  a: ADT<A, Tag>,
+  b: ADT<B, Tag>
+): ADT<Extract<A, B>, Tag> => makeADT(a.tag)(intersectKeys(a.keys, b.keys))
+
+export type KeysDefinition<A, Tag extends keyof A & string> = { [k in A[Tag] & string]: any }
+export const isIn = <A, Tag extends keyof A & string>(keys: KeysDefinition<A, Tag>) => (k: string) => k in keys
+
+export type ByTag<A> = <Tag extends TagsOf<A> & string>(t: Tag) => (keys: KeysDefinition<A, Tag>) => ADT<A, Tag>
+
+interface TypeDef<T> {
+  _TD: T
+}
+type TypeOfDef<X extends TypeDef<any>> = X['_TD']
+
+export const ofType = <T>(): TypeDef<T> => 1 as any
+export const makeADT = <Tag extends string>(tag: Tag) => <R extends { [x in keyof R]: TypeDef<{ [t in Tag]: x }> }>(
+  _keys: R
+): ADT<TypeOfDef<R[keyof R]>, Tag> => {
+  type Tag = typeof tag
+  type A = TypeOfDef<R[keyof R]>
+  const keys: any = _keys // any
+
+  const ctors = CU.Ctors<A, Tag>(tag)(keys)
+  const predicates = PU.Predicates<A, any>(tag)(keys) // any
+  const monocles = M.MonocleFor<A>()
+  const matchers = Ma.Matchers<A, any>(tag)(keys) // any
+  const select = <Keys extends (A[Tag] & string)[]>(
+    ...selectedKeys: Keys
+  ): ADT<ExtractUnion<A, Tag, ElemType<Keys>>, Tag> => makeADT(tag)(keepKeys(keys, selectedKeys) as any)
+
+  const exclude = <Keys extends (A[Tag] & string)[]>(
+    ...excludedKeys: Keys
+  ): ADT<ExcludeUnion<A, Tag, ElemType<Keys>>, Tag> => makeADT(tag)(excludeKeys(keys, excludedKeys) as any)
+
+  const res: ADT<A, Tag> = {
+    ...ctors,
+    ...predicates,
+    ...monocles,
+    ...matchers,
+    tag,
+    keys,
+    select,
+    exclude
+  }
+  return res
+}

packages/adt/src/adt/matcher.ts

@@ -0,0 +1,94 @@
+import { identity } from 'fp-ts/lib/function'
+import { KeysDefinition, isIn } from '.'
+import { TagsOf } from './common'
+
+type ValueByKeyByTag<Union extends Record<any, any>, Tags extends keyof Union = keyof Union> = {
+  [Tag in Tags]: { [Key in Union[Tag]]: Union extends { [r in Tag]: Key } ? Union : never }
+}
+
+type Cases<Record, R> = { [key in keyof Record]: (v: Record[key]) => R }
+
+type Folder<A> = <R>(f: (a: A) => R) => (a: A) => R
+
+interface Default<A, R> {
+  default: (a: A) => R
+}
+/**
+ * Dispatch calls for each tag value, ensuring a common result type `R`
+ */
+interface Matcher<A, Tag extends keyof A & string> extends MatcherInter<A, ValueByKeyByTag<A>[Tag]> {}
+interface MatcherInter<A, Record> {
+  <R>(match: Cases<Record, R>): (a: A) => R
+  // tslint:disable-next-line: unified-signatures
+  <R>(match: Partial<Cases<Record, R>> & Default<A, R>): (a: A) => R
+}
+
+interface Transform<A, Tag extends keyof A & string> extends TransformInter<A, ValueByKeyByTag<A>[Tag]> {}
+interface TransformInter<A, Record> {
+  (match: Partial<Cases<Record, A>>): (a: A) => A
+}
+
+interface ReducerBuilder<S, A, Tag extends keyof A & string> {
+  (match: Cases<ValueByKeyByTag<A>[Tag], (s: S) => S>): Reducer<S, A>
+  // tslint:disable-next-line: unified-signatures
+  (match: Partial<Cases<ValueByKeyByTag<A>[Tag], (s: S) => S>> & Default<A, (s: S) => S>): Reducer<S, A>
+}
+
+/**
+ * Same purpose as `Matcher` but the result type is infered as a union of all branches results types
+ */
+interface MatcherWiden<A, Tag extends keyof A & string> extends MatcherWidenIntern<A, ValueByKeyByTag<A>[Tag]> {}
+
+interface MatcherWidenIntern<A, Record> {
+  <M extends Cases<Record, any>>(match: M): (a: A) => ReturnType<M[keyof M]> extends infer R ? R : never
+  <M extends Partial<Cases<Record, any>> & Default<A, any>>(match: M): (
+    a: A
+  ) => ReturnType<NonNullable<M[keyof M]>> extends infer R ? R : never
+}
+
+export interface Reducer<S, A> {
+  (state: S | undefined, action: A): S
+}
+
+export interface Matchers<A, Tag extends keyof A & string> {
+  fold: Folder<A>
+  match: Matcher<A, Tag>
+  transform: Transform<A, Tag>
+  matchWiden: MatcherWiden<A, Tag>
+  createReducer: <S>(initialState: S) => ReducerBuilder<S, A, Tag>
+}
+
+export const Matchers = <A, Tag extends TagsOf<A> & string>(tag: Tag) => (
+  keys: KeysDefinition<A, Tag>
+): Matchers<A, Tag> => {
+  const inKeys = isIn(keys)
+  const match = (match: any) => (a: any): any => {
+    const key = a[tag]
+    return key in match ? match[key](a) : match['default'](a)
+  }
+  const transform = (match: any) => (a: any): any => {
+    const key = a[tag]
+    return key in match ? match[key](a) : a
+  }
+  const matchWiden = match
+  const fold = identity
+  const createReducer = <S>(initialState: S): ReducerBuilder<S, A, Tag> => (m: any) => {
+    const matcher = match(m)
+    return (s: any, a: any) => {
+      const key = a[tag]
+      const state = s === undefined ? initialState : s
+      if (inKeys(key)) {
+        return matcher(a)(state)
+      } else {
+        return state
+      }
+    }
+  }
+  return {
+    match,
+    matchWiden,
+    transform,
+    fold,
+    createReducer
+  }
+}