Merge pull request #24 from inhabitedtype/option-for-result

Use option instead of result for dispatch return value

README.md

@@ -63,8 +63,8 @@ let handler request =
     ; "/hello/:who/", hello_handler
   ] in
   match DSL.dispatch table request.path with
-  | Result.Ok handler -> handler request
-  | Result.Error _    -> "Not found!"
+  | Some handler -> handler request
+  | None         -> "Not found!"
 ;;
 
 let _ =

dispatch-js.opam

@@ -9,7 +9,6 @@ depends: [
   "dune" {build & >= "1.0"}
   "dispatch" {>="0.4.0"}
   "js_of_ocaml-lwt" {>= "3.5.0"}
-  "result"
 ]
 build: [
   ["dune" "subst"] {pinned}

dispatch.opam

@@ -9,7 +9,6 @@ depends: [
   "ocaml" {>="4.03.0"}
   "alcotest" {with-test & > "0.5.0"}
   "dune" {build & >= "1.0"}
-  "result"
 ]
 build: [
   ["dune" "subst"] {pinned}

js/dispatch_js.ml

@@ -1,19 +1,18 @@
 open Lwt
-open Result
 open Js_of_ocaml
 module Lwt_js_events = Js_of_ocaml_lwt.Lwt_js_events
 
-let dispatch_on_fragment ?on_failure ?(default="/") routes = 
-  let dispatch = Dispatch.dispatch routes in
-  let on_failure =
-    match on_failure with
-    | None   -> (fun msg -> print_endline msg; return_unit)
-    | Some f -> f
-  in
+let default_on_failure msg =
+  print_endline msg;
+  return_unit
+;;
+
+let dispatch_on_fragment ?(on_failure=default_on_failure) ?(default="/") routes =
+  let dispatch_exn = Dispatch.dispatch_exn routes in
   let go frag =
-    match dispatch frag with
-    | Error msg -> on_failure msg
-    | Ok    res -> res
+    match dispatch_exn frag with
+    | exception (Failure msg) -> on_failure msg
+    | handler                 -> handler
   in
   let frag_loop =
     Lwt_js_events.onhashchanges (fun e _ ->
@@ -27,11 +26,11 @@ let dispatch_on_fragment ?on_failure ?(default="/") routes =
     in
     go frag)
   in
-  let current = Url.Current.get_fragment () in
-  if current = "" then begin 
+  match Url.Current.get_fragment () with
+  | "" ->
     Url.Current.set_fragment default;
     frag_loop
-  end else 
+  | current ->
     go current >>= fun _ -> frag_loop
 
 module DSL = struct

lib/dispatch.ml

@@ -31,8 +31,6 @@
     POSSIBILITY OF SUCH DAMAGE.
   ----------------------------------------------------------------------------*)
 
-open Result
-
 type tag =
   [ `Lit | `Var ]
 
@@ -112,11 +110,11 @@ let path_match ps0 ms0 =
 let dispatch routes path =
   let ps0 = path_split path in
   let rec loop = function
-    | []          -> Error "no matching routes found"
+    | []          -> None
     | (ms, exact, f)::xs ->
       begin match exact, path_match ps0 ms with
-      | #typ   , `Exact assoc        -> Ok(f assoc None)
-      | `Prefix, `Partial(assoc, ps) -> Ok(f assoc (Some (String.concat "/" ps)))
+      | #typ   , `Exact assoc        -> Some(f assoc None)
+      | `Prefix, `Partial(assoc, ps) -> Some(f assoc (Some (String.concat "/" ps)))
       | `Exact , `Partial _          -> loop xs
       | _      , `Failure _          -> loop xs
       end
@@ -125,8 +123,8 @@ let dispatch routes path =
 
 let dispatch_exn routes path =
   match dispatch routes path with
-  | Ok x      -> x
-  | Error msg -> failwith msg
+  | Some x -> x
+  | None   -> failwith (Printf.sprintf "no matching route found: %s" path)
 
 module DSL = struct
   type 'a route = string * (assoc -> string option -> 'a)

lib/dispatch.mli

@@ -38,8 +38,6 @@
     used both for dispatching requests in a server, as well as handing changes
     to heirarchical fragments in a client-side application. *)
 
-open Result
-
 type tag = [ `Lit | `Var ]
 (** The type tag for a path component. [`Lit] indiciates that the component
    should match exactly, while [`Var] indicates that the component can be
@@ -70,13 +68,13 @@ 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, string) result
+val dispatch     : 'a route list -> string -> 'a option
 val dispatch_exn : 'a route list -> 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
     returns the result. If none of the [routes] matches [path], it will return
-    an [Error] result.
+    [None].
 
     [dispatch_exn routes path] behaves just like [dispatch routes path] except
     will raise an exception using [failwith] in the case of no matches. *)
@@ -106,6 +104,6 @@ module DSL : sig
   # of_dsk "/user/:id/settings";;
     = ([`Lit, "user"; `Var, "id"; `Lit, "settings"], `Exact) v} *)
 
-  val dispatch     : 'a route list -> string -> ('a, string) result
+  val dispatch     : 'a route list -> string -> 'a option
   val dispatch_exn : 'a route list -> string -> 'a
 end

test/test_dispatch.ml

@@ -32,8 +32,6 @@
   ----------------------------------------------------------------------------*)
 
 
-open Result
-
 let base_path c _ _ = c
 let params vs _ = vs
 let param_path k ps _ = List.assoc k ps
@@ -52,9 +50,9 @@ let literals =
   "literals", [
     "base cases", `Quick, begin fun () ->
       let t0, t1 = ["/", fun _ _ -> ()], ["", fun _ _ -> ()] in
-      let check = Alcotest.check (result unit pass) in
-      let test_ok  ~msg tbl p = check msg (dispatch tbl p) (Ok ()) in
-      let test_err ~msg tbl p = check msg (dispatch tbl p) (Error "_") 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";
@@ -70,8 +68,8 @@ let literals =
         ; ("/bar"    , base_path "/bar")
         ]
       in
-      let check = Alcotest.check (result string pass) in
-      let test_ok ~msg p = check msg (dispatch t0 p) (Ok p) in
+      let check = Alcotest.check (option string) in
+      let test_ok ~msg p = check msg (dispatch t0 p) (Some p) in
       test_ok "/foo"      ~msg:"leading pattern gets matched";
       test_ok "/bar"      ~msg:"trailing pattern gets matched";
       test_ok "/foo/baz"  ~msg:"prefix match does not shadow";
@@ -87,8 +85,8 @@ let params =
         ; ("/foo/:id/bar/:baz", param_path "baz")
         ]
       in
-      let check = Alcotest.check (result string pass) in
-      let test_ok ~msg p v = check msg (dispatch t0 p) (Ok v) in
+      let check = Alcotest.check (option string) in
+      let test_ok ~msg p v = check msg (dispatch t0 p) (Some v) in
       test_ok "/foo/1"          "1"   ~msg:"leading pattern matches";
       test_ok "/foo/1/test"    "test" ~msg:"prefix match does not shadow";
       test_ok "/foo/1/bar/one" "one"  ~msg:"interleaved keys and liters";
@@ -99,8 +97,8 @@ let params =
         ; ("/test/:x/:y/order/:z/", params)
         ]
       in
-      let check = Alcotest.check (result assoc pass) in
-      let test_ok ~msg p v = check msg (dispatch t0 p) (Ok v) in
+      let check = Alcotest.check (option assoc) in
+      let test_ok ~msg p v = check msg (dispatch t0 p) (Some v) in
       test_ok ~msg:"slashes not included in param"
         "/test/foo/bar/order/baz" ["x", "foo"; "y", "bar"; "z", "baz"];
       test_ok ~msg:"leading pattern matches"
@@ -112,8 +110,8 @@ let params =
 let wildcards =
   "wildcard", [
     let t0 = ["/foo/*", disp_path] in
-    let check = Alcotest.check (result string pass) in
-    let test_ok ~msg p v = check msg (dispatch t0 p) (Ok v) 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 () ->
       test_ok ~msg: "a trailing wildcard pattern matches just the prefix"
         "/foo" "";