@typed/fx 0.0.1

package/src/Stream/drain.ts

@@ -0,0 +1,73 @@
+import { pipe } from 'hkt-ts'
+
+import { Stream } from './Stream.js'
+
+import { Fiber } from '@/Fiber/Fiber.js'
+import { FiberContext } from '@/FiberContext/FiberContext.js'
+import { FiberRef } from '@/FiberRef/FiberRef.js'
+import { update } from '@/FiberRef/operations.js'
+import * as Fx from '@/Fx/index.js'
+import { Scheduler } from '@/Scheduler/Scheduler.js'
+import { Drain, Sink, makeDrain } from '@/Sink/Sink.js'
+
+export function drain<R, E, A>(
+  stream: Stream<R, E, A>,
+  __trace?: string,
+): Fx.Fx<R | Scheduler, never, Fiber<E, A>> {
+  return pipe(
+    Fx.Do,
+    Fx.bind('fiberContext', () => Fx.getFiberContext),
+    Fx.let('context', ({ fiberContext }) => fiberContext.fork()),
+    Fx.let('sink', ({ context }) => new Drain<E, A>(context.scope)),
+    Fx.flatMap(({ sink, context }) => fork(stream, sink, context), __trace),
+  )
+}
+
+export function fork<R, E, A, E2 = never>(
+  stream: Stream<R, E, A>,
+  sink: Sink<E | E2, A>,
+  context: FiberContext,
+): Fx.Fx<R | Scheduler, never, Fiber<E | E2, A>> {
+  return Fx.asks(Scheduler)((scheduler) => stream.fork(sink, scheduler, context))
+}
+
+export function observe<A, R2, E2, B>(f: (a: A) => Fx.Fx<R2, E2, B>, __trace?: string) {
+  return <R, E>(stream: Stream<R, E, A>): Fx.Fx<R | R2 | Scheduler, never, Fiber<E | E2, A>> =>
+    pipe(
+      Fx.Do,
+      Fx.bind('fiberContext', () => Fx.getFiberContext),
+      Fx.let('context', ({ fiberContext }) => fiberContext.fork()),
+      Fx.bind('sink', ({ context }) => makeDrain<E, A, R2, E2>(context.scope, { event: f })),
+      Fx.flatMap(({ sink, context }) => fork(stream, sink, context), __trace),
+    )
+}
+
+export function collect<R, E, A>(
+  stream: Stream<R, E, A>,
+  __trace?: string,
+): Fx.Fx<R | Scheduler, E, readonly A[]> {
+  return pipe(
+    Fx.fromLazy(() => FiberRef.make(Fx.now<readonly A[]>([]))),
+    Fx.bindTo('fiberRef'),
+    Fx.bind('fiberContext', () => Fx.getFiberContext),
+    Fx.let('context', ({ fiberContext }) => fiberContext.fork()),
+    Fx.bind('sink', ({ context, fiberRef }) =>
+      makeDrain<E, A, R, E>(context.scope, {
+        event: (a) =>
+          pipe(
+            fiberRef,
+            update((as) => [...as, a]),
+          ),
+      }),
+    ),
+    Fx.flatMap(
+      ({ sink, context, fiberRef }) =>
+        pipe(
+          fork(stream, sink, context),
+          Fx.flatMap(Fx.join),
+          Fx.flatMap(() => Fx.getFiberRef(fiberRef)),
+        ),
+      __trace,
+    ),
+  )
+}

package/src/Stream/fromFx.test.ts

@@ -0,0 +1,39 @@
+import { deepStrictEqual } from 'assert'
+
+import { pipe } from 'hkt-ts'
+
+import { collect, observe } from './drain.js'
+import { fromFx } from './fromFx.js'
+
+import { runTest } from '@/Fx/Fx.test.js'
+import * as Fx from '@/Fx/index.js'
+import { RootScheduler } from '@/Scheduler/RootScheduler.js'
+import { Scheduler } from '@/Scheduler/Scheduler.js'
+
+describe(new URL(import.meta.url).pathname, () => {
+  describe(fromFx.name, () => {
+    const value = Math.random()
+    const stream = fromFx(Fx.success(value))
+
+    it('should create a Stream', () =>
+      pipe(
+        stream,
+        observe((n) => Fx.fromLazy(() => deepStrictEqual(n, value))),
+        Fx.flatMap(Fx.join),
+        Fx.provideService(Scheduler, RootScheduler()),
+        runTest,
+      ))
+
+    it('should be collectable', async () => {
+      await pipe(
+        Fx.Fx(function* () {
+          const events = yield* collect(stream)
+
+          deepStrictEqual(events, [value])
+        }),
+        Fx.provideService(Scheduler, RootScheduler()),
+        runTest,
+      )
+    })
+  })
+})

package/src/Stream/fromFx.ts

@@ -0,0 +1,27 @@
+import { flow, pipe } from 'hkt-ts'
+
+import { Stream } from './Stream.js'
+
+import { Env } from '@/Env/Env.js'
+import * as Fx from '@/Fx/Fx.js'
+
+export function fromFx<R, E, A>(fx: Fx.Fx<R, E, A>): Stream<R, E, A> {
+  return Stream((sink, scheduler, context) =>
+    Fx.asksEnv((env: Env<R>) =>
+      scheduler.asap(
+        pipe(
+          fx,
+          Fx.matchCause(
+            sink.error,
+            flow(
+              sink.event,
+              Fx.flatMap(() => sink.end),
+            ),
+          ),
+        ),
+        env,
+        context,
+      ),
+    ),
+  )
+}

package/src/Stream/index.ts

@@ -0,0 +1,3 @@
+export * from './drain.js'
+export * from './fromFx.js'
+export * from './Stream.js'

package/src/Supervisor/Supervisor.ts

@@ -0,0 +1,49 @@
+import { constVoid } from 'hkt-ts'
+
+import { AnyExit } from '@/Exit/Exit.js'
+import { AnyLiveFiber } from '@/Fiber/Fiber.js'
+import { AnyFx, Of, unit, zipAll } from '@/Fx/Fx.js'
+import { AnyInstruction } from '@/Fx/Instruction.js'
+
+export class Supervisor<A> {
+  constructor(
+    readonly value: Of<A>,
+    readonly onStart: (fiber: AnyLiveFiber, fx: AnyFx) => void = constVoid,
+    readonly onEnd: (fiber: AnyLiveFiber, exit: AnyExit) => void = constVoid,
+    readonly onInstruction: (fiber: AnyLiveFiber, instruction: AnyInstruction) => void = constVoid,
+    readonly onSuspended: (fiber: AnyLiveFiber) => void = constVoid,
+    readonly onRunning: (fiber: AnyLiveFiber) => void = constVoid,
+  ) {}
+}
+
+export const None = new (class None extends Supervisor<any> {})(unit)
+export type None = typeof None
+
+export const isNone = <A>(supervisor: Supervisor<A>): supervisor is None => supervisor === None
+
+export function and<B>(second: Supervisor<B>) {
+  return <A>(first: Supervisor<A>) =>
+    new Supervisor<readonly [A, B]>(
+      zipAll([first.value, second.value]),
+      (fiber, fx) => {
+        first.onStart(fiber, fx)
+        second.onStart(fiber, fx)
+      },
+      (fiber, exit) => {
+        first.onEnd(fiber, exit)
+        second.onEnd(fiber, exit)
+      },
+      (fiber, instr) => {
+        first.onInstruction(fiber, instr)
+        second.onInstruction(fiber, instr)
+      },
+      (fiber) => {
+        first.onSuspended(fiber)
+        second.onSuspended(fiber)
+      },
+      (fiber) => {
+        first.onRunning(fiber)
+        second.onRunning(fiber)
+      },
+    )
+}

package/src/Supervisor/index.ts

@@ -0,0 +1 @@
+export * from './Supervisor.js'

package/src/Tagged/index.ts

@@ -0,0 +1,127 @@
+/* eslint-disable @typescript-eslint/no-unused-vars */
+/**
+ * Tagged is a module to help you construct Tagged types, which
+ * are a means of creating nominal-like types in TypeScript.
+ */
+
+import { Constrain, HKT2, Params, Variance } from 'hkt-ts/HKT'
+import type * as Associative from 'hkt-ts/Typeclass/Associative'
+import * as AB from 'hkt-ts/Typeclass/AssociativeBoth'
+import type { Bounded } from 'hkt-ts/Typeclass/Bounded'
+import type * as Commutative from 'hkt-ts/Typeclass/Commutative'
+import type { Concat } from 'hkt-ts/Typeclass/Concat'
+import * as C from 'hkt-ts/Typeclass/Covariant'
+import type { Eq } from 'hkt-ts/Typeclass/Eq'
+import type { Identity } from 'hkt-ts/Typeclass/Identity'
+import type { Inverse } from 'hkt-ts/Typeclass/Inverse'
+import type { Ord } from 'hkt-ts/Typeclass/Ord'
+import type * as T from 'hkt-ts/Typeclass/Top'
+import { unsafeCoerce } from 'hkt-ts/function'
+import { M as B } from 'ts-toolbelt'
+
+export const TAG = Symbol('@typed/fx/Tag')
+export type TAG = typeof TAG
+
+/**
+ * Tag is encoded with as a Covariant type which allows for subtyping,
+ * unlike Brand (from hkt-ts/Branded) which allows super-types via its Contravariant encoding of BRAND.
+ */
+export type Tag<T> = { readonly [TAG]: () => T }
+
+/**
+ * @category Type-level
+ */
+export type TagOf<A> = [A] extends [Tagged<infer Brand, infer _>] ? Brand : unknown
+
+/**
+ * @category Type-level
+ */
+export type ValueOf<A> = A extends Tagged<TagOf<A>, infer R> ? R : never
+
+/**
+ * @category Model
+ */
+export type Tagged<T, Type> = Type & Tag<T>
+
+/**
+ * @category Type-level
+ */
+export type Combine<T, U> = ValueOf<T> & ValueOf<U> & Tag<TagOf<T> & TagOf<U>>
+
+/**
+ * @category Constructor
+ */
+export const Tagged = <A extends Tagged<any, any>>() => {
+  const constructor_ = <E extends ValueOf<A>>(e: E): Tagged<TagOf<A>, E> => unsafeCoerce(e)
+
+  constructor_.makeEq = (A: Eq<ValueOf<A>>): Eq<A> => unsafeCoerce(A)
+
+  constructor_.makeOrd = (A: Ord<ValueOf<A>>): Ord<A> => unsafeCoerce(A)
+
+  constructor_.makeBounded = (A: Bounded<ValueOf<A>>): Bounded<A> => unsafeCoerce(A)
+
+  constructor_.makeIdentity = (A: Identity<ValueOf<A>>): Identity<A> => unsafeCoerce(A)
+
+  constructor_.makeConcat = (A: Concat<ValueOf<A>>): Concat<A> => unsafeCoerce(A)
+
+  constructor_.makeAssociative = (
+    A: Associative.Associative<ValueOf<A>>,
+  ): Associative.Associative<A> => unsafeCoerce(A)
+
+  constructor_.makeCommutative = (
+    A: Commutative.Commutative<ValueOf<A>>,
+  ): Commutative.Commutative<A> => unsafeCoerce(A)
+
+  constructor_.makeInverse = (A: Inverse<ValueOf<A>>): Inverse<A> => unsafeCoerce(A)
+
+  return constructor_
+}
+
+export const tag: <A extends Tagged<any, any>>(value: ValueOf<A>) => A = unsafeCoerce
+
+export const untag: <A extends Tagged<any, any>>(value: A) => ValueOf<A> = unsafeCoerce
+
+/**
+ * Helper for removing all Branded values from a given type. Can be helpful for generating
+ * an incoming type from a domain type.
+ */
+export type StripTagged<A> = A extends B.Primitive | Date
+  ? ValueOf<A>
+  : {
+      readonly [K in keyof A]: StripTagged<A[K]>
+    }
+
+export interface TaggedHKT extends HKT2 {
+  readonly type: Tagged<this[Params.E], this[Params.A]>
+}
+
+export const Covariant: C.Covariant2<TaggedHKT> = {
+  map: (f) => (k) => unsafeCoerce(f(k)),
+}
+
+export const map = Covariant.map
+export const bindTo = C.bindTo(Covariant)
+export const flap = C.flap(Covariant)
+export const tupled = C.tupled(Covariant)
+export const mapTo = C.mapTo(Covariant)
+
+export const AssociativeBoth: AB.AssociativeBoth2<TaggedHKT> = {
+  both: (s) => (f) => unsafeCoerce([f, s] as const),
+}
+
+export const both = AssociativeBoth.both
+export const tuple = AB.tuple<TaggedHKT>({ ...AssociativeBoth, ...Covariant })
+
+export const makeTop =
+  <Tag>() =>
+  <T>(
+    value: T,
+  ): T.Top2<
+    Constrain<
+      Constrain<TaggedHKT, Params.A, Variance.Invariant<T>>,
+      Params.E,
+      Variance.Contravariant<Tag>
+    >
+  > => ({
+    top: unsafeCoerce(value),
+  })

package/src/Time/index.ts

@@ -0,0 +1,62 @@
+import { Branded } from 'hkt-ts/Branded'
+import * as N from 'hkt-ts/number'
+
+/**
+ * Monotonic representation of millisecond-precision Time relative to some StartTime.
+ * This is used all over the codebase such that tests that depend on time can remain
+ * deterministic. It is often intersected with another type (like Date) that will
+ * allow turning Time back into that other type.
+ */
+export type Time = Branded<{ readonly Time: Time }, number>
+export const Time = Branded<Time>()
+
+export const TimeAssociative = Time.makeAssociative(N.AssociativeSum)
+export const TimeIdentity = Time.makeIdentity(N.IdentitySum)
+export const TimeCommutative = Time.makeCommutative(N.AssociativeSum)
+export const TimeEq = Time.makeEq(N.Eq)
+export const TimeInverse = Time.makeInverse(N.Inverse)
+export const TimeOrd = Time.makeOrd(N.Ord)
+export const TimeBounded = Time.makeBounded({ ...N.Bounded, bottom: 0 })
+
+/**
+ * Millisecond precision Unix Timestamp. MUST be directly useable in `new Date(UnixTime)`
+ */
+export type UnixTime = Branded<{ readonly UnixTime: UnixTime }, number>
+export const UnixTime = Branded<UnixTime>()
+
+declare global {
+  // Patch Date.now to return UnixTime
+  export interface DateConstructor {
+    now(): UnixTime
+  }
+}
+
+export const MIN_UNIX_TIME = UnixTime(0)
+export const MAX_UNIX_TIME = UnixTime(8.64e15) // WHAT WILL WE DO AFTER +275760-09-13T00:00:00.000Z???
+
+export const UnixTimeAssociative = UnixTime.makeAssociative(N.AssociativeSum)
+export const UnixTimeIdentity = UnixTime.makeIdentity(N.IdentitySum)
+export const UnixTimeCommutative = UnixTime.makeCommutative(N.AssociativeSum)
+export const UnixTimeEq = UnixTime.makeEq(N.Eq)
+export const UnixTimeInverse = UnixTime.makeInverse(N.Inverse)
+export const UnixTimeOrd = UnixTime.makeOrd(N.Ord)
+export const UnixTimeBounded = UnixTime.makeBounded({
+  ...N.Bounded,
+  bottom: MIN_UNIX_TIME,
+  top: MAX_UNIX_TIME,
+})
+
+/**
+ * Millisecond precision Delay, monotonic in relation to "now". Useful for describing
+ * things like `setTimeout(f, Delay)`
+ */
+export type Delay = Branded<{ readonly Delay: Delay }, number>
+export const Delay = Branded<Delay>()
+
+export const DelayAssociative = Delay.makeAssociative(N.AssociativeSum)
+export const DelayIdentity = Delay.makeIdentity(N.IdentitySum)
+export const DelayCommutative = Delay.makeCommutative(N.AssociativeSum)
+export const DelayEq = Delay.makeEq(N.Eq)
+export const DelayInverse = Delay.makeInverse(N.Inverse)
+export const DelayOrd = Delay.makeOrd(N.Ord)
+export const DelayBounded = Delay.makeBounded({ ...N.Bounded, bottom: 0 })

package/src/Timeline/index.ts

@@ -0,0 +1,157 @@
+import { Disposable } from '@/Disposable/Disposable.js'
+import { MAX_UNIX_TIME, UnixTime } from '@/Time/index.js'
+
+/**
+ * A Timeline is a time-ordered queue, which uses a binary search to quickly insert/remove values.
+ * It allows de-queuing all values from the Queue that are at or before a specific time.
+ */
+export interface Timeline<A> {
+  /**
+   * Returns the UnixTime at which a Task should be run.
+   */
+  readonly nextArrival: () => UnixTime
+
+  /**
+   * Returns true if the Timeline has no tasks
+   */
+  readonly isEmpty: () => boolean
+
+  /**
+   * Add a task to the timeline, returns a Dispsoable to remove
+   * the task from the timeline.
+   */
+  readonly add: (time: UnixTime, a: A) => Disposable
+
+  /**
+   * Extract all of the values held in the queue that is at or before the specified Time.
+   */
+  readonly getReadyTasks: (t: UnixTime) => readonly A[]
+}
+
+export function Timeline<A>(onUpdated?: () => void): Timeline<A> {
+  return new TimelineImpl(onUpdated)
+}
+
+class TimelineImpl<A> implements Timeline<A> {
+  protected timeSlots: TimeSlot<A>[] = []
+
+  constructor(readonly onUpdated?: () => void) {}
+
+  readonly nextArrival = (): UnixTime => {
+    if (this.isEmpty()) {
+      return MAX_UNIX_TIME
+    }
+
+    return this.timeSlots[0].time
+  }
+
+  readonly isEmpty = (): boolean => {
+    return this.timeSlots.length === 0
+  }
+
+  readonly add = (time: UnixTime, a: A): Disposable => {
+    insertByTime(time, a, this.timeSlots)
+    this.onUpdated?.()
+
+    return Disposable(() => this.remove(time, a))
+  }
+
+  protected remove = (time: UnixTime, a: A): boolean => {
+    const i = binarySearch(time, this.timeSlots)
+
+    if (i >= 0 && i < this.timeSlots.length) {
+      const events = this.timeSlots[i].events
+      const at = events.findIndex((x) => x === a)
+
+      if (at >= 0) {
+        events.splice(at, 1)
+
+        if (events.length === 0) {
+          this.timeSlots.splice(i, 1)
+        }
+
+        this.onUpdated?.()
+
+        return true
+      }
+    }
+
+    return false
+  }
+
+  readonly getReadyTasks = (t: UnixTime): readonly A[] => {
+    const tasks = this.timeSlots
+    const l = tasks.length
+    let i = 0
+
+    while (i < l && tasks[i].time <= t) {
+      ++i
+    }
+
+    return this.timeSlots.splice(0, i).flatMap((x) => x.events)
+  }
+}
+
+interface TimeSlot<A> {
+  readonly time: UnixTime
+  readonly events: A[]
+}
+
+function insertByTime<A>(time: UnixTime, a: A, timeslots: Array<TimeSlot<A>>): void {
+  const l = timeslots.length
+
+  if (l === 0) {
+    timeslots.push(makeTimeslot(time, [a]))
+
+    return
+  }
+
+  const i = binarySearch(time, timeslots)
+
+  if (i >= l) {
+    timeslots.push(makeTimeslot(time, [a]))
+  } else {
+    insertAtTimeslot(a, timeslots, time, i)
+  }
+}
+
+function insertAtTimeslot<A>(
+  task: A,
+  timeslots: Array<TimeSlot<A>>,
+  time: UnixTime,
+  i: number,
+): void {
+  const timeslot = timeslots[i]
+
+  if (time === timeslot.time) {
+    timeslot.events.push(task)
+  } else {
+    timeslots.splice(i, 0, makeTimeslot(time, [task]))
+  }
+}
+
+function binarySearch<A>(t: UnixTime, sortedArray: ArrayLike<TimeSlot<A>>): number {
+  let lo = 0
+  let hi = sortedArray.length
+  let mid, y
+
+  while (lo < hi) {
+    mid = Math.floor((lo + hi) / 2)
+    y = sortedArray[mid]
+
+    if (t === y.time) {
+      return mid
+    } else if (t < y.time) {
+      hi = mid
+    } else {
+      lo = mid + 1
+    }
+  }
+
+  return hi
+}
+
+const makeTimeslot = <A>(t: UnixTime, events: A[]): TimeSlot<A> => ({
+  time: t,
+  events: events,
+})

package/src/Timer/SetTimeoutTimer.ts

@@ -0,0 +1,19 @@
+import { Timer, make } from './Timer.js'
+
+import { Clock } from '@/Clock/Clock.js'
+import { DateClock } from '@/Clock/DateClock.js'
+import { Disposable, None } from '@/Disposable/Disposable.js'
+
+export function SetTimeoutTimer(clock: Clock = DateClock()): Timer {
+  return make(clock, (f, delay) => {
+    if (delay <= 0) {
+      queueMicrotask(() => f(clock.getCurrentTime()))
+
+      return None
+    }
+
+    const id = setTimeout(() => f(clock.getCurrentTime()), delay)
+
+    return Disposable(() => clearTimeout(id))
+  })
+}

package/src/Timer/TestTimer.ts

@@ -0,0 +1,39 @@
+import { flow } from 'hkt-ts'
+
+import { Timer } from './Timer.js'
+
+import * as Clock from '@/Clock/Clock.js'
+import { TestClock } from '@/Clock/TestClock.js'
+import { None } from '@/Disposable/Disposable.js'
+import { Time } from '@/Time/index.js'
+import { Timeline } from '@/Timeline/index.js'
+
+/**
+ * A Timer which provides imperative access to progressing Time forward.
+ */
+export interface TestTimer extends Timer, TestClock {}
+
+export function TestTimer(clock: TestClock = TestClock(), autoRun = true): TestTimer {
+  const timeline = Timeline<(t: Time) => void>()
+  const runReadyTimers = (t: Time) => (
+    timeline.getReadyTasks(Clock.timeToUnixTime(t)(clock)).forEach((f) => f(t)), t
+  )
+
+  return {
+    startTime: clock.startTime,
+    getCurrentTime: clock.getCurrentTime,
+    setTimer: (f, delay) => {
+      // If auto-run is enabled an delay is 0,
+      // synchronously run the callback.
+      if (autoRun && delay === 0) {
+        f(clock.getCurrentTime())
+
+        return None
+      }
+
+      return timeline.add(Clock.delayToUnixTime(delay)(clock), f)
+    },
+    progressTimeBy: flow(clock.progressTimeBy, runReadyTimers),
+    progressTimeTo: flow(clock.progressTimeTo, runReadyTimers),
+  }
+}

package/src/Timer/Timer.ts

@@ -0,0 +1,24 @@
+import * as C from '@/Clock/index.js'
+import { Disposable } from '@/Disposable/Disposable.js'
+import { Service } from '@/Service/index.js'
+import { Delay, Time } from '@/Time/index.js'
+
+export interface Timer extends C.Clock {
+  readonly setTimer: (f: (time: Time) => void, delay: Delay) => Disposable
+}
+
+export const Timer = Service<Timer>('Timer')
+
+export function make(clock: C.Clock, setTimer: Timer['setTimer']): Timer {
+  return {
+    ...clock,
+    setTimer,
+  }
+}
+
+export function fork(timer: Timer): Timer {
+  return {
+    ...timer,
+    ...C.fork(timer),
+  }
+}

package/src/Timer/index.ts

@@ -0,0 +1,3 @@
+export * from './SetTimeoutTimer.js'
+export * from './TestTimer.js'
+export * from './Timer.js'