Reconstruct_Route.ml

exception RouteDoesNotMatch
exception MalformedRouteString of string
exception MalformedQueryString of string
exception MalformedQueryParameter of string* string* exn

type 'ty path =
  | End: unit path
  | Constant: string* 'ty path -> 'ty path
  | String: string* 'ty path -> (string* 'ty) path
  | Int: string* 'ty path -> (int* 'ty) path
  | Float: string* 'ty path -> (float* 'ty) path
  | Wildcard: 'ty path -> 'ty path
  | Custom: string* (string -> 'a)* 'ty path -> ('a* 'ty) path
let rec evalPath : 't . 't path -> string list -> 't= fun (type t) ->
  (fun route  ->
     fun parts  ->
       match (route, parts) with
       | (End ,[]) -> ()
       | (_,[]) -> raise RouteDoesNotMatch
       | (End ,_) -> raise RouteDoesNotMatch
       | (((Constant (value,tl))[@explicit_arity ]),str::next) when
           value = str -> evalPath tl next
       | (Constant _,_) -> raise RouteDoesNotMatch
       | (((String (_,tl))[@explicit_arity ]),str::next) ->
           (str, (evalPath tl next))
       | (((Int (_,tl))[@explicit_arity ]),str::next) ->
           let value =
             try int_of_string str
             with | Failure _ -> raise RouteDoesNotMatch in
           (value, (evalPath tl next))
       | (((Float (_,tl))[@explicit_arity ]),str::next) ->
           let value =
             try float_of_string str
             with | Failure _ -> raise RouteDoesNotMatch in
           (value, (evalPath tl next))
       | (((Wildcard (tl))[@explicit_arity ]),_::next) ->
           (try evalPath tl next
            with
            | RouteDoesNotMatch  ->
                evalPath ((Wildcard (tl))[@explicit_arity ]) next)
       | (((Custom (_,parser,tl))[@explicit_arity ]),str::next) ->
           let value = try parser str with | _ -> raise RouteDoesNotMatch in
           (value, (evalPath tl next)) : t path -> string list -> t)
let a =
  ((Constant
      ("hello",
        ((String ("world", ((Int ("age", End))[@explicit_arity ])))[@explicit_arity
                                                                    ])))
  [@explicit_arity ])
let b = evalPath a ["hello"; "nick"; "24"]