From 58470ab46da07febe859f0cca8fbf88499ff6d86 Mon Sep 17 00:00:00 2001
From: Spiros Eliopoulos <spiros@inhabitedtype.com>
Date: Tue, 20 Oct 2015 10:46:07 -0400
Subject: [PATCH] var_order: return path parameters in the order they appear

Allow users to consistently pattern match on the path parameter
association list. Relying on ordering will make for less robust route
handlers, but sometimes that's ok.
---
 lib/dispatch.ml           |  4 ++--
 lib_test/test_dispatch.ml | 19 +++++++++++++++++--
 2 files changed, 19 insertions(+), 4 deletions(-)

diff --git a/lib/dispatch.ml b/lib/dispatch.ml
index 08d2b39..9aba7c4 100644
--- a/lib/dispatch.ml
+++ b/lib/dispatch.ml
@@ -97,8 +97,8 @@ let of_dsl str =
 let path_match ps0 ms0 =
   let rec loop ps ms acc =
     match ps, ms with
-    | []    , []  -> `Exact acc
-    | _     , []  -> `Partial (acc, ps)
+    | []    , []  -> `Exact (List.rev acc)
+    | _     , []  -> `Partial (List.rev acc, ps)
     | []    , _   -> `Failure (Printf.sprintf
       "unmatched pattern suffix: %s" (to_dsl (ms, `Exact)))
     | p::ps', (`Lit, l)::ms' ->
diff --git a/lib_test/test_dispatch.ml b/lib_test/test_dispatch.ml
index 04524e1..230ce66 100644
--- a/lib_test/test_dispatch.ml
+++ b/lib_test/test_dispatch.ml
@@ -32,12 +32,14 @@
   ----------------------------------------------------------------------------*)
 
 let base_path c _ _ = c
+let params vs _ = vs
 let param_path k ps _ = List.assoc k ps
 let disp_path _ r =
   match r with
   | None   -> ""
   | Some r -> r
 
+
 open OUnit
 open Dispatch.DSL
 open Result
@@ -125,6 +127,18 @@ let keys () =
     end;
 ;;
 
+let var_order () =
+  let table =
+    [ ("/test/:z/:x/:y/", params)
+    ; ("/test/:x/:y/order/:z/", params) ]
+  in
+  "return path parameters in the order they appear"
+    @? begin match dispatch table "/test/foo/bar/order/baz" with
+      | Ok ["x", "foo"; "y", "bar"; "z", "baz" ] -> true
+      | _                                        -> false
+    end
+;;
+
 let wildcard () =
   let table = ["/foo/*", disp_path] in
   "a trailing wildcard pattern matches just the prefix"
@@ -156,9 +170,10 @@ let _ =
     "single" >:: single;
     "overlap" >:: overlap;
     "keys" >:: keys;
-    "wildcard" >:: wildcard
+    "var order" >:: var_order;
+    "wildcard" >:: wildcard;
   ] in
-  let suite = (Printf.sprintf "test logic") >::: tests in
+  let suite = (Printf.sprintf "test dispatch") >::: tests in
   let verbose = ref false in
   let set_verbose _ = verbose := true in
   Arg.parse