4 files changed, 111 insertions(+), 14 deletions(-)

M lib/cgi.ml
M lib/geohash.ml
M lib/route.ml
M test/route_test.ml

@@ 86,17 86,18 @@ let request_from_env () =
   try
     Ok
       {
-        host = Os.getenv_safe ~default:(Os.getenv "SERVER_NAME") "HTTP_HOST";
-        http_cookie = Os.getenv_safe ~default:"" "HTTP_COOKIE";
-        path_info = Os.getenv_safe ~default:"" "PATH_INFO";
-        query_string = Os.getenv_safe ~default:"" "QUERY_STRING";
-        request_method = Os.getenv "REQUEST_METHOD";
-        (* request_uri = Os.getenv "REQUEST_URI"; *)
+        host =
+          "HTTP_HOST" |> Os.getenv_safe ~default:("SERVER_NAME" |> Os.getenv);
+        http_cookie = "HTTP_COOKIE" |> Os.getenv_safe ~default:"";
+        path_info = "PATH_INFO" |> Os.getenv_safe ~default:"";
+        query_string = "QUERY_STRING" |> Os.getenv_safe ~default:"";
+        request_method = "REQUEST_METHOD" |> Os.getenv;
+        (* request_uri = "REQUEST_URI" |> Os.getenv ; *)
         scheme =
-          (match Os.getenv_safe ~default:"" "HTTPS" with
+          (match "HTTPS" |> Os.getenv_safe ~default:"" with
           | "on" -> "https"
           | _ -> "http");
-        script_name = Os.getenv "SCRIPT_NAME";
-        server_port = Os.getenv "SERVER_PORT";
+        script_name = "SCRIPT_NAME" |> Os.getenv;
+        server_port = "SERVER_PORT" |> Os.getenv;
       }
   with Not_found -> Error "Not Found."

@@ 27,7 27,7 @@ open Optint.Int63
 (*
  * 60 bits are fine, because
  * - 12 geohash characters equal 60 bit
- * - more chars would overflow 64 bit
+ * - more chars would overflow 64 bit anyway
  * - ocaml has efficient int63, enough for 60 bits
  *)
 

@@ 11,17 11,49 @@
 module P = struct
   open Tyre
 
-  let lat_lon_pair = float <&> pcre "([,; +]|%2C|%3B|%20)+" *> float
+  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 "′|%E2%80%B2" <* ws
+          <&> (float <* pcre "″|%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

@@ 31,4 31,68 @@ let test_qs () =
   | Error (`NoMatch (_, original)) -> assert (original != "")
   | _ -> assert false
 
-let () = test_qs ()
+let test_deg () =
+  (*
+  let la, lo =
+    "q=47.427%C2%B0,+13.059%C2%B0" |> coord_from_qs |> Result.get_ok
+  in
+  Printf.printf "test_deg %f, %f" la lo;
+  *)
+  assert (Ok (47.427, 13.059) = ("q=47.427%C2%B0,+13.059%C2%B0" |> coord_from_qs));
+  (* assert (Ok (47.427, 13.059) = ("q=47.427°, 13.059°" |> coord_from_qs)); *)
+  (* assert (
+     Ok (47.5440, 15.4396) = ("q=47° 25′ 37″ N, 13° 3′ 32″ O" |> coord_from_qs)); *)
+  let la, lo =
+    "q=47%C2%B0+25%E2%80%B2+37%E2%80%B3+N,+13%C2%B0+3%E2%80%B2+32%E2%80%B3+O"
+    |> coord_from_qs |> Result.get_ok
+  in
+  (* Printf.printf "%f,%f\n" la lo; *)
+  assert (47.427 -. la < 1e-1);
+  assert (13.059 -. lo < 1e-1);
+  let la', lo' =
+    "q=47%C2%B0+25%E2%80%B2+37.2%E2%80%B3+N,+13%C2%B0+3%E2%80%B2+32.4%E2%80%B3+E"
+    |> coord_from_qs |> Result.get_ok
+  in
+  (* Printf.printf "%f,%f\n" la' lo'; *)
+  assert (47.427 -. la' < 1e-1);
+  assert (13.059 -. lo' < 1e-1);
+  assert true
+
+let test_deg_min_sec () =
+  let open Tyre in
+  let dms =
+    let ws = pcre "( |\t|\\+|%20)*" in
+    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 "°" <* ws
+      <&> (float <* pcre "′" <* ws <&> (float <* pcre "″" <* ws))
+      <&> pcre "[NSEW]")
+    |> compile
+  in
+  let x = "47° 25′ 37″ N" |> exec dms |> Result.get_ok in
+  (* Printf.printf "%f" x; *)
+  assert (47.426944 -. x < 1.e-16);
+  let x' = "47° 25′ 37″ E" |> exec dms |> Result.get_ok in
+  (* Printf.printf "%f" x'; *)
+  assert (47.426944 -. x' < 1.e-16)
+
+let () =
+  test_qs ();
+  test_deg ();
+  test_deg_min_sec ();
+  assert true