Merge pull request #26 from inhabitedtype/constructor

constructor: add a create function

js/dispatch_js.ml

@@ -32,14 +32,3 @@ let dispatch_on_fragment ?(on_failure=default_on_failure) ?(default="/") routes
     frag_loop
   | current ->
     go current >>= fun _ -> frag_loop
-
-module DSL = struct
-  let convert routes =
-    List.map (fun (m, x) ->
-      let ts, t = Dispatch.of_dsl m in
-      ts, t, x)
-    routes
-
-  let dispatch_on_fragment ?on_failure ?default routes =
-    dispatch_on_fragment ?on_failure ?default (convert routes)
-end

js/dispatch_js.mli

@@ -36,22 +36,13 @@
     Dispatch_js makes it easy for js_of_ocaml applications to monitor and react
     to changes in URI fragments. *)
 
-open Dispatch
-
-val dispatch_on_fragment :
-  ?on_failure:(string -> unit Lwt.t) -> ?default:string ->
-  unit Lwt.t route list -> unit Lwt.t
+val dispatch_on_fragment
+  :  ?on_failure:(string -> unit Lwt.t)
+  -> ?default:string
+  -> unit Lwt.t Dispatch.t
+  -> unit Lwt.t
 (** [dispatch_on_fragment ?on_failure ?default routes] will monitor the URL
     fragment and dispatch to the appropriate hander in [routes]. In the event
     that the fragment does not match any routes, [on_failure] will be called,
     if provided, with the fragment. On setup the fragment will be set to
     [default], or ["/"] if no default is provided. *)
-
-module DSL : sig
-
-  val dispatch_on_fragment : 
-    ?on_failure:(string -> unit Lwt.t) -> ?default:string ->
-    unit Lwt.t DSL.route list -> unit Lwt.t
-  (** [dispatch_on_fragment ?on_failure ?default routes] is the same as the
-      non-DSL version with the exception of the route type. *)
-end

lib/dispatch.ml

@@ -40,6 +40,10 @@ type typ =
 type assoc = (string * string) list
 type 'a route = (tag * string) list * typ * (assoc -> string option -> 'a)
 
+type 'a t = 'a route list
+
+let create t = t
+
 let path_split path =
   (* NOTE(seliopou): This was implemented manually to minimize dependencies for
    * js_of_ocaml. Ain't nobody got time for another regular expression library
@@ -129,15 +133,9 @@ let dispatch_exn routes path =
 module DSL = struct
   type 'a route = string * (assoc -> string option -> 'a)
 
-  let convert routes =
+  let create routes =
     List.map (fun (m, x) ->
       let ts, t = of_dsl m in
       ts, t, x)
     routes
-
-  let dispatch routes =
-    dispatch (convert routes)
-
-  let dispatch_exn routes =
-    dispatch_exn (convert routes)
 end

lib/dispatch.mli

@@ -68,8 +68,12 @@ type 'a route = (tag * string) list * typ * (assoc -> string option -> 'a)
     route match, the matching information will be passed to the handler to
     produce a value of tyoe ['a] that will be returned. *)
 
-val dispatch     : 'a route list -> string -> 'a option
-val dispatch_exn : 'a route list -> string -> 'a
+type 'a t
+
+val create : 'a route list -> 'a t
+
+val dispatch     : 'a t -> string -> 'a option
+val dispatch_exn : 'a t -> string -> 'a
 (** [dispatch routes path] iterates through [routes] and selects the first one
     that matches [path]. It then applies the route handler to any component
     mappings and trailing path components (in the case of a prefix match) and
@@ -104,6 +108,5 @@ module DSL : sig
   # of_dsk "/user/:id/settings";;
     = ([`Lit, "user"; `Var, "id"; `Lit, "settings"], `Exact) v} *)
 
-  val dispatch     : 'a route list -> string -> 'a option
-  val dispatch_exn : 'a route list -> string -> 'a
+  val create : 'a route list -> 'a t
 end

test/test_dispatch.ml

@@ -44,29 +44,31 @@ open Alcotest
 
 let assoc = list (pair string string)
 
-open Dispatch.DSL
+open Dispatch
 
 let literals = 
   "literals", [
     "base cases", `Quick, begin fun () ->
-      let t0, t1 = ["/", fun _ _ -> ()], ["", fun _ _ -> ()] in
+      let t0, t1 = DSL.create ["/", fun _ _ -> ()], DSL.create ["", fun _ _ -> ()] in
+      let empty = DSL.create [] in
       let check = Alcotest.check (option unit) in
       let test_ok  ~msg tbl p = check msg (dispatch tbl p) (Some ()) in
       let test_err ~msg tbl p = check msg (dispatch tbl p) None in
-      test_err [] "/"     ~msg:"empty table produces errors";
-      test_ok  t0 "/"     ~msg:"empty path string maps to root";
-      test_ok  t1 ""      ~msg:"empty route path matches root";
-      test_err t0 "/foo"  ~msg:"root entry won't dispatch others";
+      test_err empty "/"     ~msg:"empty table produces errors";
+      test_ok  t0    "/"     ~msg:"empty path string maps to root";
+      test_ok  t1    ""      ~msg:"empty route path matches root";
+      test_err t0    "/foo"  ~msg:"root entry won't dispatch others";
     end;
     "overlaping paths", `Quick, begin fun () ->
       let t0 =
-        [ ("/foo"    , base_path "/foo")
-        ; ("/foo/bar", base_path "/foo/bar")
-        ; ("/foo/baz", base_path "/foo/baz")
-        ; ("/bar/baz", base_path "/bar/baz")
-        ; ("/bar/foo", base_path "/bar/foo")
-        ; ("/bar"    , base_path "/bar")
-        ]
+        DSL.create
+          [ ("/foo"    , base_path "/foo")
+          ; ("/foo/bar", base_path "/foo/bar")
+          ; ("/foo/baz", base_path "/foo/baz")
+          ; ("/bar/baz", base_path "/bar/baz")
+          ; ("/bar/foo", base_path "/bar/foo")
+          ; ("/bar"    , base_path "/bar")
+          ]
       in
       let check = Alcotest.check (option string) in
       let test_ok ~msg p = check msg (dispatch t0 p) (Some p) in
@@ -80,10 +82,11 @@ let params =
   "params", [
     "base cases", `Quick, begin fun () ->
       let t0 =
-        [ ("/foo/:id"         , param_path "id")
-        ; ("/foo/:id/:bar"    , param_path "bar")
-        ; ("/foo/:id/bar/:baz", param_path "baz")
-        ]
+        DSL.create
+          [ ("/foo/:id"         , param_path "id")
+          ; ("/foo/:id/:bar"    , param_path "bar")
+          ; ("/foo/:id/bar/:baz", param_path "baz")
+          ]
       in
       let check = Alcotest.check (option string) in
       let test_ok ~msg p v = check msg (dispatch t0 p) (Some v) in
@@ -93,9 +96,10 @@ let params =
     end;
     "variable ordering", `Quick, begin fun () ->
       let t0 =
-        [ ("/test/:z/:x/:y/"      , params)
-        ; ("/test/:x/:y/order/:z/", params)
-        ]
+        DSL.create
+          [ ("/test/:z/:x/:y/"      , params)
+          ; ("/test/:x/:y/order/:z/", params)
+          ]
       in
       let check = Alcotest.check (option assoc) in
       let test_ok ~msg p v = check msg (dispatch t0 p) (Some v) in
@@ -109,7 +113,7 @@ let params =
 
 let wildcards =
   "wildcard", [
-    let t0 = ["/foo/*", disp_path] in
+    let t0 = DSL.create ["/foo/*", disp_path] in
     let check = Alcotest.check (option string) in
     let test_ok ~msg p v = check msg (dispatch t0 p) (Some v) in
     "base cases", `Quick, begin fun () ->