fp-ts: On free monad, tagless-final and error handling

Hi. I’m trying to use Free to describe a program that exists always in terms of an Either<L, A>. All my instructions are binary in that way, e.g.

export class CountAvailableUnits<L, A> {
  public readonly _tag: "CountAvailableUnits" = "CountAvailableUnits";
  public readonly _A!: A;
  public readonly _URI!: InstructionURI;

  constructor(
    readonly id: string;
    readonly more: (a: Either<L, number>) => Either<L, A>,
  ) {}
}

When I attempt to foldFree(either)(interpreter, program).value I end up with Either<{}, Either<L, A>>. I can’t figure out the secret sauce to make foldFree do what I want. It looks like it should, based on the signature of FoldFree2, but this is beyond my ability to debug. Any ideas?

Thanks

About this issue

  • Original URL
  • State: closed
  • Created 6 years ago
  • Comments: 34 (20 by maintainers)

Most upvoted comments

Disclaimer: this is pretty long…

Let’s say we want to implement the following program

  • try to load the user from the localStorage
  • if is not there try to load the user from a remote endpoint
  • every operation will be logged

Scenario 1: using mtl / finally tagless

First of all let’s define the domain model and the capabilities

// mtl.ts
import { Either } from 'fp-ts/lib/Either'
import { HKT } from 'fp-ts/lib/HKT'
import { Monad } from 'fp-ts/lib/Monad'
import { none, Option, some } from 'fp-ts/lib/Option'

export interface User {
  id: string
  name: string
}

// abstract local storage
interface MonadStorage<M> {
  getItem: (key: string) => HKT<M, Option<string>>
}

// abstract remote endpoint
interface MonadUser<M> {
  fetch: (userId: string) => HKT<M, Either<string, Option<User>>>
}

// abstract logging
interface MonadLogger<M> {
  log: (message: string) => HKT<M, void>
}

export interface MonadApp<M> extends MonadStorage<M>, MonadUser<M>, MonadLogger<M>, Monad<M> {}

then the main program

// mtl.ts
export class Main {
  getMain<M>(M: MonadApp<M>): (userId: string) => HKT<M, Option<User>> {
    const withLog = <A>(message: string, fa: HKT<M, A>): HKT<M, A> => M.chain(M.log(message), () => fa)
    const parseUser = (s: string): User => JSON.parse(s)
    return userId => {
      const localUser = M.chain(M.getItem(userId), o =>
        o.fold(withLog('local user not found', M.of(none)), s => M.of(some(parseUser(s))))
      )
      const remoteUser = M.chain(M.fetch(userId), e =>
        e.fold(
          () => withLog('error while retrieving user', M.of(none)),
          o =>
            o.fold(withLog('remote user not found', M.of(none)), user => withLog('remote user found', M.of(some(user))))
        )
      )
      return M.chain(localUser, o => o.fold(remoteUser, user => M.of(some(user))))
    }
  }
}

In order to test the program we must define a test instance of MonadApp, so first of all let’s define an overloading of getMain for the State monad

// mtl-test.ts
import { Either, left, right } from 'fp-ts/lib/Either'
import { Type2, URIS2 } from 'fp-ts/lib/HKT'
import { Monad2 } from 'fp-ts/lib/Monad'
import { fromNullable, Option } from 'fp-ts/lib/Option'
import { state, State, URI } from 'fp-ts/lib/State'
import { Main, User } from './mtl'

//
// mtl augmentation
//

interface MonadStorage2<M extends URIS2, L> {
  getItem: (key: string) => Type2<M, L, Option<string>>
}

interface MonadUser2<M extends URIS2, L> {
  fetch: (userId: string) => Type2<M, L, Either<string, Option<User>>>
}

interface MonadLogger2<M extends URIS2, L> {
  log: (message: string) => Type2<M, L, void>
}

interface MonadApp2<M extends URIS2, L> extends MonadStorage2<M, L>, MonadUser2<M, L>, MonadLogger2<M, L>, Monad2<M> {}

declare module './mtl' {
  interface Main {
    getMain<M extends URIS2, L>(M: MonadApp2<M, L>): (userId: string) => Type2<M, L, Option<User>>
  }
}

Now we can define a instance for State

// mtl-test.ts
export interface TestState {
  localStorage: Record<string, string>
  users: Record<string, User>
  error: boolean
  log: Array<string>
}

const testInstance: MonadApp2<URI, TestState> = {
  ...state,
  getItem: key => new State(s => [fromNullable(s.localStorage[key]), s]),
  fetch: userId => new State(s => (s.error ? [left('500'), s] : [right(fromNullable(s.users[userId])), s])),
  log: message => new State(s => [undefined, { ...s, log: s.log.concat(message) }])
}

const main = new Main().getMain(testInstance)
// result: State<TestState, Option<User>>
const result = main('abc')

Finally we can actually test the program with different initial states

// mtl-test.ts
const testState1 = { localStorage: {}, users: { abc: { id: 'abc', name: 'Giulio' } }, error: false, log: [] }
console.log(result.run(testState1))
/*
[ some({
  "id": "abc",
  "name": "Giulio"
}),
  { localStorage: {},
    users: { abc: [Object] },
    error: false,
    log: [ 'local user not found', 'remote user found' ] } ]
*/
const testState2 = { localStorage: {}, users: {}, error: false, log: [] }
console.log(result.run(testState2))
/*
[ none,
  { localStorage: {},
    users: {},
    error: false,
    log: [ 'local user not found', 'remote user not found' ] } ]
*/

Scenario 2: using concrete types

Let’s still define the capabilities but with concrete types

// concrete.ts
import { User } from './mtl'
import { IO } from 'fp-ts/lib/IO'
import { Option, some, none, fromNullable } from 'fp-ts/lib/Option'
import { Task, fromIO, task } from 'fp-ts/lib/Task'
import { Either, left, right } from 'fp-ts/lib/Either'

interface MonadStorage {
  getItem: (key: string) => IO<Option<string>>
}

interface MonadUser {
  fetch: (userId: string) => Task<Either<string, Option<User>>> // or TaskEither<string, Option<User>>
}

interface MonadLogger {
  log: (message: string) => IO<void>
}

interface MonadApp extends MonadStorage, MonadUser, MonadLogger {}

and then the main program

// concrete.ts
const getMain = (M: MonadApp): ((userId: string) => Task<Option<User>>) => {
  const withLog = <A>(message: string, fa: Task<A>): Task<A> => fromIO(M.log(message)).chain(() => fa)
  const parseUser = (s: string): User => JSON.parse(s)
  return userId => {
    const localUser = fromIO(M.getItem(userId)).chain(o =>
      o.fold(withLog('local user not found', task.of(none)), s => task.of(some(parseUser(s))))
    )
    const remoteUser = M.fetch(userId).chain(e =>
      e.fold(
        () => withLog('error while retrieving user', task.of(none)),
        o =>
          o.fold(withLog('remote user not found', task.of(none)), user =>
            withLog('remote user found', task.of(some(user)))
          )
      )
    )
    return localUser.chain(o => o.fold(remoteUser, user => task.of(some(user))))
  }
}

How can I test this program? We need a test instance for MonadApp and I’ll use IORef for this

// concrete.ts
import { TestState } from './mtl-test'
import { IORef } from './IORef' // <= this is simply a local copy of IORef

const getTestInstance = (ref: IORef<TestState>): MonadApp => {
  return {
    getItem: key => ref.read.map(s => fromNullable(s.localStorage[key])),
    fetch: userId => fromIO(ref.read.map(s => (s.error ? left('500') : right(fromNullable(s.users[userId]))))),
    log: message => ref.modify(s => ({ ...s, log: s.log.concat(message) }))
  }
}

const testState1 = { localStorage: {}, users: { abc: { id: 'abc', name: 'Giulio' } }, error: false, log: [] }
const ref1 = new IORef(testState1)
const testInstance1 = getTestInstance(ref1)
getMain(testInstance1)('abc')
  .chain(result => fromIO(ref1.read).map(state => [result, state]))
  .run()
  .then(console.log)
/*
[ some({
  "id": "abc",
  "name": "Giulio"
}),
  { localStorage: {},
    users: { abc: [Object] },
    error: false,
    log: [ 'local user not found', 'remote user found' ] } ]
*/
const testState2 = { localStorage: {}, users: {}, error: false, log: [] }
const ref2 = new IORef(testState2)
const testInstance2 = getTestInstance(ref2)
getMain(testInstance2)('abc')
  .chain(result => fromIO(ref2.read).map(state => [result, state]))
  .run()
  .then(console.log)
/*
[ none,
  { localStorage: {},
    users: {},
    error: false,
    log: [ 'local user not found', 'remote user not found' ] } ]
*/

using Reader* to deliver dictionaries of => IO or => Task functions that I can replace at test time

@leemhenson In both scenarios, using Reader instead of passing MonadApp (or the other static dictionaries) manually seems a good option

Actually the problem with u2 already exist with today s chain implementation.

I mean someone using the current chain api with a Left of ErrorSubsystem1 and chaining on a function returning a ErrorSubsystem2 will detect nothing due to the structural nature of TS like @peterhorne said.

So switching to that new Error consolidation scheme would not be a regression.

Is it correct @gcanti ?

In the case of u2 they are “the same” type due to the fact that Typescript is structurally typed. That doesn’t mean that it’s unsafe, does it?

AFAIK finally tagless and mtl are (kind of) synonyms

I found it quite difficult to recommend due to the amount of boilerplate and visual noise from Typescript’s inability to infer types as well as Haskell or Purescript can

Yes, I feel your pain, while in Haskell/PureScript (or Scala) looks like a no brainer, in TypeScript there’s a lot of ceremonies. Perhaps it might worth it in a library but it’s a hard sell in the application code

I’m basically trying to work out what is a good, general-purpose approach for making effectful code testable that I can guide my team towards

I’m trying to find a good balance as well. I’ll try to collect my thoughts, I need some time though.

using Reader* to deliver dictionaries of => IO or => Task functions that I can replace at test time

Using Reader seems a good option to avoid passing around the static dictionaries by hand, however I think that is tangential to the heart of the problem which is to abstract over the effect M of a general effectful program (I might be wrong though, I’ll think about it)

op: (p1: P1, p2: P2, ...) => M<T>