Tracking Effects in ReasonML

Eff.re

module Eff: {
  type t('t, 'a);
  let make: (unit => 'a) => t('t, 'a);
  let run: t('t, 'a) => 'a;
  let map: (t('t, 'a), 'a => 'b) => t('t, 'b);
  let join: t('t, t('t, 'a)) => t('t, 'a);
  let bind: (t('t, 'a), 'a => t('t, 'b)) => t('t, 'b);
} = {
  type t('t, 'a) = unit => 'a;
  let make: (unit => 'a) => t('t, 'a) = m => m;
  let run: t('t, 'a) => 'a = m => m();
  let map: (t('t, 'a), 'a => 'b) => t('t, 'b) =
    (m, f) => make(() => f(m->run));
  let join: t('t, t('t, 'a)) => t('t, 'a) = m => make(() => m->run->run);
  let bind: (t('t, 'a), 'a => t('t, 'b)) => t('t, 'b) =
    (m, f) => m->map(a => f(a))->join;
};

// SYNTAX

module Bind = {
  let let_ = Eff.bind;
};

module Map = {
  let let_ = Eff.map;
};

// HTTP

type method =
  | Get
  | Post;

type req = {
  body: string,
  header: string,
  method,
};

type res = {
  body: string,
  status: int,
};

type db;

type route =
  | Get({
      path: string,
      handler: req => Eff.t([ | `read(db)], res),
    })
  | Post({
      path: string,
      handler: req => Eff.t([ | `read(db) | `write(db)], res),
    });

// APP

[@decco]
type user = {
  username: string,
  uid: int,
};

let createUser: string => Eff.t([> | `write(db)], user) =
  username => Eff.make(() => {username, uid: 1});

let lookupUser: string => Eff.t([> | `read(db)], option(user)) =
  username => Eff.make(() => Some({username, uid: 1}));

let signupPage = req => {
  let username = req.header;
  let%Bind user = lookupUser(username);
  switch (user) {
  | Some(_) =>
    Eff.make(() =>
      {body: "A user with this username already exists!", status: 400}
    )
  | None =>
    let%Map _ = createUser(username);
    {body: "Created User with name " ++ username, status: 200};
  };
};

let getUser = req => {
  let%Map user = lookupUser(req.header);
  switch (user) {
  | Some(user) => {body: user_encode(user)->Js.Json.stringify, status: 200}
  | None => {body: "Not found user " ++ req.header, status: 404}
  };
};

// ROUTE DEFINITION

let routes = [
  Get({path: "/user", handler: getUser}),
  Post({path: "/signup", handler: signupPage}),
];