General State Monad w/ Reason Module Functions

state-monad.re

let id = x => x;
let ($) = (f, x) => f(x);
let flip = f => (x, y) => f(y, x);
let const = (x, _) => x;
let (<<<) = (f, g) => x => f(g(x));
let (>>>) = (f, g) => x => g(f(x));

module type Functor = {
  type f('a);
  let fmap: ('a => 'b) => f('a) => f('b);
}

module FunctorEx = (F: Functor) => {
  include F;
  let (<$>) = fmap;
  let (<&>) = (x, f) => fmap(f, x);
  let (<$) = (r, x) => fmap(const(r), x);
  let ($>) = (x, r) => fmap(const(r), x);
  let void = (f, x) => fmap(x => ignore(f(x)), x);
}

module type Monad = {
  type m('a);
  let bind: m('a) => ('a => m('b)) => m('b);
}

module MonadEx = (M: Monad) => {
  include M;
  let (>>=) = bind;
  let (>>) = (a, b) => a >>= (_ => b);
  let (<<) = (b, a) => a >>= (_ => b);
}

type state('s, 'a) = 's => ('a, 's);

module StateF_ = (Species: { type t; }): (Functor with type f('a) = state(Species.t, 'a)) => {
  type f('a) = state(Species.t, 'a);
  let fmap = (f, x) => s => {
    let (a, s_next) = x(s);
    (f(a), s_next)
  };
}

module StateM_ = (Species: { type t; }): (Monad with type m('a) = state(Species.t, 'a)) => {
  type m('a) = state(Species.t, 'a);
  let bind = (a, bb) => s => {
    let (a_next, s_next) = a(s);
    bb(a_next)(s_next)
  };
}

module StateFunctor = (Species: { type t }) => FunctorEx(StateF_(Species));
module StateMonad = (Species: { type t }) => MonadEx(StateM_(Species));

module IntSpecies = { type t = int };

module IntStateFunctor = StateFunctor(IntSpecies);
module IntStateMonad = StateMonad(IntSpecies);

open IntStateFunctor;
open IntStateMonad;

let add = (x, y) => x + y;
let put = s => _ => ((), s);
let get = s => (s, s);
let a: state(int, int) = s => (0, s);

a >> get <&> add(7) <&> Js.log $ 5; // output: 12