diff --git a/examples/ixIO.ts b/examples/ixIO.ts new file mode 100644 index 000000000..1aaba352a --- /dev/null +++ b/examples/ixIO.ts @@ -0,0 +1,82 @@ +import { IxIO } from 'fp-ts/lib/IxIO' +import * as io from 'fp-ts/lib/IO' + +/* + + Usage + + Based on State Machines All The Way Down + An Architecture for Dependently Typed Applications + https://eb.host.cs.st-andrews.ac.uk/drafts/states-all-the-way.pdf + by Edwin Brady + +*/ + +// +// finite state machine +// + +// By defining this state machine in a type, we can ensure that any sequence +// of operations which type checks is a valid sequence of operations on a door. +// The door can be open or closed +export type DoorState = 'Open' | 'Closed' + +// +// operations +// + +// A represents the return type of the operation +// I represents the input state (the precondition) +// O represents output state (the postcondition) +export class Operation extends IxIO {} + +class Open extends Operation<'Closed', 'Open', void> { + constructor() { + super( + new io.IO(() => { + console.log(`Opening the door`) + }) + ) + } +} +class Close extends Operation<'Open', 'Closed', void> { + constructor() { + super( + new io.IO(() => { + console.log(`Closing the door`) + }) + ) + } +} +class RingBell extends Operation<'Closed', 'Closed', void> { + constructor() { + super( + new io.IO(() => { + console.log(`Ringing the bell`) + }) + ) + } +} + +// tip: decomment the following lines to see the static errors + +// error: Type '"Open"' is not assignable to type '"Closed"' +// if you open the door, you must close it +// const x1: Operation<'Closed', 'Closed', void> = new Open() + +// ok +export const x2: Operation<'Closed', 'Closed', void> = new Open().ichain(() => new Close()) + +// error: Type '"Closed"' is not assignable to type '"Open"' +// you can't ring the bell when the door is open +// const x3 = new Open().ichain(() => new RingBell()) + +// ok +export const x4 = new Open().ichain(() => new Close()).ichain(() => new RingBell()) + +x4.value.run() +/* +Opening the door +Closing the door +Ringing the bell +*/ diff --git a/src/HKT.ts b/src/HKT.ts index e98ecc8f1..4bbbf1412 100644 --- a/src/HKT.ts +++ b/src/HKT.ts @@ -7,26 +7,34 @@ export interface HKT2 extends HKT { readonly _L: L } +export interface HKT3 extends HKT2 { + readonly _U: U +} + // type-level dictionaries for HKTs export interface URI2HKT {} export interface URI2HKT2 {} +export interface URI2HKT3 {} // URI constraints with dictionary integrity constraint export type HKTS = (URI2HKT & { never: HKT })[keyof URI2HKT | 'never']['_URI'] - export type HKT2S = (URI2HKT2 & { never: HKT })[keyof URI2HKT2 | 'never']['_URI'] +export type HKT3S = (URI2HKT3 & { never: HKT })[ + | keyof URI2HKT3 + | 'never']['_URI'] // HKTAs is the same as URI2HKT[U], but checks for URI constraints export type HKTAs = URI2HKT[URI] - export type HKT2As = URI2HKT2[URI] +export type HKT3As = URI2HKT3[URI] // Type-level integrity check /* tslint:disable */ (null! as URI2HKT) as { [k in keyof URI2HKT]: HKT } (null! as URI2HKT2) as { [k in keyof URI2HKT2]: HKT2 } +(null! as URI2HKT3) as { [k in keyof URI2HKT3]: HKT3 } /* tslint:enable */ diff --git a/src/IxIO.ts b/src/IxIO.ts new file mode 100644 index 000000000..1a4c9bdae --- /dev/null +++ b/src/IxIO.ts @@ -0,0 +1,76 @@ +import { Monad } from '../src/Monad' +import { IxMonad, FantasyIxMonad } from '../src/IxMonad' +import { IO } from '../src/IO' +import * as io from '../src/IO' + +declare module './HKT' { + interface URI2HKT3 { + IxIO: IxIO + } +} + +export const URI = 'IxIO' + +export type URI = typeof URI + +export class IxIO implements FantasyIxMonad { + static iof = iof + readonly _A: A + readonly _L: O + readonly _U: I + readonly _URI: URI + constructor(public readonly value: IO) {} + run(): A { + return this.value.run() + } + iof(b: B): IxIO { + return iof(b) + } + ichain(f: (a: A) => IxIO): IxIO { + return new IxIO(this.value.chain(a => f(a).value)) + } + of(b: B): IxIO { + return iof(b) + } + map(f: (a: A) => B): IxIO { + return new IxIO(this.value.map(f)) + } + ap(fab: IxIO B>): IxIO { + return new IxIO(this.value.ap(fab.value)) + } + chain(f: (a: A) => IxIO): IxIO { + return new IxIO(this.value.chain(a => f(a).value)) + } +} + +export function iof(a: A): IxIO { + return new IxIO(io.of(a)) +} + +export function ichain(f: (a: A) => IxIO, fa: IxIO): IxIO { + return fa.ichain(f) +} + +export function map(f: (a: A) => B, fa: IxIO): IxIO { + return fa.map(f) +} + +export const of = iof + +export function ap(fab: IxIO B>, fa: IxIO): IxIO { + return fa.ap(fab) +} + +export function chain(f: (a: A) => IxIO, fa: IxIO): IxIO { + return fa.chain(f) +} + +export const ixIO: Monad & IxMonad = { + URI, + map, + of, + ap, + chain, + iof, + ichain +} diff --git a/src/IxMonad.ts b/src/IxMonad.ts new file mode 100644 index 000000000..913c6c845 --- /dev/null +++ b/src/IxMonad.ts @@ -0,0 +1,39 @@ +import { HKT3, HKT3S, HKT3As } from './HKT' +import { constant } from './function' + +// Adapted from https://github.com/garyb/purescript-indexed-monad + +export interface IxMonad { + readonly URI: F + iof(a: A): HKT3 + ichain(f: (a: A) => HKT3, fa: HKT3): HKT3 +} + +export interface FantasyIxMonad { + iof(b: B): HKT3 + ichain(f: (a: A) => HKT3): HKT3 +} + +export class Ops { + iapplyFirst( + ixmonad: IxMonad + ): (fa: HKT3As, fb: HKT3As) => HKT3As + iapplyFirst(ixmonad: IxMonad): (fa: HKT3, fb: HKT3) => HKT3 + iapplyFirst(ixmonad: IxMonad): (fa: HKT3, fb: HKT3) => HKT3 { + return (fa, fb) => ixmonad.ichain(a => ixmonad.ichain(() => ixmonad.iof(a), fb), fa) + } + + iapplySecond( + ixmonad: IxMonad + ): (fa: HKT3As, fb: HKT3As) => HKT3As + iapplySecond(ixmonad: IxMonad): (fa: HKT3, fb: HKT3) => HKT3 + iapplySecond( + ixmonad: IxMonad + ): (fa: HKT3, fb: HKT3) => HKT3 { + return (fa, fb) => ixmonad.ichain(constant(fb), fa) + } +} + +const ops = new Ops() +export const iapplyFirst: Ops['iapplyFirst'] = ops.iapplyFirst +export const iapplySecond: Ops['iapplySecond'] = ops.iapplySecond diff --git a/src/index.ts b/src/index.ts index ca59b29ff..bf8b32e63 100644 --- a/src/index.ts +++ b/src/index.ts @@ -48,6 +48,10 @@ import * as identity from './Identity' export { identity } import * as io from './IO' export { io } +import * as ixIo from './IxIO' +export { ixIo } +import * as ixMonad from './IxMonad' +export { ixMonad } import * as monad from './Monad' export { monad } import * as monoid from './Monoid' diff --git a/test/IxIO.ts b/test/IxIO.ts new file mode 100644 index 000000000..c27b26153 --- /dev/null +++ b/test/IxIO.ts @@ -0,0 +1,83 @@ +import * as assert from 'assert' +import { iapplyFirst, iapplySecond } from '../src/IxMonad' +import { IxIO } from '../src/IxIO' +import * as ixIO from '../src/IxIO' +import * as io from '../src/IO' + +// +// finite state machine +// + +// By defining this state machine in a type, we can ensure that any sequence +// of operations which type checks is a valid sequence of operations on a door. +// The door can be open or closed +type DoorState = 'Open' | 'Closed' + +// +// operations +// + +let log: Array = [] + +// A represents the return type of the operation +// I represents the input state (the precondition) +// O represents output state (the postcondition) +class Operation extends IxIO { + constructor(ma: io.IO) { + super(ma) + } +} + +class Open extends Operation<'Closed', 'Open', number> { + constructor() { + super( + new io.IO(() => { + log.push(`Opening the door`) + return 1 + }) + ) + } +} +class Close extends Operation<'Open', 'Closed', void> { + constructor() { + super( + new io.IO(() => { + log.push(`Closing the door`) + return undefined + }) + ) + } +} +class RingBell extends Operation<'Closed', 'Closed', void> { + constructor() { + super( + new io.IO(() => { + log.push(`Ringing the bell`) + return undefined + }) + ) + } +} + +describe('IxIO', () => { + it('should run', () => { + log = [] + const action = new Open().ichain(() => new Close()).ichain(() => new RingBell()) + action.run() + assert.deepEqual(log, ['Opening the door', 'Closing the door', 'Ringing the bell']) + }) + + it('iapplyFirst', () => { + log = [] + const action = iapplyFirst(ixIO)(new Open(), new Close()) + action.run() + assert.deepEqual(log, ['Opening the door', 'Closing the door']) + }) + + it('iapplySecond', () => { + log = [] + const action = iapplySecond(ixIO)(new Open(), new Close()) + action.run() + assert.deepEqual(log, ['Opening the door', 'Closing the door']) + }) +})