deriving.js

// Simple functor derivation
const conName = Symbol("Constructor Name")
const polyVar = Symbol("Polymorpic Variable")
const nestSelf = Symbol("Nest Self")
const isLazy = Symbol("Lazy Eval")
const unit = Symbol("Unit")
const poly = name => ({ t: polyVar, name })
const self = name => ({ t: nestSelf, name })
const lazy = v => ({ [isLazy]: true, ...v })
const force = r => r()

const functorVar = Symbol("Functor Var")

const curryN = n => f => {
  const loop = a => acc => (a === 0 ? f(...acc) : x => loop(a - 1)([...acc, x]));
  return loop(n)([]);
};

const uncurry = f => {
  return (...args) => args.reduce((acc, n) => acc(n), f)
}

// This function takes an ADT and produces constructors and pattern matchers for it.
const deriveConstruct = ({ adt }) => {

  // Make a curried constructor function for a data constructor
  const constructorFn = k => xs => {
    const go = acc => n => y => {
      const { t, name, [isLazy]: lazy } = xs[n]
      const next = { [name]: lazy && !(typeof y === 'function') ? () => y : y, ...acc }
      return Object.keys(next).length === xs.length
        ? { [conName]: k, ...next }
        : go(next)(n + 1)
    }
    return go({})(0)
  }

  // Make a matching function for the constructors
  const match = cases => val => {
    const n = val[conName]
    const c = cases[n]
    return adt[n].reduce((fn, { name }) => fn(val[name]), c)
  }

  // Make all of the constructors for an ADT
  const construct = Object.keys(adt).reduce((acc, k) => {
    const v = adt[k]
    const c = v.length > 0 ? constructorFn(k)(v) : { [conName]: k }
    return { [k]: c, ...acc }
  }, {})

  return { construct, adt, match }
}

// Derives a Functor, given Construct
const deriveFunctor = tdef => {

  const { construct, match, adt } = tdef

  const handleSym = ({ t, name: n, [isLazy]: lazy }, v) => {
    const handlers = {
      [polyVar]: f => {
        const val = (name, _v) => name === adt[functorVar] ? f(_v) : _v
        return lazy ? () => val(n, v()) : val(n, v)
      },
      [nestSelf]: f => lazy ? () => map(f)(v()) : map(f)(v)
    }
    return handlers[t]
  }

  // Makes a map match case for a data constructor
  const makeMatchCase = (f, k) => (...args) => {
    const rs = adt[k].map((c, i) => {
      const v = args[i]
      const h = handleSym(c, v)(f)
      return h
    })
    return uncurry(construct[k])(...rs)
  }

  // Make the map match cases for an ADT
  const makeMatchCases = f => {
    const cases = Object.keys(adt).reduce((acc, k) => {
      const l = adt[k].length
      const c = l > 0
        ? curryN(l)(makeMatchCase(f, k))
        : construct[k]
      return { [k]: c, ...acc }
    }, {})
    return cases
  }

  const map = f => match(makeMatchCases(f))

  return { map, ...tdef }
}

const listADT = {
  Cons: [poly('val'), self('tail')],
  Nil: [],
  [functorVar]: 'val'
}

const lazyListADT = {
  Cons: [poly('val'), lazy(self('tail'))],
  Nil: [],
  [functorVar]: 'val'
}

const Arr = (() => {
  const Cons = head => tail => [head, ...tail];
  const Nil = [];
  const match = ({ Cons, Nil }) => arr => {
    return arr.length === 0 ? Nil : Cons(arr[0])(arr.slice(1));
  }
  return { ...deriveFunctor({ adt: listADT, construct: { Cons, Nil }, match }) };
})();

const { Cons, Nil } = Arr.construct
const arr = Cons(1)(Cons(2)(Cons(3)(Nil)))
console.log('Arr mapping: ', Arr.map(x => x + 1)(arr))

const List = (() => {
  const derived = deriveFunctor(deriveConstruct({ adt: lazyListADT }))
  const { match, map } = derived
  const { Cons, Nil } = derived.construct

  const scanl = f => q => match({
    Nil: Cons(q)(Nil),
    Cons: x => xs => Cons(q)(() => scanl(f)(f(q)(x))(xs()))
  })

  const take = n => match({
    Nil,
    Cons: x => xs =>
      n === 0
        ? Nil
        : Cons(x)(() => take(n - 1)(xs()))
  })

  return {
    take,
    scanl,
    ...derived
  }
})()
const { Cons: LCons, Nil: LNil } = List.construct

const toArr = List.match({
  Nil: [],
  Cons: x => xs => [x, ...toArr(xs())]
})

const l = LCons(1)(LCons(2)(LCons(3)(LNil)))

const r = List.map(x => { console.log('[r] List elem forced: ', x + 1); return x + 1 })(l)
console.log('[r] Accessing 2nd element of r: ', r.tail().val)

const r2 = List.map(x => { console.log('[r2] List elem forced: ', x + 1); return x + 1 })(l)
console.log('[r2] Converting r2 to an array: ', toArr(r2))

// is actually lazy
const fibs = List.scanl(x => y => x + y)(0)(LCons(1)(() => fibs))
console.log(toArr(List.take(100)(fibs)))