geohash/lib/route.ml

(*
 * Parse path and Query string 
 *
 * We have either a 
 *
 * path: /<geohash>/<format>
 * or
 * query_string: ?q=<lat><sep><lon>
 *)

module P = struct
  open Tyre

  let ws = pcre "( |\t|\\+|%20)*"

  let deg_min_sec =
    conv
      (fun ((d, (m, s)), he) ->
         let si = match he with
           | "S" | "W" -> -1.
           | _ -> 1.
         and d' = d
         and m' = m
         and s' = s in
         si *. (d' +. ((m' +. (s' /. 60.)) /. 60.)))
      (fun v ->
         let si = if v < 0. then -1. else 1. in
         let d' = v *. si in
         let d = d' |> floor in
         let dr = d' -. d in
         let m' = dr *. 60. in
         let m = m' |> floor in
         let mr' = m' -. m in
         let se = mr' *. 60. in
         ((d, (m, se)), if si < 0. then "S" else "N"))
      (float <* pcre "°|%C2%B0" <* ws
       <&> (float <* pcre "'|′|%27|%E2%80%B2" <* ws
            <&> (float <* pcre "\"|″|%22|%E2%80%B3" <* ws))
       <&> pcre "[NSEOW]")

  let dec = float <* opt (str "%C2%B0")

  let deg =
    conv
      (fun x -> match x with
         | `Left v | `Right v -> v)
      (fun y -> (* write decimal by default *) `Left y)
      (dec <|> deg_min_sec)

  let sep = pcre "([,; +]|%20|%2C|%3B)+"
  let lat_lon_pair = deg <&> sep *> deg

  let geo_uri =
    opt (pcre "geo(:|%3A)") *> lat_lon_pair
    <* opt (pcre "(\\?|%3F)z(=|%3D)[0-9]+")

  let lat_lon = compile (geo_uri <* stop)
  let qs_lat_lon = compile (str "q=" *> geo_uri <* stop)
end

let coord_from_qs qs = qs |> Tyre.exec P.qs_lat_lon
let coord_from_s s = s |> Tyre.exec P.lat_lon