Source file router.ml

open Misc
open Sexplib.Std
module Co = Cohttp
module Rock = Rock
module Route = Route
open Rock

type 'a t = (Route.t * 'a) Queue.t array [@@deriving sexp]

let create () = Array.init 7 (fun _ -> Queue.create ())

let int_of_meth = function
  | `GET -> 0
  | `POST -> 1
  | `PUT -> 2
  | `DELETE -> 3
  | `HEAD -> 4
  | `PATCH -> 5
  | `OPTIONS -> 6
  | _ -> failwith "non standard http verbs not supported"

let get t meth = t.(int_of_meth meth)

let add t ~route ~meth ~action = Queue.push (route, action) t.(int_of_meth meth)

(** finds matching endpoint and returns it with the parsed list of parameters *)
let matching_endpoint endpoints meth uri =
  let endpoints = get endpoints meth in
  endpoints
  |> Queue.find_map ~f:(fun ep ->
         uri |> Route.match_url (fst ep) |> Option.map ~f:(fun p -> (ep, p)))

module Env = struct
  let key : Route.matches Hmap0.key =
    Hmap0.Key.create ("path_params", [%sexp_of: Route.matches])
end

(* not param_exn since if the endpoint was selected it's likely that the
   parameter is already there *)
let param req param =
  let {Route.params; _} = Hmap0.find_exn Env.key (Request.env req) in
  List.assoc param params

let splat req = Hmap0.find_exn Env.key (Request.env req) |> Route.splat

(* takes a list of endpoints and a default handler. calls an endpoint if a match
   is found. otherwise calls the handler *)
let m endpoints =
  let filter default req =
    let url = req |> Request.uri |> Uri.path in
    match matching_endpoint endpoints (Request.meth req) url with
    | None -> default req
    | Some (endpoint, params) ->
        let env_with_params = Hmap0.add Env.key params (Request.env req) in
        (snd endpoint) {req with Request.env= env_with_params}
  in
  Rock.Middleware.create ~name:"Router" ~filter