diff --git a/README.md b/README.md index a6523bb..7896a40 100644 --- a/README.md +++ b/README.md @@ -55,6 +55,48 @@ val print_route : int -> string = - : string = "user/12/add" ``` +It is possible to define custom patterns that can be used for matching. + +```ocaml +# open Routes;; +# type shape = Circle | Square +type shape = Circle | Square + +# let shape_of_string = function "circle" -> Some Circle | "square" -> Some Square | _ -> None +val shape_of_string : string -> shape option = + +# let shape_to_string = function Circle -> "circle" | Square -> "square" +val shape_to_string : shape -> string = + +# let shape = pattern shape_to_string shape_of_string +val shape : ('_weak1, '_weak2) path -> (shape -> '_weak1, '_weak2) path = + + +# let process_shape (s : shape) = shape_to_string s +val process_shape : shape -> string = + +# let route () = s "shape" / shape / s "create" /? nil +val route : unit -> (shape -> '_weak3, '_weak3) path = + +# sprintf route +- : shape -> string = + +# sprintf route Square +- : string = "shape/square/create" + +# let router = one_of [ None, route @--> process_shape ] +val router : string router = + +# match' ~target:"/shape/circle/create" router +- : string option = Some "circle" + +# match' ~target:"/shape/square/create" router +- : string option = Some "square" + +# match' ~target:"/shape/triangle/create" router +- : string option = None +``` + ## Installation ###### To use the version published on opam: diff --git a/src/routes.ml b/src/routes.ml index ff9bf4c..bd59fe8 100644 --- a/src/routes.ml +++ b/src/routes.ml @@ -132,6 +132,7 @@ type 'b router = ; any_method : 'b route PatternTrie.t } +let pattern to_ from_ r = Conv (conv to_ from_, r) let empty_router = { method_routes = Method.M.empty; any_method = PatternTrie.empty } let ( @--> ) r handler = Route (r (), handler) let s w r = Match (w, r) diff --git a/src/routes.mli b/src/routes.mli index 96881dc..2b2bae6 100644 --- a/src/routes.mli +++ b/src/routes.mli @@ -37,6 +37,12 @@ type ('a, 'b) path type 'b route type 'b router +val pattern + : ('c -> string) + -> (string -> 'c option) + -> ('a, 'b) path + -> ('c -> 'a, 'b) path + val int : ('a, 'b) path -> (int -> 'a, 'b) path val int32 : ('a, 'b) path -> (int32 -> 'a, 'b) path val int64 : ('a, 'b) path -> (int64 -> 'a, 'b) path