Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
// Adapted from http://lukajcb.github.io/blog/functional/2018/01/03/optimizing-tagless-final.html
import { Applicative, Applicative1 } from 'fp-ts/lib/Applicative'
import { Apply, Apply1, Apply2C, applySecond, liftA4 } from 'fp-ts/lib/Apply'
import * as array from 'fp-ts/lib/Array'
import * as const_ from 'fp-ts/lib/Const'
import { HKT, Type, Type2, URIS, URIS2 } from 'fp-ts/lib/HKT'
import { IO, io, URI as IOURI } from 'fp-ts/lib/IO'
import { Option, some } from 'fp-ts/lib/Option'
import { getProductSemigroup, Semigroup } from 'fp-ts/lib/Semigroup'
import { Setoid, setoidString } from 'fp-ts/lib/Setoid'
import { getMonoid, singleton, StrMap, traverseWithKey } from 'fp-ts/lib/StrMap'
interface KVStore<F> {
get: (k: string) => HKT<F, Option<string>>
put: (k: string, v: string) => HKT<F, void>
}
interface KVStore1<F extends URIS> {
get: (k: string) => Type<F, Option<string>>
put: (k: string, v: string) => Type<F, void>
}
interface KVStore2C<F extends URIS2, L> {
get: (k: string) => Type2<F, L, Option<string>>
put: (k: string, v: string) => Type2<F, L, void>
}
function program<F extends URIS2, L>(F: Apply2C<F, L> & KVStore2C<F, L>): Type2<F, L, Array<string>>
function program<F extends URIS>(F: Apply1<F> & KVStore1<F>): Type<F, Array<string>>
function program<F>(F: Apply<F> & KVStore<F>): HKT<F, Array<string>> {
return liftA4(F)<Option<string>, Option<string>, void, Option<string>, Array<string>>(a => b => _ => c =>
array.catOptions([a, b, c])
)(F.get('Cats'))(F.get('Dogs'))(F.put('Mice', '42'))(F.get('Cats'))
}
// using an array as a poor man set
type M = [Array<string>, StrMap<string>]
class Const<A> extends const_.Const<M, A> {
constructor(set: Array<string>, map: StrMap<string>) {
super([set, map])
}
}
const getSetSemigroup = <A>(S: Setoid<A>): Semigroup<Array<A>> => {
return {
concat: (x, y) => x.concat(y.filter(ey => !x.some(ex => S.equals(ex, ey))))
}
}
const A = const_.getApply(getProductSemigroup(getSetSemigroup(setoidString), getMonoid<string>()))
const analysisInterpreter: Apply2C<const_.URI, M> & KVStore2C<const_.URI, M> = {
...A,
get: (k: string) => new Const<Option<string>>([k], new StrMap({})),
put: (k: string, v: string) => new Const<undefined>([], singleton(k, v))
}
console.log('-- analysisInterpreter --')
console.log(program<const_.URI, M>(analysisInterpreter).value)
// output:
// -- analysisInterpreter --
// [ [ 'Cats', 'Dogs' ], StrMap { value: { Mice: '42' } } ]
const ioInterpreter: Applicative1<IOURI> & KVStore1<IOURI> = {
URI: io.URI,
map: io.map,
of: io.of,
ap: io.ap,
get: (k: string) =>
new IO(() => {
console.log(`get ${k}`)
return some(`${k}-value`)
}),
put: (k: string, v: string) =>
new IO(() => {
console.log(`put ${k} ${v}`)
})
}
console.log('-- ioInterpreter --')
program(ioInterpreter).run()
// output:
// -- ioInterpreter --
// get Cats
// get Dogs
// put Mice 42
// get Cats
function optimizedProgram<F extends URIS, L>(F: Applicative1<F> & KVStore1<F>): Type<F, Array<Option<string>>>
function optimizedProgram<F>(F: Applicative<F> & KVStore<F>): HKT<F, Array<Option<string>>> {
const [gets, puts] = program<const_.URI, M>(analysisInterpreter).value
const fputs = traverseWithKey(F)(puts, (k, v) => F.put(k, v))
const fgets = array.traverse(F)(gets, F.get)
return applySecond(F)(fputs, fgets)
}
console.log('-- optimizedProgram with ioInterpreter --')
optimizedProgram(ioInterpreter).run()
// output:
// -- optimizedProgram with ioInterpreter --
// put Mice 42
// get Cats
// get Dogs
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.