Reason version of http://blog.haberkucharsky.com/technology/2015/07/21/more-monads-in-ocaml.html code

candy_dispenser.re

type input =
  | Insert_coin
  | Turn;

module Machine_state = {
  type t = {
    locked: bool,
    candies: int,
    coins: int,
  };
};

type t = Machine_state.t;

let make = (~candies, ~coins) =>
  Machine_state.{locked: true, candies, coins};

module Machine = State.Make(Machine_state);

let insert_coin =
  Machine.modify(s =>
    Machine_state.(
      if (s.locked && s.coins > 0) {
        {...s, locked: false, coins: s.coins + 1};
      } else {
        s;
      }
    )
  );

let turn =
  Machine.modify(s =>
    Machine_state.(
      if (s.locked) {
        s;
      } else {
        {...s, locked: true, candies: s.candies - 1};
      }
    )
  );

let next = input =>
  Machine_state.(
    Machine.Monad.(
      Machine.get
      >>= (
        s =>
          if (s.candies == 0) {
            pure();
          } else {
            switch (input) {
            | Turn => turn
            | Insert_coin => insert_coin
            };
          }
      )
    )
  );

let run = (inputs, t) =>
  Machine_state.(
    Machine.Monad.sequence(List.map(next, inputs))
    |> Machine.run(t)
    |> fst
    |> (s => (s.candies, s.coins))
  );

candy_dispenser.rei

type t;

type input =
  | Insert_coin
  | Turn;

let make: (~candies: int, ~coins: int) => t;

/** The number of candies and coins in the dispenser after the inputs have been processed. */

let run: (list(input), t) => (int, int);

candy_dispenser_test.re

open Printf;

let () = {
  open Candy_dispenser;
  let dispenser = make(~candies=10, ~coins=3);
  let (candies, coins) =
    dispenser |> run([Insert_coin, Turn, Insert_coin, Turn, Turn]);
  printf("Got %d candies remaining with %d coins.\n", candies, coins);
};

functor_class.re

module type S = {
  type t(_);

  let map: ('a => 'b, t('a)) => t('b);
};

module Of_monad = (M: Monad_class.S) : (S with type t('a) = M.t('a)) => {
  type t('a) = M.t('a);

  let map = (f, ma) => M.bind(a => M.pure(f(a)), ma);
};

monad_class.re

module type S = {
  type t(_);

  let pure: 'a => t('a);

  let bind: ('a => t('b), t('a)) => t('b);
};

module type EXTENSION = {
  type t(_);

  include S with type t('a) := t('a);

  let (>>=): (t('a), 'a => t('b)) => t('b);

  let join: t(t('a)) => t('a);

  let sequence: list(t('a)) => t(list('a));
};

module Extend = (M: S) : (EXTENSION with type t('a) := M.t('a)) => {
  include M;

  let (>>=) = (m, f) => M.bind(f, m);

  let join = maa => maa >>= (ma => ma);

  let sequence = mas =>
    List.fold_right(
      (ma, ms) => ma >>= (a => ms >>= (s => pure([a, ...s]))),
      mas,
      pure([]),
    );
};

option.re

type t('a) = option('a);

module Monad_instance: Monad_class.S with type t('a) = option('a) = {
  type t('a) = option('a);

  let pure = a => Some(a);

  let bind = f =>
    fun
    | None => None
    | Some(a) => f(a);
};

module Monad = Monad_class.Extend(Monad_instance);
module Functor_instance = Functor_class.Of_monad(Monad_instance);

state.re

module type S = {
  type t(_);

  type state;

  module Monad_instance: Monad_class.S with type t('a) = t('a);

  module Monad: (module type of Monad_class.Extend(Monad_instance));

  module Functor_instance: (module type of Functor_class.Of_monad(Monad_instance));

  let run: (state, t('a)) => (state, 'a);

  let get: t(state);

  let set: state => t(unit);

  let modify: (state => state) => t(unit);
};

module Make = (K: {type t;}) : (S with type state := K.t) => {
  module Run = {
    type t('a) = K.t => (K.t, 'a);
  };

  type t('a) = Run.t('a);

  let run = (k, ma) => ma(k);

  module Monad_instance = {
    type t('a) = Run.t('a);

    let pure = (a, k) => (k, a);

    let bind = (f, ma, k) => {
      let (k2, a) = ma(k);
      (f(a))(k2);
    };
  };

  module Monad = Monad_class.Extend(Monad_instance);

  module Functor_instance = Functor_class.Of_monad(Monad_instance);

  let get = k => (k, k);

  let set = (k, _) => (k, ());

  let modify = f => Monad.(get >>= (k => set(f(k))));
};