5 files changed, 69 insertions(+), 41 deletions(-)

M bin/gen_link_flags.sh
A deploy.sh
M lib/cgi.ml
M lib/geohash.ml
M test/geohash_test.ml

@@ 4,7 4,7 @@
 case "$(uname -s)" in
   Darwin)
     # do not link statically on macos.
-    echo "()"
+    echo '()'
     ;;
   *)
     echo '(-ccopt "-static")'

@@ 0,0 1,30 @@
+#!/bin/sh
+# https://mro.name/geohash
+#
+cd "$(dirname "${0}")" || exit 1
+
+make clean
+make || exit 1
+
+readonly name="geohash"
+readonly ver="0.1"
+
+readonly src="_build/default/bin/${name}.exe"
+
+git_sha="$(sed -En '/git_sha/s/^.+"([0-9a-f]+)"/\1/gp' < bin/version.ml)"
+dst="${name}-v${ver}+${git_sha}-$(uname -s)-$(uname -m)"
+readonly git_sha dst
+
+chmod u+w "${src}"
+strip "${src}"
+file "${src}"
+
+readonly dir="/var/www/vhosts/dev.mro.name/pages/${name}"
+ssh c1 mkdir -p "${dir}" \
+  && rsync -avPz "${src}" c1:"${dir}/${dst}" \
+  && ssh c1 ls -Al "${dir}/${dst}" \
+  && exit 0
+
+echo rsync -avPz "$(pwd)/${src}" c1:"${dir}/${dst}"
+exit 1
+

@@ 84,10 84,9 @@ let request_uri req =
 (* Almost trivial. https://tools.ietf.org/html/rfc3875 *)
 let request_from_env () =
   try
-    let name = Os.getenv "SERVER_NAME" in
     Ok
       {
-        host = Os.getenv_safe ~default:name "HTTP_HOST";
+        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";

@@ 26,17 26,17 @@ open Optint.Int63
 
 (*
  * 60 bits are fine, because
- * - nobody uses 13 chars = 65 bit
  * - 12 geohash characters equal 60 bit
- * - ocaml has efficient int63 but not int64
+ * - more chars would overflow 64 bit
+ * - ocaml has efficient int63, enough for 60 bits
  *)
 
-(* wgs84 -> 30 bit geohash *)
+(* wgs84 -> 30 bit geohash. https://mmcloughlin.com/posts/geohash-assembly#implementation *)
 let quantize30 (lat, lng) =
   let f r x = Float.ldexp ((x /. r) +. 0.5) 30 |> of_float in
   (f 180. lat, f 360. lng)
 
-(* 30 bit geohash -> wgs84 *)
+(* 30 bit geohash -> wgs84. https://mmcloughlin.com/posts/geohash-assembly#implementation *)
 let dequantize30 (lat, lon) =
   let f r x = r *. (Float.ldexp (x |> to_float) (-30) -. 0.5) in
   (f 180. lat, f 360. lon)


@@ 53,33 53,28 @@ let x3333333333333333 = of_int64 0x3333333333333333L
 
 let x5555555555555555 = of_int64 0x3555555555555555L
 
-let spread x =
-  let f s m x' = m |> logand (x' |> logor (shift_left x' s)) in
-  x |> f 16 x0000ffff0000ffff |> f 8 x00ff00ff00ff00ff |> f 4 x0f0f0f0f0f0f0f0f
-  |> f 2 x3333333333333333 |> f 1 x5555555555555555
-
-let squash x =
-  let f s m x' = m |> logand (x' |> logor (shift_right x' s)) in
-  x |> logand x5555555555555555 |> f 1 x3333333333333333
-  |> f 2 x0f0f0f0f0f0f0f0f |> f 4 x00ff00ff00ff00ff |> f 8 x0000ffff0000ffff
-  |> f 16 x00000000ffffffff
-
-let interleave (x, y) = spread x |> logor (shift_left (spread y) 1)
-
-let deinterleave x = (squash x, squash (shift_right x 1))
-
-let alphabet = Bytes.of_string "0123456789bcdefghjkmnpqrstuvwxyz"
-
-let b32_int_to_char i = Bytes.get alphabet i
-
-let b32_int_of_char c =
-  (* if we want it fast, either do binary search or construct a sparse LUT from chars 0-z -> int *)
-  match c |> Bytes.index_opt alphabet with None -> Error c | Some i -> Ok i
+let interleave (x, y) =
+  let spread x =
+    let f s m x' = m |> logand (x' |> logor (shift_left x' s)) in
+    x |> f 16 x0000ffff0000ffff |> f 8 x00ff00ff00ff00ff
+    |> f 4 x0f0f0f0f0f0f0f0f |> f 2 x3333333333333333 |> f 1 x5555555555555555
+  in
+  spread x |> logor (shift_left (spread y) 1)
+
+let deinterleave x =
+  let squash x =
+    let f s m x' = m |> logand (x' |> logor (shift_right x' s)) in
+    x |> logand x5555555555555555 |> f 1 x3333333333333333
+    |> f 2 x0f0f0f0f0f0f0f0f |> f 4 x00ff00ff00ff00ff |> f 8 x0000ffff0000ffff
+    |> f 16 x00000000ffffffff
+  in
+  (squash x, squash (shift_right x 1))
 
-let x1f = of_int 0x1f
+let alphabet = "0123456789bcdefghjkmnpqrstuvwxyz" |> Bytes.of_string
 
 (* encode the chars * 5 low bits of x *)
 let base32_encode chars x =
+  let b32_int_to_char i = i |> Bytes.get alphabet and x1f = of_int 0x1f in
   let rec f i x' b =
     match i with
     | -1 -> b


@@ 90,7 85,10 @@ let base32_encode chars x =
   chars |> Bytes.create |> f (chars - 1) x |> Bytes.to_string
 
 let base32_decode hash =
-  let len = hash |> String.length in
+  let b32_int_of_char c =
+    (* if we want it fast, either do binary search or construct a sparse LUT from chars 0-z -> int *)
+    match c |> Bytes.index_opt alphabet with None -> Error c | Some i -> Ok i
+  and len = hash |> String.length in
   match len <= 12 with
   | false -> Error '_'
   | true ->


@@ 105,23 103,23 @@ let base32_decode hash =
       f 0 zero
 
 let encode chars wgs84 =
-  match 0 <= chars && chars <= 12 with
+  (* is the empty string a geohash? representing all earth? *)
+  match 1 <= chars && chars <= 12 with
   | false -> Error chars
   | true ->
       let h60 = wgs84 |> quantize30 |> interleave in
       Ok (shift_right h60 (60 - (5 * chars)) |> base32_encode chars)
 
-let error_with_precision bits =
+let error_with_precision bits factor =
   let latBits = bits / 2 in
   let lonBits = bits - latBits in
-  let latErr = Float.ldexp 180. (-latBits)
-  and lonErr = Float.ldexp 360. (-lonBits) in
+  let latErr = factor *. Float.ldexp 180. (-latBits)
+  and lonErr = factor *. Float.ldexp 360. (-lonBits) in
   (latErr, lonErr)
 
 let decode hash =
   Result.bind (base32_decode hash) (fun h60 ->
       let bits = 5 * String.length hash in
       let lat, lon = shift_left h60 (60 - bits) |> deinterleave |> dequantize30
-      and latE, lonE = error_with_precision bits in
-      let latE2, lonE2 = (latE *. 0.5, lonE *. 0.5) in
+      and latE2, lonE2 = error_with_precision bits 0.5 in
       Ok ((lat +. latE2, lon +. lonE2), (latE2, lonE2)))

@@ 83,7 83,8 @@ let test_base32_decode () =
   t 11 "ezs42" (of_int64 0xdfe082L);
   (* t 12 "u4pruydqqvj" (of_int64 0x6895bebccb5b71L); *)
   t 13 "zzs000000000" (of_int64 0x0fff000000000000L);
-  t 50 "zzzzzzzzzzzz" (of_int64 0x0FFFFFFFFFFFFFFFL)
+  t 50 "zzzzzzzzzzzz" (of_int64 0x0FFFFFFFFFFFFFFFL);
+  t 60 "" (of_int64 0x0L)
 
 let test_base32_encode () =
   let t i p a b =


@@ 109,13 110,13 @@ let test_encode_a () =
     a |> encode p |> Result.get_ok
     |> Assert2.equals_string (Printf.sprintf "test_encode_a #%d" i) b
   in
-  t 0 12 (27.988056, 86.925278) "tuvz4p141zc1";
+  t 1 12 (27.988056, 86.925278) "tuvz4p141zc1";
   t 10 12 (-25.382708, -49.265506) "6gkzwgjzn820";
   t 20 12 (57.649111, 10.407440) "u4pruydqqvjw";
   t 30 12 (47.879105, 12.634964) "u28brs0s0004";
   t 40 11 (47.879105, 12.634964) "u28brs0s000";
-  t 50 1 (47.879105, 12.634964) "u";
-  t 60 0 (47.879105, 12.634964) ""
+  t 50 1 (47.879105, 12.634964) "u"
+(* t 60 0 (47.879105, 12.634964) "" *)
 
 let test_decode_sunshine () =
   let t i a b =