StateChart.re

type stateDef('event, 'state) = {
  on: 'event => option('state),
  onEnter: option('event => unit),
  onExit: option('event => unit),
};

module type Machine = {
  /* type event; */
  type state;
  let initial: state;
  let states: state => stateDef('event, state);
};

module MakeMachine = (Node: Machine) => {
  let initial = Node.initial;
  let transition = (currentState, event) => {
    let currentStateDef = currentState |> Node.states;
    let newState = currentStateDef.on(event);
    switch (newState) {
    | None => currentState
    | Some(ns) =>
      switch (currentStateDef.onExit) {
      | None => ()
      | Some(fn) => fn(event)
      };
      let newStateDef = ns |> Node.states;
      switch (newStateDef.onEnter) {
      | None => ()
      | Some(fn) => fn(event)
      };
      ns;
    };
  };
};

StateMachine.re

module type Machine = {
  type event;
  type state;
  let name: string;
  let initial: state;
  let transition: (event, state) => option(state);
};

module MakeMachine = (Node: Machine) => {
  type state = Node.state;
  type action = Node.event;
  let component = ReasonReact.reducerComponent(Node.name);
  let make = children => {
    ...component,
    initialState: () => Node.initial,
    reducer: (action, state) => {
      let nextState = Node.transition(action, state);
      switch (nextState) {
      | None => ReasonReact.NoUpdate
      | Some(s) => ReasonReact.Update(s)
      };
    },
    render: self => children(self.state, self.send),
  };
};

Xstate.re

type jsExtendedState;

   type jsTransition = {. "cond": (jsExtendedState, string) => bool};

   type jsStateNode = {
     .
     "id": string,
     "on": Js.Dict.t(Js.Dict.t(jsTransition)),
     "states": Js.Dict.t(jsStateNode),
   };

   type jsMachineConfig = {
     .
     "key": string,
     "initial": string,
     "states": Js.Dict.t(jsStateNode),
     "strict": bool,
   };

   type jsState = {
     .
     "value": string,
     "history": jsState,
   };

   type transition = (string, Js.Dict.t(jsTransition));

   type stateInstance('state) = {
     value: 'state,
     history: stateInstance('state),
   };

   module type MachineConfig = {
     let name: string;
     type state;
     let stateToJs: state => string;
     type event;
     let eventToJs: event => string;
     let eventFromJs: string => option(event);
     type action;
     let actionToJs: action => string;
     type extendedState;
   };

   module type MachineGenerator = {
     include MachineConfig;
     type condidionalGuard = (extendedState, event) => bool;
     let makeTransition:
       (~on: event, ~target: state, ~cond: condidionalGuard, unit) => transition;
     let makeStateNode:
       (
         ~id: state,
         ~transitions: list(transition),
         ~states: list(jsStateNode),
         unit
       ) =>
       jsStateNode;
   };

   module MakeGenerator = (Config: MachineConfig) => {
     include Config;
     let makeTransition = (~on, ~target, ~cond, ()) => {
       let t = Js.Dict.empty();
       Js.Dict.set(
         t,
         target |> stateToJs,
         {
           "cond": (es, eventAsString) => cond(es, eventAsString |> eventFromJs),
         },
       );
       (on |> eventToJs, t);
     };
     let makeStateNode = (~id, ~transitions, ~states, ()) => {
       "id": id |> stateToJs,
       "on": Js.Dict.fromList(transitions),
       "states": states |> Array.of_list,
     };
   };

   module type MachineMaker = {
     include MachineConfig;
     let key: string;
     let initial: state;
     let states: Js.Dict.t(jsStateNode);
     let strict: bool;
   };

   module MakeMachine = (Maker: MachineMaker) => {
     type machine;
     [@bs.module "xstate"]
     external machine_ : jsMachineConfig => machine = "Machine";
     [@bs.send]
     external transition_ : (machine, string, string, jsExtendedState) => jsState =
       "transition";
     let machine =
       machine_({
         "key": Maker.key,
         "initial": Maker.initial |> Maker.stateToJs,
         "states": Maker.states,
         "strict": Maker.strict,
       });
     external makeExtendedState : Maker.extendedState => jsExtendedState =
       "%identity";
     let transition = (currentState, event, extendedState) => {
       let jsResponse =
         machine
         |. transition_(
              currentState |> Maker.stateToJs,
              event |> Maker.eventToJs,
              extendedState |> makeExtendedState,
            );
       ();
     };
   };

   module TrafficLightConfig: MachineConfig = {
     let name = "light";
     [@bs.deriving jsConverter]
     type state = [ | `Green | `Yellow | `Red];
     [@bs.deriving jsConverter]
     type event = [ | `Timer];
     [@bs.deriving jsConverter]
     type action = [ | `DoThing];
     type extendedState = string;
   };

   module TLGenerator = MakeGenerator(TrafficLightConfig);

   module TrafficLight =
     MakeMachine(
       {
   			open TLGenerator;
         let key = "light";
         let initial = `Green;
         let strict = false;
         let states = [
   				makeStateNode(~id=`Green, ~states=[], ~transitions=[
   					makeTransition(~on=`Timer, ~target=`Yellow, ~cond=(_ => true), ())
   				], ())
   			];
       },
     );