From 1bf6f2d47217b1d9e956152c8c29407fb2feaaa4 Mon Sep 17 00:00:00 2001
From: Andrey Popp <8mayday@gmail.com>
Date: Fri, 19 Apr 2024 16:30:11 +0300
Subject: [PATCH] init

---
 .github/workflows/main.yml |  39 ++++
 .gitignore                 |   2 +
 .ocamlformat               |   3 +
 README.md                  | 116 ++++++++++
 dune                       |  22 ++
 dune-project               |  24 +++
 ppx_router.ml              | 428 +++++++++++++++++++++++++++++++++++++
 ppx_router.mli             |   0
 ppx_router.opam            |  32 +++
 ppx_router_runtime.ml      |  77 +++++++
 ppx_router_runtime.mli     |  48 +++++
 ppx_router_test.ml         |   1 +
 test/dune                  |   7 +
 test/test.ml               |  70 ++++++
 test/test.t                |  13 ++
 15 files changed, 882 insertions(+)
 create mode 100644 .github/workflows/main.yml
 create mode 100644 .gitignore
 create mode 100644 .ocamlformat
 create mode 100644 README.md
 create mode 100644 dune
 create mode 100644 dune-project
 create mode 100644 ppx_router.ml
 create mode 100644 ppx_router.mli
 create mode 100644 ppx_router.opam
 create mode 100644 ppx_router_runtime.ml
 create mode 100644 ppx_router_runtime.mli
 create mode 100644 ppx_router_test.ml
 create mode 100644 test/dune
 create mode 100644 test/test.ml
 create mode 100644 test/test.t

diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml
new file mode 100644
index 0000000..a8de7c1
--- /dev/null
+++ b/.github/workflows/main.yml
@@ -0,0 +1,39 @@
+name: main
+
+on:
+  pull_request:
+  push:
+  schedule:
+    - cron: 0 1 * * MON
+
+permissions: read-all
+
+jobs:
+  build:
+    strategy:
+      fail-fast: false
+      matrix:
+        os:
+          - ubuntu-latest
+        ocaml-compiler:
+          - "4.14"
+          - "5.1"
+
+    runs-on: ${{ matrix.os }}
+
+    steps:
+      - name: checkout tree
+        uses: actions/checkout@v4
+
+      - name: set-up OCaml ${{ matrix.ocaml-compiler }}
+        uses: ocaml/setup-ocaml@v2
+        with:
+          ocaml-compiler: ${{ matrix.ocaml-compiler }}
+          opam-repositories: |
+            default: https://github.com/ocaml/opam-repository.git
+
+      - run: opam install . --deps-only --with-test
+
+      - run: opam exec -- dune build
+
+      - run: opam exec -- dune runtest
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..f485c7c
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+_opam
+_build
diff --git a/.ocamlformat b/.ocamlformat
new file mode 100644
index 0000000..6869d9b
--- /dev/null
+++ b/.ocamlformat
@@ -0,0 +1,3 @@
+break-infix=fit-or-vertical
+margin=74
+parens-tuple=multi-line-only
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..a9791dd
--- /dev/null
+++ b/README.md
@@ -0,0 +1,116 @@
+# `ppx_router`
+
+A typed router for Dream.
+
+## Usage
+
+Install (custom opam repo is required as for now):
+```
+opam repo add andreypopp https://github.com/andreypopp/opam-repository.git
+opam update
+opam install ppx_router
+```
+
+Put this into your `dune` file:
+```
+(...
+ (preprocess (pps ppx_router))
+```
+
+Define your routes:
+```ocaml
+module Routes = struct
+  open Ppx_router_runtime.Types
+
+  type t =
+    | Home [@GET "/"]
+    | Hello of { name : string; repeat : int option } [@GET "/hello/:name"]
+    [@@deriving router]
+end
+```
+
+Notice the `[@@deriving router]` annotation, which instruct to generate code
+for routing based on the variant type definition.
+
+Each branch in the variant type definition corresponds to a separate route, it
+needs to have a `[@GET "/path"]` attribute (or `[@POST "/path"]`, etc.) which
+specify a path pattern for the route.
+
+The path pattern can contain named parameters, like `:name` in the example
+above. In this case the parameter will be extracted from the path and used in
+the route payload. All other fields from a route payload are considered query
+parameters.
+
+Now we can generate hrefs for these routes:
+```ocaml
+let () =
+  assert (Routes.href Home = "/");
+  assert (Routes.href (Hello {name="world"; repeat=1} = "/hello/world?repeat=1")
+```
+
+and define a handler for them:
+```ocaml
+let handle = Routes.handle (fun route _req ->
+  match route with
+  | Home -> Dream.html "Home page!"
+  | Hello {name; repeat} ->
+    let name =
+      match repeat with
+      | Some repeat ->
+        List.init repeat (fun _ -> name) |> String.concat ", "
+      | None -> name
+    in
+    Dream.html (Printf.sprintf "Hello, %s" name))
+```
+
+Finally we can use the handler in a Dream app:
+```ocaml
+let () = Dream.run ~interface:"0.0.0.0" ~port:8080 handle
+```
+
+## Custom path/query parameter types
+
+When generating parameter encoding/decoding code for a parameter of type `T`,
+`ppx_router` will emit the code that uses the following functions.
+
+If `T` is a path parameter:
+```ocaml
+val T_of_url_path : string -> T option
+val T_to_url_path : T -> string
+```
+
+If `T` is a query parameter:
+```ocaml
+val T_of_url_query : string list -> T option
+val T_to_url_query : T -> string list
+```
+
+The default encoders/decoders are provided in `Ppx_router_runtime.Types` module
+(this is why we need to `open` the module when defining routes).
+
+To provide custom encoders/decoders for a custom type, we can define own
+functions, for example:
+
+```ocaml
+module Modifier = struct
+  type t = Capitalize | Uppercase
+
+  let rec of_url_query : t Ppx_router_runtime.url_query_decoder = function
+    | [] -> None
+    | [ "capitalize" ] -> Some Capitalize
+    | [ "uppercase" ] -> Some Uppercase
+    | _ :: xs -> of_url_query xs (* let the last one win *)
+
+  let to_url_query : t Ppx_router_runtime.url_query_encoder = function
+    | Capitalize -> [ "capitalize" ]
+    | Uppercase -> [ "uppercase" ]
+end
+```
+
+After that one can use `Modifier.t` in route definitions:
+
+```ocaml
+type t =
+  | Hello of { name : string; modifier : Modifier.t } [@GET "/hello/:name"]
+  [@@deriving router]
+```
diff --git a/dune b/dune
new file mode 100644
index 0000000..8634168
--- /dev/null
+++ b/dune
@@ -0,0 +1,22 @@
+(library
+ (name ppx_router)
+ (modules ppx_router)
+ (public_name ppx_router)
+ (libraries uri ppxlib containers)
+ (kind ppx_rewriter)
+ (ppx_runtime_libraries ppx_router.runtime)
+ (preprocess
+  (pps ppxlib.metaquot)))
+
+(library
+ (name ppx_router_runtime)
+ (modules ppx_router_runtime)
+ (public_name ppx_router.runtime)
+ (libraries containers dream routes)
+ (preprocess
+  (pps ppxlib.metaquot)))
+
+(executable
+ (name ppx_router_test)
+ (modules ppx_router_test)
+ (libraries ppx_router))
diff --git a/dune-project b/dune-project
new file mode 100644
index 0000000..9ee9c6a
--- /dev/null
+++ b/dune-project
@@ -0,0 +1,24 @@
+(lang dune 3.11)
+
+(generate_opam_files true)
+
+(source
+ (github andreypopp/ppx_router))
+
+(authors "Andrey Popp")
+
+(maintainers "Andrey Popp")
+
+(license LICENSE)
+
+(package
+ (name ppx_router)
+ (depends
+  (ocaml
+   (>= 4.14))
+  dune
+  ppxlib
+  containers
+  routes
+  dream
+  uri))
diff --git a/ppx_router.ml b/ppx_router.ml
new file mode 100644
index 0000000..16ca356
--- /dev/null
+++ b/ppx_router.ml
@@ -0,0 +1,428 @@
+open ContainersLabels
+open Ppxlib
+open Ast_builder.Default
+
+let patt_and_expr ~loc label = pvar ~loc label, evar ~loc label
+let ( --> ) pc_lhs pc_rhs = { pc_lhs; pc_rhs; pc_guard = None }
+
+type method_ = [ `GET | `POST | `PUT | `DELETE ]
+
+let method_to_string : method_ -> string = function
+  | `GET -> "GET"
+  | `POST -> "POST"
+  | `PUT -> "PUT"
+  | `DELETE -> "DELETE"
+
+let collect_params_rev ~loc:_ uri =
+  let rec aux acc = function
+    | [] -> acc
+    | "" :: xs -> aux acc xs
+    | x :: xs -> (
+        match String.chop_prefix x ~pre:":" with
+        | None -> aux (`path x :: acc) xs
+        | Some name -> aux (`param name :: acc) xs)
+  in
+  aux [] (Uri.path uri |> String.split_on_char ~by:'/')
+
+let string_patt () =
+  let open Ast_pattern in
+  single_expr_payload (estring __')
+
+type ctor = {
+  ctor : constructor_declaration;
+  method_ : method_;
+  path : path;
+  query : (string * core_type) list;
+}
+
+and path = path_segment list
+and path_segment = Ppath of string | Pparam of string * core_type
+
+let equal_path : path Equal.t =
+  let eq_param a b =
+    match a, b with
+    | Ppath a, Ppath b -> String.equal a b
+    | Pparam _, Pparam _ -> true
+    | _ -> false
+  in
+  Equal.list eq_param
+
+let equal_route_by_path_method : ctor Equal.t =
+ fun a b -> Equal.poly a.method_ b.method_ && equal_path a.path b.path
+
+let equal_route_by_path : ctor Equal.t =
+ fun a b -> equal_path a.path b.path
+
+let hash_route_by_path : ctor Hash.t =
+ fun ctor ->
+  Hash.list
+    (function
+      | Pparam _ -> 0 | Ppath x -> Hash.combine2 1 (Hash.string x))
+    ctor.path
+
+let declare_router_attr method_ =
+  let name = Printf.sprintf "router.%s" (method_to_string method_) in
+  ( method_,
+    Attribute.declare name Attribute.Context.Constructor_declaration
+      (string_patt ()) (fun x -> x) )
+
+let attr_GET = declare_router_attr `GET
+let attr_POST = declare_router_attr `POST
+let attr_PUT = declare_router_attr `PUT
+let attr_DELETE = declare_router_attr `DELETE
+let attrs = [ attr_GET; attr_POST; attr_PUT; attr_DELETE ]
+
+let derive_path_name (ctor : ctor) =
+  let name = ctor.ctor.pcd_name.txt in
+  Ppxlib.Expansion_helpers.mangle (Prefix "path") name
+
+let to_supported_arg_type (t : core_type) =
+  let loc = t.ptyp_loc in
+  match t.ptyp_desc with
+  | Ptyp_constr (t, args) -> `constr (t.txt, args)
+  | Ptyp_tuple xs -> `tuple xs
+  | Ptyp_any | Ptyp_var _
+  | Ptyp_arrow (_, _, _)
+  | Ptyp_object (_, _)
+  | Ptyp_class (_, _)
+  | Ptyp_alias (_, _)
+  | Ptyp_variant (_, _, _)
+  | Ptyp_poly (_, _)
+  | Ptyp_package _ | Ptyp_extension _ ->
+      Location.raise_errorf ~loc
+        "cannot automatically derive type parameter decoding/encoding" ()
+
+let rec derive_conv suffix t =
+  let loc = t.ptyp_loc in
+  match to_supported_arg_type t with
+  | `tuple ts ->
+      let n = List.length ts in
+      let name = Printf.sprintf "tuple%d" n in
+      [%expr
+        [%e evar ~loc name]
+          [%e elist ~loc (List.map ts ~f:(derive_conv suffix))]]
+  | `constr (name, args) ->
+      let txt = Expansion_helpers.mangle_lid (Suffix suffix) name in
+      let init = pexp_ident ~loc { loc; txt } in
+      List.fold_left args ~init ~f:(fun acc arg ->
+          pexp_apply ~loc acc [ Nolabel, derive_conv suffix arg ])
+
+let derive_path (ctor, ctors) =
+  let loc = ctor.ctor.pcd_loc in
+  let name = derive_path_name ctor in
+  let body =
+    match ctor.path with
+    | [] -> [%expr Routes.nil]
+    | init :: params ->
+        let body =
+          let f = function
+            | Pparam (name, ty) ->
+                let to_url = derive_conv "to_url_path" ty in
+                let of_url = derive_conv "of_url_path" ty in
+                [%expr
+                  Routes.pattern [%e to_url] [%e of_url]
+                    [%e estring ~loc name]]
+            | Ppath path -> [%expr Routes.s [%e estring ~loc path]]
+          in
+          List.fold_left params ~init:(f init) ~f:(fun body param ->
+              let param = f param in
+              [%expr Routes.( / ) [%e body] [%e param]])
+        in
+        [%expr Routes.( /? ) [%e body] Routes.nil]
+  in
+  let make =
+    let params =
+      List.filter ctor.path ~f:(function
+        | Pparam _ -> true
+        | Ppath _ -> false)
+      |> List.mapi ~f:(fun idx _ -> Printf.sprintf "_param%d" idx)
+    in
+    let preq, req = patt_and_expr ~loc (gen_symbol ~prefix:"_req" ()) in
+    let by_method =
+      let init =
+        [
+          ppat_any ~loc
+          --> [%expr raise Ppx_router_runtime.Method_not_allowed];
+        ]
+      in
+      List.fold_left ctors ~init ~f:(fun cases ctor ->
+          let loc = ctor.ctor.pcd_loc in
+          let name = ctor.ctor.pcd_name.txt in
+          let method_ = method_to_string ctor.method_ in
+          let pat = ppat_variant ~loc method_ None in
+          let lname = { loc; txt = Lident name } in
+          let path_params =
+            List.filter_map ctor.path ~f:(function
+              | Pparam (name, _) -> Some name
+              | Ppath _ -> None)
+          in
+          let args =
+            List.map2 path_params params ~f:(fun name value ->
+                { loc; txt = Lident name }, evar ~loc value)
+          in
+          let args =
+            args
+            @ List.filter_map ctor.query ~f:(fun (name, typ) ->
+                  let field_name = { loc; txt = Lident name } in
+                  let of_url = derive_conv "of_url_query" typ in
+                  let value =
+                    [%expr
+                      let v =
+                        Dream.queries [%e req] [%e estring ~loc name]
+                      in
+                      match [%e of_url] v with
+                      | Some v -> v
+                      | None ->
+                          raise
+                            (Ppx_router_runtime.Invalid_query_parameter
+                               ([%e estring ~loc name], v))]
+                  in
+                  Some (field_name, value))
+          in
+          let args =
+            match args with
+            | [] -> None
+            | args -> Some (pexp_record ~loc args None)
+          in
+          let expr = pexp_construct ~loc lname args in
+          (pat --> [%expr [%e expr]]) :: cases)
+    in
+    let make =
+      [%expr
+        fun ([%p preq] : Dream.request) ->
+          [%e pexp_match ~loc [%expr Dream.method_ [%e req]] by_method]]
+    in
+    List.fold_left (List.rev params) ~init:make ~f:(fun body param ->
+        pexp_fun ~loc Nolabel None (pvar ~loc param) body)
+  in
+  let body = [%expr Routes.route [%e body] [%e make]] in
+  [%stri let [%p pvar ~loc name] = [%e body]]
+
+let derive_router td ctors =
+  let loc = td.ptype_loc in
+  let name = td.ptype_name.txt in
+  let name = Ppxlib.Expansion_helpers.mangle (Suffix "router") name in
+  let paths =
+    List.map ctors ~f:(fun (ctor, _ctors) ->
+        let name = derive_path_name ctor in
+        let loc = ctor.ctor.pcd_loc in
+        evar ~loc name)
+  in
+  [%stri
+    let [%p pvar ~loc name] =
+      Ppx_router_runtime.make (Routes.one_of [%e elist ~loc paths])]
+
+let derive_handle td =
+  let loc = td.ptype_loc in
+  let name = td.ptype_name.txt in
+  let router = Ppxlib.Expansion_helpers.mangle (Suffix "router") name in
+  let name = Ppxlib.Expansion_helpers.mangle (Suffix "handle") name in
+  [%stri
+    let [%p pvar ~loc name] =
+      Ppx_router_runtime.handle [%e evar ~loc router]]
+
+let derive_href_case ~loc (path : path) query x =
+  match path, query with
+  | [], [] -> [%expr "/"]
+  | path, query ->
+      let pout, out = patt_and_expr ~loc (gen_symbol ~prefix:"out" ()) in
+      let psep, sep = patt_and_expr ~loc (gen_symbol ~prefix:"_sep" ()) in
+      let body = [%expr Buffer.contents [%e out]] in
+      let body =
+        match query with
+        | [] -> body
+        | q :: qs ->
+            let f acc (name, typ) =
+              let _pvalue, value = patt_and_expr ~loc name in
+              let write =
+                [%expr
+                  Stdlib.List.iter
+                    (fun value ->
+                      Buffer.add_char [%e out] ![%e sep];
+                      Ppx_router_runtime.encode_query_key [%e out]
+                        [%e estring ~loc name];
+                      [%e sep] := '&';
+                      Buffer.add_char [%e out] '=';
+                      Ppx_router_runtime.encode_query_value [%e out] value)
+                    ([%e derive_conv "to_url_query" typ] [%e value])]
+              in
+              [%expr
+                [%e write];
+                [%e acc]]
+            in
+            let body = f body q in
+            List.fold_left qs ~init:body ~f
+      in
+      let body =
+        List.fold_left (List.rev path) ~init:body ~f:(fun acc param ->
+            match param with
+            | Ppath x ->
+                [%expr
+                  Buffer.add_char [%e out] '/';
+                  Ppx_router_runtime.encode_path [%e out]
+                    [%e estring ~loc x];
+                  [%e acc]]
+            | Pparam (x, typ) ->
+                let to_url = derive_conv "to_url_path" typ in
+                [%expr
+                  Buffer.add_char [%e out] '/';
+                  Ppx_router_runtime.encode_path [%e out]
+                    ([%e to_url] [%e evar ~loc x]);
+                  [%e acc]])
+      in
+      let body =
+        [%expr
+          let [%p pout] = Buffer.create 16 in
+          let [%p psep] = ref '?' in
+          [%e body]]
+      in
+      let bnds =
+        let make name =
+          let pat = pvar ~loc name in
+          let expr = pexp_field ~loc x { loc; txt = Lident name } in
+          value_binding ~loc ~pat ~expr
+        in
+        List.filter_map path ~f:(fun param ->
+            match param with
+            | Ppath _ -> None
+            | Pparam (name, _typ) -> Some (make name))
+        @ List.map query ~f:(fun (name, _typ) -> make name)
+      in
+      pexp_let ~loc Nonrecursive bnds body
+
+let derive_href td (ctors : ctor list) =
+  let loc = td.ptype_loc in
+  let name = td.ptype_name.txt in
+  let name = Ppxlib.Expansion_helpers.mangle (Suffix "href") name in
+  let cases =
+    List.map ctors ~f:(fun ctor ->
+        let loc = ctor.ctor.pcd_loc in
+        let name = ctor.ctor.pcd_name in
+        let lid = { loc; txt = Lident name.txt } in
+        match ctor.path, ctor.query with
+        | [], [] ->
+            let p = ppat_construct ~loc lid None in
+            p --> derive_href_case ~loc [] [] [%expr assert false]
+        | path, query ->
+            let px, x = patt_and_expr ~loc (gen_symbol ~prefix:"x" ()) in
+            let p = ppat_construct ~loc lid (Some px) in
+            p --> derive_href_case ~loc path query x)
+  in
+  [%stri let [%p pvar ~loc name] = [%e pexp_function ~loc cases]]
+
+let derive_router_td td =
+  let loc = td.ptype_loc in
+  let () =
+    match td.ptype_params with
+    | [] -> ()
+    | _ -> Location.raise_errorf ~loc "type parameters are not supported"
+  in
+  let ctors =
+    match td.ptype_kind with
+    | Ptype_variant ctors -> ctors
+    | Ptype_abstract | Ptype_record _ | Ptype_open ->
+        Location.raise_errorf ~loc
+          "only variant types are supported for by [@@deriving router]"
+  in
+  let ctors =
+    List.fold_left ctors ~init:[] ~f:(fun ctors ctor ->
+        let loc = ctor.pcd_loc in
+        let lds =
+          match ctor.pcd_args with
+          | Pcstr_record lds -> lds
+          | Pcstr_tuple [] -> []
+          | Pcstr_tuple _ ->
+              Location.raise_errorf ~loc
+                "only record constructors are supported"
+        in
+        let info =
+          List.find_map attrs ~f:(fun (method_, attr) ->
+              match Attribute.get attr ctor with
+              | None -> None
+              | Some uri ->
+                  let uri = Uri.of_string uri.txt in
+                  Some (ctor, method_, uri))
+        in
+        let ctor, method_, uri =
+          match info with
+          | None ->
+              Location.raise_errorf ~loc
+                "missing attribute [@GET], [@POST], [@PUT] or [@DELETE]"
+          | Some x -> x
+        in
+        let resolve_type name =
+          let typ =
+            List.find_map lds ~f:(fun ld ->
+                match String.equal ld.pld_name.txt name with
+                | true -> Some ld.pld_type
+                | false -> None)
+          in
+          match typ with
+          | None ->
+              Location.raise_errorf ~loc "missing type for param: %S" name
+          | Some typ -> typ
+        in
+        let path = List.rev (collect_params_rev ~loc uri) in
+        let path =
+          List.map path ~f:(function
+            | `path x -> Ppath x
+            | `param x -> Pparam (x, resolve_type x))
+        in
+        let query =
+          List.filter_map lds ~f:(fun ld ->
+              let is_path_param =
+                List.exists path ~f:(function
+                  | Pparam (name, _) -> String.equal name ld.pld_name.txt
+                  | Ppath _ -> false)
+              in
+              if is_path_param then None
+              else Some (ld.pld_name.txt, ld.pld_type))
+        in
+        let ctor = { ctor; method_; path; query } in
+        (match
+           List.find_opt ctors ~f:(equal_route_by_path_method ctor)
+         with
+        | None -> ()
+        | Some conflict ->
+            Location.raise_errorf ~loc
+              "route %s %s is already defined in %s constructor"
+              (method_to_string method_)
+              (Uri.path uri) conflict.ctor.pcd_name.txt);
+        ctor :: ctors)
+  in
+  let ctors = List.rev ctors in
+  let ctors_by_path =
+    List.group_by ~eq:equal_route_by_path ~hash:hash_route_by_path ctors
+    |> List.map ~f:(fun ctors ->
+           let ctor = List.hd ctors in
+           ctor, ctors)
+  in
+  let paths = List.rev_map ctors_by_path ~f:derive_path in
+  let paths =
+    pstr_open ~loc
+      {
+        popen_override = Fresh;
+        popen_expr = pmod_structure ~loc paths;
+        popen_loc = loc;
+        popen_attributes = [];
+      }
+  in
+  paths
+  :: [
+       derive_router td ctors_by_path;
+       derive_handle td;
+       derive_href td ctors;
+     ]
+
+let derive_router ~ctxt (_rec_flag, type_decls) =
+  let loc = Expansion_context.Deriver.derived_item_loc ctxt in
+  match type_decls with
+  | [ td ] -> derive_router_td td
+  | [] -> assert false
+  | _ ->
+      Location.raise_errorf ~loc "expected exactly one type declaration"
+
+let _ =
+  let args = Deriving.Args.(empty) in
+  let str_type_decl = Deriving.Generator.V2.make args derive_router in
+  Deriving.add ~str_type_decl "router"
diff --git a/ppx_router.mli b/ppx_router.mli
new file mode 100644
index 0000000..e69de29
diff --git a/ppx_router.opam b/ppx_router.opam
new file mode 100644
index 0000000..fcac745
--- /dev/null
+++ b/ppx_router.opam
@@ -0,0 +1,32 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+maintainer: ["Andrey Popp"]
+authors: ["Andrey Popp"]
+license: "LICENSE"
+homepage: "https://github.com/andreypopp/ppx_router"
+bug-reports: "https://github.com/andreypopp/ppx_router/issues"
+depends: [
+  "ocaml" {>= "4.14"}
+  "dune" {>= "3.11"}
+  "ppxlib"
+  "containers"
+  "routes"
+  "dream"
+  "uri"
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/andreypopp/ppx_router.git"
diff --git a/ppx_router_runtime.ml b/ppx_router_runtime.ml
new file mode 100644
index 0000000..f36f31e
--- /dev/null
+++ b/ppx_router_runtime.ml
@@ -0,0 +1,77 @@
+type 'a url_path_encoder = 'a -> string
+type 'a url_path_decoder = string -> 'a option
+type 'a url_query_encoder = 'a -> string list
+type 'a url_query_decoder = string list -> 'a option
+
+module Types = struct
+  let string_to_url_path x = x
+  let string_of_url_path x = Some x
+  let int_to_url_path x = string_of_int x
+  let int_of_url_path x = int_of_string_opt x
+  let bool_to_url_path x = if x then "true" else "false"
+
+  let bool_of_url_path x =
+    match x with "true" -> Some true | "false" -> Some false | _ -> None
+
+  let rec last_wins f = function
+    | [] -> None
+    | [ x ] -> f x
+    | _ :: xs -> last_wins f xs
+
+  let string_to_url_query x = [ x ]
+  let string_of_url_query = last_wins (fun x -> Some x)
+  let int_to_url_query x = [ string_of_int x ]
+  let int_of_url_query = last_wins int_of_string_opt
+  let bool_to_url_query x = if x then [ "true" ] else []
+
+  let bool_of_url_query =
+    last_wins (function "true" -> Some true | _ -> Some false)
+
+  let option_to_url_query :
+      'a url_query_encoder -> 'a option url_query_encoder =
+   fun f x -> match x with None -> [] | Some v -> f v
+
+  let option_of_url_query :
+      'a url_query_decoder -> 'a option url_query_decoder =
+   fun f x ->
+    match x with
+    | [] -> Some None
+    | x -> ( match f x with None -> None | Some v -> Some (Some v))
+end
+
+let encode_path out x =
+  Buffer.add_string out (Uri.pct_encode ~component:`Path x)
+
+let encode_query_key out x =
+  Buffer.add_string out (Uri.pct_encode ~component:`Query_key x)
+
+let encode_query_value out x =
+  Buffer.add_string out (Uri.pct_encode ~component:`Query_value x)
+
+exception Method_not_allowed
+exception Invalid_query_parameter of string * string list
+
+type 'a router = (Dream.request -> 'a) Routes.router
+
+let make x = x
+
+let route (router : _ router) req =
+  let target = Dream.target req in
+  match Routes.match' router ~target with
+  | Routes.FullMatch v | Routes.MatchWithTrailingSlash v -> (
+      match v req with
+      | v -> `Ok v
+      | exception Invalid_query_parameter (x, y) ->
+          `Invalid_query_parameter (x, y)
+      | exception Method_not_allowed -> `Method_not_allowed)
+  | Routes.NoMatch -> `Not_found
+
+let handle (router : _ router) f req =
+  match route router req with
+  | `Ok v -> f v req
+  | `Invalid_query_parameter (param, _) ->
+      Dream.respond ~status:`Bad_Request
+        (Printf.sprintf "Invalid or missing query parameter: %s" param)
+  | `Method_not_allowed ->
+      Dream.respond ~status:`Method_Not_Allowed "Method not allowed"
+  | `Not_found -> Dream.respond ~status:`Not_Found "Not found"
diff --git a/ppx_router_runtime.mli b/ppx_router_runtime.mli
new file mode 100644
index 0000000..86913d2
--- /dev/null
+++ b/ppx_router_runtime.mli
@@ -0,0 +1,48 @@
+type 'a url_path_encoder = 'a -> string
+type 'a url_path_decoder = string -> 'a option
+type 'a url_query_encoder = 'a -> string list
+type 'a url_query_decoder = string list -> 'a option
+
+module Types : sig
+  val string_to_url_path : string url_path_encoder
+  val string_of_url_path : string url_path_decoder
+  val int_to_url_path : int url_path_encoder
+  val int_of_url_path : int url_path_decoder
+  val bool_to_url_path : bool url_path_encoder
+  val bool_of_url_path : bool url_path_decoder
+  val string_to_url_query : string url_query_encoder
+  val string_of_url_query : string url_query_decoder
+  val int_to_url_query : int url_query_encoder
+  val int_of_url_query : int url_query_decoder
+  val bool_to_url_query : bool url_query_encoder
+  val bool_of_url_query : bool url_query_decoder
+
+  val option_to_url_query :
+    'a url_query_encoder -> 'a option url_query_encoder
+
+  val option_of_url_query :
+    'a url_query_decoder -> 'a option url_query_decoder
+end
+
+val encode_path : Buffer.t -> string -> unit
+val encode_query_key : Buffer.t -> string -> unit
+val encode_query_value : Buffer.t -> string -> unit
+
+exception Method_not_allowed
+exception Invalid_query_parameter of string * string list
+
+type 'a router
+
+val make : (Dream.request -> 'a) Routes.router -> 'a router
+
+val handle : 'a router -> ('a -> Dream.handler) -> Dream.handler
+(** handle request given a router and a dispatcher *)
+
+val route :
+  'a router ->
+  Dream.request ->
+  [ `Ok of 'a
+  | `Not_found
+  | `Method_not_allowed
+  | `Invalid_query_parameter of string * string list ]
+(** route request given a router *)
diff --git a/ppx_router_test.ml b/ppx_router_test.ml
new file mode 100644
index 0000000..e3cba40
--- /dev/null
+++ b/ppx_router_test.ml
@@ -0,0 +1 @@
+let () = Ppxlib.Driver.standalone ()
diff --git a/test/dune b/test/dune
new file mode 100644
index 0000000..0884b45
--- /dev/null
+++ b/test/dune
@@ -0,0 +1,7 @@
+(executable
+  (name test)
+  (libraries dream)
+  (preprocess (pps ppx_router)))
+
+(cram
+  (deps ./test.exe))
diff --git a/test/test.ml b/test/test.ml
new file mode 100644
index 0000000..7ee1f1b
--- /dev/null
+++ b/test/test.ml
@@ -0,0 +1,70 @@
+type modifier = Uppercase | Lowercase
+
+let rec modifier_of_url_query = function
+  | [] -> None
+  | [ "uppercase" ] -> Some Uppercase
+  | [ "lowercase" ] -> Some Lowercase
+  | _ :: rest -> modifier_of_url_query rest (* last wins, if multiple *)
+
+let modifier_to_url_query = function
+  | Uppercase -> [ "uppercase" ]
+  | Lowercase -> [ "lowercase" ]
+
+module Routes = struct
+  open Ppx_router_runtime.Types
+
+  type t =
+    | Home [@GET "/"]
+    | Hello of { name : string; modifier : modifier option }
+        [@GET "/hello/:name"]
+  [@@deriving router]
+end
+
+let handler =
+  Routes.handle (fun route _req ->
+      match route with
+      | Home -> Dream.html "HOME PAGE"
+      | Hello { name; modifier } ->
+          let name =
+            match modifier with
+            | None -> name
+            | Some Uppercase -> String.uppercase_ascii name
+            | Some Lowercase -> String.lowercase_ascii name
+          in
+          let greeting = Printf.sprintf "Hello, %s!" name in
+          Dream.html greeting)
+
+let run () = Dream.run @@ Dream.logger @@ handler
+
+let test () =
+  print_endline "# TESTING HREF GENERATION";
+  print_endline (Routes.href Routes.Home);
+  print_endline
+    (Routes.href (Routes.Hello { name = "world"; modifier = None }));
+  print_endline
+    (Routes.href
+       (Routes.Hello { name = "world"; modifier = Some Uppercase }));
+  print_endline "# TESTING ROUTE MATCHING GENERATION";
+  let test_req method_ target =
+    print_endline
+      (Printf.sprintf "## %s %s" (Dream.method_to_string method_) target);
+    Lwt_main.run
+      (let open Lwt.Infix in
+       let req = Dream.request ~method_ ~target "" in
+       handler req >>= fun resp ->
+       Dream.body resp >>= fun body ->
+       print_endline body;
+       Lwt.return ())
+  in
+  test_req `GET "/";
+  test_req `GET "/hello/world";
+  test_req `GET "/hello/world?modifier=uppercase"
+
+let () =
+  match Sys.argv.(1) with
+  | exception Invalid_argument _ -> run ()
+  | "run" -> run ()
+  | "test" -> test ()
+  | _ ->
+      prerr_endline "unknown subcommand";
+      exit 1
diff --git a/test/test.t b/test/test.t
new file mode 100644
index 0000000..4a7bb43
--- /dev/null
+++ b/test/test.t
@@ -0,0 +1,13 @@
+
+  $ ./test.exe test
+  # TESTING HREF GENERATION
+  /
+  /hello/world
+  /hello/world?modifier=uppercase
+  # TESTING ROUTE MATCHING GENERATION
+  ## GET /
+  HOME PAGE
+  ## GET /hello/world
+  Hello, world!
+  ## GET /hello/world?modifier=uppercase
+  Hello, WORLD!