suave.ml

let pure a = Some a |> Js.Promise.resolve
let fail _ = None |> Js.Promise.resolve 
let (>=>) x y a =
    x a 
    |> Js.Promise.then_ ( 
        function
        | None -> None |> Js.Promise.resolve 
        | Some s -> y s
    )

let rec choose options a =
    match options with
    | [] -> fail(a)
    | h :: t -> h a 
                |> Js.Promise.then_ (
                    function
                    | Some s -> pure s
                    | None -> choose t a
                    )
         
type http = { 
    path : string; 
    method_ : string; 
    send : int -> Js.Json.t -> http
}

(* method filters *)
let isMethod m a = if a.method_ = m then pure a else fail a
let get = isMethod "GET"
let put = isMethod "PUT"
let post = isMethod "POST"
let delete = isMethod "DELETE"

(* path filters *)
let path p a = if a.path = p then pure(a) else fail(a)

(* writers *)
let convert a =
    match Js.Json.stringifyAny a with
    | Some s -> Js.Json.parseExn s
    | None -> Js.Json.null

let setStatus code content a = a.send code (convert content) |> pure
let ok a = setStatus 200 a
let notFound a = setStatus 404 a
let error a = setStatus 500 a

(* example api *)
type store = { number : int }
let stores = [| { number = 2304 } |]

let api = choose [
    path "/stores" >=> choose [
        get >=> ok stores;
        post >=> ok "posted stores"
    ];
    path "/items" >=> choose [
        get >=> ok "got items";
        post >=> ok "posted items"
    ];
    notFound "Like Bono, we still haven't found what you're looking for"
]

suave.re

type webPart('a) = 'a => Js.Promise.t(option('a));

let pure = a => Js.Promise.resolve(Some(a));
let fail = _ => Js.Promise.resolve(None);
let (>=>) = (x, y, a) =>
  x(a)
  |> Js.Promise.then_(
       fun
       | None => Js.Promise.resolve(None)
       | Some(a) => y(a),
     );

let rec choose = (options, arg) =>
  switch (options) {
  | [] => fail(arg)
  | [h, ...t] =>
    h(arg)
    |> Js.Promise.then_(
         fun
         | Some(a) => pure(a)
         | None => choose(t, arg),
       )
  };

let filter = (pred, arg) => pred(arg) ? pure(arg) : fail(arg);

type http = {
  path: string,
  method: string,
  send: (int, Js.Json.t) => http,
};

let get =
  filter(
    fun
    | {method: "GET"} => true
    | _ => false,
  );

let put =
  filter(
    fun
    | {method: "PUT"} => true
    | _ => false,
  );
let post =
  filter(
    fun
    | {method: "POST"} => true
    | _ => false,
  );

let delete =
  filter(
    fun
    | {method: "DELETE"} => true
    | _ => false,
  );

let path = p => filter(http => http.path == p ? true : false);

let convert = a => {
  switch (Js.Json.stringifyAny(a)) {
  | Some(s) => Js.Json.parseExn(s)
  | None => Js.Json.null
  };
};

let setStatus = (code, content): webPart(http) =>
  http => pure(http.send(code, content |> convert));

let ok = content => setStatus(200, content);
let notFound = content => setStatus(404, content);
let error = content => setStatus(500, content);

// example api

type store = { number : int }
let stores = [| { number: 2304 } |]

let api = choose([
  path("/stores") >=> choose([
    get >=> ok(stores),
    post >=> ok("posted stores")
  ]),
  path("/items") >=> choose([
    get >=> ok("got items"),
    post >=> ok("posted items")
  ]),
  notFound("Like Bono, we still haven't found what you're looking for")
])