Monad in TypeScript

import { Option, some, none, option } from 'fp-ts/lib/Option'
import { array } from 'fp-ts/lib/Array'
import { sequence } from 'fp-ts/lib/Traversable'

export function getAllSomesOrNone<A>(xs: Array<Option<A>>): Option<Array<A>> {
  return sequence(option, array)(xs)
}

console.log(getAllSomesOrNone([some(1), some(2), some(3)])) // => some([1, 2, 3])
console.log(getAllSomesOrNone([some(1), none, some(3)])) // => none

// Traversable.ts より一部を抜粋

// applicativeはモナドcにくるまった関数a -> bを、c[a] -> c[b]な関数に変換する
export function traverse<F, T>(
  F: Applicative<F>,
  T: Traversable<T>
): <A, B>(ta: HKT<T, A>, f: (a: A) => HKT<F, B>) => HKT<F, HKT<T, B>> {
  return T.traverse(F)
}

export interface Traversable<T> extends Functor<T>, Foldable<T> {
  readonly traverse: <F>(F: Applicative<F>) => <A, B>(ta: HKT<T, A>, f: (a: A) => HKT<F, B>) => HKT<F, HKT<T, B>>
}

// HKT: Higher Kinded Types(高階型)
// "型の型"を定義する
export function sequence<F, T>(
  f: Applicative<F>,
  t: Traversable<T>
): <A>(tfa: HKT<T, HKT<F, A>>) => HKT<F, HKT<T, A>> {
  return tfa => t.traverse(f)(tfa, fa => fa)
}

// URIは、Monadの識別子で単なる文字列("Option", "List"など)
export function sequence<F extends URIS, T extends URIS>(
  f: Applicative1<F>,
  t: Traversable1<T>
): <A>(tfa: Type<T, Type<F, A>>) => Type<F, Type<T, A>>

import { Either, left, right } from 'fp-ts/lib/Either'

export function elementAt<A>(xs: Array<A>, i: number): Either<string, A> {
  if (i < 0) {
    return left<string, A>('out of lower bound')
  }
  if (i >= xs.length) {
    return left<string, A>('out of upper bound')
  }
  return right<string, A>(xs[i])
}

console.log(elementAt([1, 2, 3], -1)) // => left('out of lower bound')
console.log(elementAt([1, 2, 3], 10)) // => left('out of upper bound')
console.log(elementAt([1, 2, 3], 1))  // => right(2)

import Control.Monad.State

main :: IO ()
main = runStateT code [1..] >> return ()
--
-- layer an infinite list of uniques over the IO monad
--

code :: StateT [Integer] IO ()
code = do
    x <- pop
    io $ print x
    y <- pop
    io $ print y
    z <- pop
    io $ print z
    return ()

--
-- pop the next unique off the stack
--
pop :: StateT [Integer] IO Integer
pop = do
    (x:xs) <- get
    put xs
    return x

io :: IO a -> StateT [Integer] IO a
io = liftIO

import * as stateT from 'fp-ts/lib/StateT'
import { io, IO } from 'fp-ts/lib/IO'
import { Monad2 } from 'fp-ts/lib/Monad'
import { Endomorphism } from 'fp-ts/lib/function'
import * as array from 'fp-ts/lib/Array'
import { State } from 'fp-ts/lib/State'

declare module 'fp-ts/lib/HKT' {
  interface URI2HKT2<L, A> {
    StateIO: StateIO<L, A>
  }
}

const stateTIO = stateT.getStateT(io)

export const URI = 'StateIO'

export type URI = typeof URI

export class StateIO<S, A> {
  readonly _A!: A
  readonly _L!: S
  readonly _URI!: URI
  constructor(readonly value: (s: S) => IO<[A, S]>) {}
  run(s: S): [A, S] {
    return this.value(s).run()
  }
  eval(s: S): A {
    return this.run(s)[0]
  }
  exec(s: S): S {
    return this.run(s)[1]
  }
  map<B>(f: (a: A) => B): StateIO<S, B> {
    return new StateIO(stateTIO.map(f, this.value))
  }
  ap<B>(fab: StateIO<S, (a: A) => B>): StateIO<S, B> {
    return new StateIO(stateTIO.ap(fab.value, this.value))
  }
  ap_<B, C>(this: StateIO<S, (b: B) => C>, fb: StateIO<S, B>): StateIO<S, C> {
    return fb.ap(this)
  }
  chain<B>(f: (a: A) => StateIO<S, B>): StateIO<S, B> {
    return new StateIO(stateTIO.chain(a => f(a).value, this.value))
  }
}

const map = <S, A, B>(fa: StateIO<S, A>, f: (a: A) => B): StateIO<S, B> => {
  return fa.map(f)
}

const of = <S, A>(a: A): StateIO<S, A> => {
  return new StateIO(stateTIO.of(a))
}

const ap = <S, A, B>(fab: StateIO<S, (a: A) => B>, fa: StateIO<S, A>): StateIO<S, B> => {
  return fa.ap(fab)
}

const chain = <S, A, B>(fa: StateIO<S, A>, f: (a: A) => StateIO<S, B>): StateIO<S, B> => {
  return fa.chain(f)
}

const stateTget = stateT.get(io)
export const get = <S>(): StateIO<S, S> => {
  return new StateIO(stateTget())
}

const stateTput = stateT.put(io)
export const put = <S>(s: S): StateIO<S, void> => {
  return new StateIO(stateTput(s))
}

const stateTmodify = stateT.modify(io)
export const modify = <S>(f: Endomorphism<S>): StateIO<S, void> => {
  return new StateIO(stateTmodify(f))
}

const stateTgets = stateT.gets(io)
export const gets = <S, A>(f: (s: S) => A): StateIO<S, A> => {
  return new StateIO(stateTgets(f))
}

const stateTliftF = stateT.liftF(io)
export const fromIO = <S, A>(fa: IO<A>): StateIO<S, A> => {
  return new StateIO(stateTliftF(fa))
}

const stateTfromState = stateT.fromState(io)
export const fromState = <S, A>(fa: State<S, A>): StateIO<S, A> => {
  return new StateIO(stateTfromState(fa))
}

export const stateIO: Monad2<URI> = {
  URI,
  map,
  of,
  ap,
  chain
}

//
// Usage (adapted from https://wiki.haskell.org/Simple_StateT_use)
//

import { log } from 'fp-ts/lib/Console'

/** pop the next unique off the stack */
const pop: StateIO<Array<number>, number> = get<Array<number>>().chain(ns =>
  array.foldL(ns, () => of(0), (h, t) => put(t).chain(() => of(h)))
)

const program1: StateIO<Array<number>, void> = pop
  .chain(x => fromIO(log(x)))
  .chain(() => pop)
  .chain(y => fromIO(log(y)))
  .chain(() => of(undefined))

program1.run([1, 2, 3])