free-monad.ts

import * as Free from 'fp-ts-contrib/Free';
import * as I from 'fp-ts/lib/Identity';
import * as O from 'fp-ts/Option';
import { Do } from 'fp-ts-contrib/Do';
import { pipe, flow } from 'fp-ts/function';
import { sequenceS } from 'fp-ts/lib/Apply';

declare module 'fp-ts/HKT' {
  interface URItoKind<A> {
    Store: StoreA;
  }
}

const StoreURI = 'Store';
type StoreURI = typeof StoreURI;

class Put<T> {
  readonly _URI!: 'Store';
  readonly _A!: void;
  readonly _tag: 'Put' = 'Put';
  constructor(readonly key: string, readonly value: T) {}
}

class Get<T> {
  readonly _URI!: StoreURI;
  readonly _A!: O.Option<T>;
  readonly _tag: 'Get' = 'Get';
  constructor(readonly key: string) {}
}

class Del {
  readonly _URI!: StoreURI;
  readonly _A!: void;
  readonly _tag: 'Del' = 'Del';
  constructor(readonly key: string) {}
}

type StoreA = Put<any> | Get<any> | Del;

const get = <T>(key: string) => Free.liftF(new Get<T>(key));

const put = <T>(key: string, value: T) => Free.liftF(new Put(key, value));

const del = (key: string) => Free.liftF(new Del(key));

const update = <T>(key: string, f: (v: T) => T) =>
  pipe(
    get<T>(key),
    Free.chain(
      flow(
        O.map((a) => put(key, f(a))),
        O.getOrElse(() => Free.of(undefined as void))
      )
    )
  );

const program = Do(Free.free)
  .do(put('dog', 2))
  .do(update<number>('dog', (_) => _ + 5))
  .do(put('cat', 9))
  .bind('cat', get<number>('cat'))
  .do(del('cat'))
  .bind('dog', get<number>('dog'))
  .return(
    flow(
      sequenceS(O.option),
      O.map(({ dog, cat }) => dog + cat)
    )
  );

class HashMap<Key, Value> {
  private _map: Map<Key, Value>;
  constructor(entries?: readonly (readonly [Key, Value])[] | null | undefined) {
    this._map = new Map<Key, Value>(entries);
  }

  size() {
    return this._map.size;
  }

  values() {
    return this._map.values();
  }

  clear() {
    this._map.clear();
  }

  delete(key: Key) {
    this._map.delete(key);
  }

  entries() {
    return this._map.entries();
  }

  has(key: Key) {
    return this._map.has(key);
  }

  get(key: Key) {
    return this._map.has(key) ? O.some(this._map.get(key) as Value) : O.none;
  }

  set(key: Key, value: Value) {
    this._map.set(key, value);
  }

  keys() {
    return this._map.keys();
  }
}

const store = new HashMap<string, any>();

const impureInterpreter = <A>(fa: StoreA): I.Identity<any> => {
  switch (fa._tag) {
    case 'Get':
      return store.get(fa.key);
    case 'Put':
      return store.set(fa.key, fa.value);
    case 'Del':
      return store.delete(fa.key);
  }
};

const result = Free.foldFree(I.identity)(impureInterpreter, program);

console.log(result);

Thank you for this.

• Is there a simpler way to do this without adding Store to URItoKind?
• Dealing with _A and _URI in class syntax to make it compatible with HKT feels like a hack. Is there a simpler syntax to do this?