Skip to content

Instantly share code, notes, and snippets.

@isthatcentered

isthatcentered/Disk.ts

Last active January 23, 2023 13:29
Show Gist options
  • Save isthatcentered/889377d316ff23219a9f8b0a97088afc to your computer and use it in GitHub Desktop.
Save isthatcentered/889377d316ff23219a9f8b0a97088afc to your computer and use it in GitHub Desktop.
Download ZIP
Typescript Free Monad
Raw
Disk.ts
import { Tagged } from "@effect-ts/core/Case"
import * as P from "../../prelude"
import * as Free from "./FreeMonad"
import { makeFree } from "./FreeMonad"
import { identity, pipe } from "@effect-ts/core/Function"
import * as T from "@effect-ts/core/Effect"
import { matchTag } from "@effect-ts/core/Utils"
import * as FS from "fs"
import * as Ei from "@effect-ts/core/Either"
export class Read<A> extends Tagged("Read")<{ path: string; _A: (a: string) => A }> {}
export class Write<A> extends Tagged("Write")<{
path: string
content: string
_A: (a: undefined) => A
}> {}
export class Delete<A> extends Tagged("Delete")<{ path: string; _A: (a: undefined) => A }> {}
export type Disk<A> = Read<A> | Write<A> | Delete<A>
export interface DiskF extends P.HKT {
readonly type: Disk<this["A"]>
}
const { chain, map, lift, pure } = makeFree<DiskF>()
export { chain, map }
export const read = (path: string) => lift(new Read({ path, _A: identity }))
export const write = (path: string, content: string) =>
lift(new Write({ path, content, _A: identity }))
export const remove = (path: string) => lift(new Delete({ path, _A: identity }))
// -------------------------------------------------------------------------------------
// Example
// -------------------------------------------------------------------------------------
const moveFile = (from: string, to: string) =>
pipe(
read(from),
chain(content => write(to, content)),
chain(_ => remove(from)),
)
export interface EffectF extends P.HKT {
readonly type: T.Effect<this["R"], this["E"], this["A"]>
}
const EffectMonad: P.Monad<EffectF> = {
chain: T.chain,
map: T.map,
of: T.succeed,
}
const readFile = (path: string) =>
T.promise(
() =>
new Promise<Ei.Either<unknown, string>>(resolve =>
FS.readFile(path, { encoding: "utf-8" }, (err, data) => {
if (!err) return resolve(Ei.right(data))
resolve(Ei.left(err)) // Typed error would obviously be better
}),
),
)
const FileSystemInterpreter = <R, E, A>(program: Free.Free<DiskF, R, E, A>): T.Effect<R, E, A> =>
pipe(
program,
Free.foldMap(EffectMonad)<DiskF>(
matchTag({
Read: _ =>
pipe(
readFile(_.path),
T.absolve, // Swallow the Either, we have Effect<unknown, never, Either<unknown, string>>, the DSL says we must return Effect<unknown, never, string>
T.orDie, // Swallow the typed error
T.map(_._A),
),
Write: _ => T.die("Pretty much the same as readfile"),
Delete: _ => T.die("Pretty much the same as readfile"),
}),
),
)
const moveHelloTS = pipe(moveFile("hello.ts", "goodby.ts"), FileSystemInterpreter, T.runPromiseExit)
Raw
Free.ts
import { Tagged } from "@effect-ts/core/Case"
import * as P from "../../prelude"
import { pipe, flow, identity } from "@effect-ts/core/Function"
import { matchTag } from "@effect-ts/core/Utils"
// -------------------------------------------------------------------------------------
// Model
// -------------------------------------------------------------------------------------
class Pure<F extends P.HKT, R, E, A> extends Tagged("Pure")<{
_F: (f: never) => F
_R: (r: unknown) => R
_E: (e: never) => E
a: A
}> {}
class Lift<F extends P.HKT, R, E, A> extends Tagged("Lift")<{
fa: P.Kind<F, R, E, A>
}> {}
class Chain<F extends P.HKT, R, E, A> extends Tagged("Chain")<{
use: <X>(
go: <R1, E1, A1, R2, E2, A2>(params: {
fa: Free<F, R1, E1, A1>
ffb: (a: A1) => Free<F, R2, E2, A2>
_R: (r: R) => R1 & R2
_E: (e: E1 | E2) => E
_A: (A: A2) => A
}) => X,
) => X
}> {}
export type Free<F extends P.HKT, R, E, A> =
| Pure<F, R, E, A>
| Lift<F, R, E, A>
| Chain<F, R, E, A>
// -------------------------------------------------------------------------------------
// Combinators
// -------------------------------------------------------------------------------------
export const pure =
<F extends P.HKT>() =>
<A>(a: A): Free<F, unknown, never, A> =>
new Pure({ _F: identity, _R: identity, _E: identity, a })
export const lift =
<F extends P.HKT>() =>
<R, E, A>(fa: P.Kind<F, R, E, A>): Free<F, R, E, A> =>
new Lift({
fa,
})
export const chain =
<F extends P.HKT>() =>
<R2, E2, A, B>(ffb: (a: A) => Free<F, R2, E2, B>) =>
<R1, E1>(fa: Free<F, R1, E1, A>): Free<F, R1 & R2, E1 | E2, B> =>
new Chain({
use: go =>
go({
ffb,
fa,
_R: identity,
_E: identity,
_A: identity,
}),
})
export const map =
<F extends P.HKT>() =>
<A, B>(f: (a: A) => B) =>
<R, E>(fa: Free<F, R, E, A>): Free<F, R, E, B> =>
pipe(fa, chain<F>()(flow(f, pure<F>())))
export const foldMap =
<G extends P.HKT>(M: P.Monad<G>) =>
<F extends P.HKT>(nt: <R, E, A>(f: P.Kind<F, R, E, A>) => P.Kind<G, R, E, A>) =>
<R, E, A>(self: Free<F, R, E, A>): P.Kind<G, R, E, A> =>
pipe(
self,
matchTag({
Pure: _ => M.of(_.a),
Lift: _ => nt(_.fa),
Chain: _ =>
_.use(({ fa, ffb, _A }) =>
pipe(
foldMap(M)(nt)(fa), //
M.chain(flow(ffb, foldMap(M)(nt))),
M.map(_A), // help typescript understand that `A2` from `Chain` class is the same as `A`
a => a as P.Kind<G, any, any, A>, // We don't have a way to `map` the `R` or `E` type with a monad so cast it is
),
),
}),
)
export const makeFree = <F extends P.HKT>() => ({
pure: pure<F>(),
lift: lift<F>(),
map: map<F>(),
chain: chain<F>(),
})
Raw
prelude.ts
import * as EI from "@effect-ts/core/Either"
import { pipe } from "@effect-ts/core/Function"
export declare const URI: unique symbol
export interface Typeclass<F extends HKT> {
readonly [URI]?: F
}
export interface HKT {
readonly R?: unknown
readonly E?: unknown
readonly A?: unknown
readonly type?: unknown
}
export type Kind<F extends HKT, R, E, A> = F extends { readonly type: unknown }
? (F & {
readonly R: R
readonly E: E
readonly A: A
})["type"]
: {
readonly _F: F
readonly _R: (_: R) => void
readonly _E: () => E
readonly _A: () => A
}
export interface ComposeF<F extends HKT, G extends HKT> extends HKT {
readonly type: Kind<
F,
this["R"],
this["E"],
Kind<G, this["R"], this["E"], this["A"]>
>
}
export interface Functor<F extends P.HKT> extends P.Typeclass<F> {
readonly map: <A, B>(
f: (a: A) => B,
) => <R, E>(fa: P.Kind<F, R, E, A>) => P.Kind<F, R, E, B>
}
export interface Pointed<F extends P.HKT> extends Functor<F> {
readonly of: <A>(a: A) => P.Kind<F, unknown, never, A>
}
export interface Apply<F extends P.HKT> extends Functor<F> {
readonly ap: <R, E1, A>(
fa: P.Kind<F, R, E1, A>,
) => <R1, E, B>(
fab: P.Kind<F, R1, E, (a: A) => B>,
) => P.Kind<F, R & R1, E | E1, B>
}
export function getApply<F extends P.HKT>(F: Monad<F>): Apply<F> {
return {
map: F.map,
ap: <R1, E1, A>(fa: P.Kind<F, R1, E1, A>) => <R2, E, B>(
fab: P.Kind<F, R2, E, (a: A) => B>,
) =>
pipe(
fa,
F.chain(a =>
pipe(
fab,
F.map(f => f(a)),
),
),
),
}
}
export interface Applicative<F extends P.HKT> extends Pointed<F>, Apply<F> {}
export function getApplicative<F extends P.HKT>(F: Monad<F>): Applicative<F> {
return {
...getApply(F),
of: F.of,
}
}
export interface Monad<F extends P.HKT> extends Pointed<F> {
readonly chain: <A, R1, E1, B>(
f: (a: A) => P.Kind<F, R1, E1, B>,
) => <R, E>(fa: P.Kind<F, R, E, A>) => P.Kind<F, R & R1, E | E1, B>
}
export interface Traversable<F extends P.HKT> extends P.Typeclass<F> {
readonly traverse: <G extends P.HKT>(
G: Applicative<G>,
) => <A, B, RG, EG>(
f: (a: A) => P.Kind<G, RG, EG, B>,
) => <RF, EF>(
self: P.Kind<F, RF, EF, A>,
) => P.Kind<G, RG, EG, P.Kind<F, RF, EF, B>>
}
export interface Semigroup<A> {
readonly concat: (left: A, right: A) => A
}
export interface Eitherable<F extends P.HKT> extends P.Typeclass<F> {
readonly either: <R, E, A>(
fa: P.Kind<F, R, E, A>,
) => P.Kind<F, R, never, EI.Either<E, A>>
}
export interface Failable<F extends P.HKT> extends P.Typeclass<F> {
readonly fail: <E>(fa: E) => P.Kind<F, unknown, E, never>
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment