diff --git a/js/dispatch_js.ml b/js/dispatch_js.ml index 608f629..051f3e2 100644 --- a/js/dispatch_js.ml +++ b/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 diff --git a/js/dispatch_js.mli b/js/dispatch_js.mli index 9ece5fb..15fb676 100644 --- a/js/dispatch_js.mli +++ b/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 diff --git a/lib/dispatch.ml b/lib/dispatch.ml index 38ef6da..2b475ef 100644 --- a/lib/dispatch.ml +++ b/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 diff --git a/lib/dispatch.mli b/lib/dispatch.mli index d533102..27b4f6c 100644 --- a/lib/dispatch.mli +++ b/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 diff --git a/test/test_dispatch.ml b/test/test_dispatch.ml index 62f6b4b..c5fe263 100644 --- a/test/test_dispatch.ml +++ b/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 () ->