feat(fun/🕰️): get the time as an emoji clock face r/2633

This small tool prints the current time rounded to half-hour precision
as an emoji clock face and exists. It can use both the local time zone
and UTC. Additionally it supports a pseudo dot time format.

Via fun.🕰️.lib we reexpose the internal library which allows conversion
from LOCAL-TIME:TIMESTAMP to an emoji clock face — maybe we'll want to
integrate this into //web/panettone?

//fun/🕰️ is the spritual (and actual) successor to
<https://github.com/sternenseemann/unicode_clock>.

It likely only works in SBCL due to its heavy usage of unicode symbol
names.

Change-Id: I44204107a14f99b04b0c5290d88e8659f013f423
Reviewed-on: https://cl.tvl.fyi/c/depot/+/3164
Tested-by: BuildkiteCI
Reviewed-by: tazjin <mail@tazj.in>

4 files changed, 162 insertions, 0 deletions

diff --git a/fun/🕰️/OWNERS b/fun/🕰️/OWNERS
new file mode 100644
index 000000000000..f16dd105d761
--- /dev/null
+++ b/fun/🕰️/OWNERS
@@ -0,0 +1,3 @@
+inherited: true
+owners:
+  - sterni
diff --git a/fun/🕰️/bin.lisp b/fun/🕰️/bin.lisp
new file mode 100644
index 000000000000..8bd8aa136d7d
--- /dev/null
+++ b/fun/🕰️/bin.lisp
@@ -0,0 +1,91 @@
+(defpackage 🕰️.bin
+  (:shadow :describe)
+  (:use :cl :opts)
+  (:import-from :uiop :quit)
+  (:import-from :local-time
+   :now :timestamp-subtimezone :+utc-zone+
+   :*default-timezone* :define-timezone)
+  (:import-from :klatre :format-dottime-offset)
+  (:import-from :🕰️ :⌚)
+  (:export :🚂))
+
+(in-package :🕰️.bin)
+(declaim (optimize (safety 3)))
+
+(opts:define-opts
+  (:name :help
+   :description "Print this help text"
+   :short #\h
+   :long "help")
+  (:name :dot-time
+   :description "Use pseudo dot-time format (implies -u)"
+   :short #\d
+   :long "dot-time")
+  (:name :utc
+   :description "Display time in UTC instead of local time"
+   :short #\u
+   :long "utc")
+  (:name :no-newline
+   :description "Don't print a trailing newline"
+   :short #\n
+   :long "no-newline"))
+
+(defun make-slash-terminated (str)
+  (if (eq (char str (1- (length str))) #\/)
+    str
+    (concatenate 'string str "/")))
+
+; TODO(sterni): upstream this into local-time
+(defun setup-default-timezone ()
+  (let* ((tz (uiop:getenv "TZ"))
+         (tz-dir (uiop:getenv "TZDIR"))
+         (tz-file (if (and tz tz-dir)
+                    (merge-pathnames
+                      (pathname tz)
+                      (pathname (make-slash-terminated tz-dir)))
+                    (pathname "/etc/localtime"))))
+    (handler-case
+      (define-timezone *default-timezone* tz-file :load t)
+      (t () (setf *default-timezone* +utc-zone+)))))
+
+
+(defun 🚂 ()
+  (let ((ts (now)))
+    (multiple-value-bind (options free-args)
+      (handler-case (opts:get-opts)
+        ; only handle subset of conditions that can happen here
+        (opts:unknown-option (c)
+          (format t "error: unknown option ~s~%" (opts:option c))
+          (quit 100)))
+
+      ; check if we have any free args we don't know what to do with
+      (when (> (length free-args) 0)
+        (write-string "error: unexpected command line argument(s): ")
+        (loop for arg in free-args
+              do (progn (write-string arg) (write-char #\space)))
+        (write-char #\newline)
+        (quit 100))
+
+      ; print help and exit
+      (when (getf options :help)
+        (opts:describe :usage-of "🕰️")
+        (quit 0))
+
+      ; reinit *default-timezone* as it is cached from compilation
+      (setup-default-timezone)
+      ; dot-time implies UTC, naturally
+      (when (getf options :dot-time)
+        (setf (getf options :utc) t))
+      ; print clock face
+      (format t "~A" (⌚ ts (if (getf options :utc)
+                               local-time:+utc-zone+
+                               local-time:*default-timezone*)))
+      ; render dot-time offset if necessary
+      (when (getf options :dot-time)
+        (multiple-value-bind (offset-secs _dst _name)
+          (timestamp-subtimezone ts local-time:*default-timezone*)
+          (write-string
+            (format-dottime-offset (round (/ offset-secs 3600))))))
+      ; write newline if necessary
+      (when (not (getf options :no-newline))
+        (write-char #\newline)))))
diff --git a/fun/🕰️/default.nix b/fun/🕰️/default.nix
new file mode 100644
index 000000000000..d6fd5fc35ef6
--- /dev/null
+++ b/fun/🕰️/default.nix
@@ -0,0 +1,36 @@
+{ depot, ... }:
+
+let
+  inherit (depot.nix)
+    buildLisp
+    ;
+
+  lib = buildLisp.library {
+    name = "lib🕰️";
+    deps = [
+      depot.third_party.lisp.local-time
+    ];
+
+    srcs = [
+      ./lib.lisp
+    ];
+  };
+
+  bin = buildLisp.program {
+    name = "🕰️";
+    deps = [
+      depot.third_party.lisp.unix-opts
+      depot.lisp.klatre
+      (buildLisp.bundled "uiop")
+      lib
+    ];
+
+    srcs = [
+      ./bin.lisp
+    ];
+
+    main = "🕰️.bin:🚂";
+  };
+in bin // {
+  inherit lib;
+}
diff --git a/fun/🕰️/lib.lisp b/fun/🕰️/lib.lisp
new file mode 100644
index 000000000000..d23db033743e
--- /dev/null
+++ b/fun/🕰️/lib.lisp
@@ -0,0 +1,32 @@
+(defpackage 🕰️
+  (:use :cl)
+  (:import-from :local-time
+   :timestamp-subtimezone :*default-timezone* :sec-of)
+  (:export :⌚))
+
+(in-package :🕰️)
+(declaim (optimize (safety 3)))
+
+(defparameter *clock-emojis*
+  (vector #\🕛 #\🕧   ; 00:00 - 00:30
+          #\🕐 #\🕜   ; 01:00 - 01:30
+          #\🕑 #\🕝   ; 00:00 - 00:30
+          #\🕒 #\🕞   ; 00:00 - 00:30
+          #\🕓 #\🕟   ; 00:00 - 00:30
+          #\🕔 #\🕠   ; 00:00 - 00:30
+          #\🕕 #\🕡   ; 00:00 - 00:30
+          #\🕖 #\🕢   ; 00:00 - 00:30
+          #\🕗 #\🕣   ; 00:00 - 00:30
+          #\🕘 #\🕤   ; 00:00 - 00:30
+          #\🕙 #\🕥   ; 00:00 - 00:30
+          #\🕚 #\🕦)) ; 11:00 - 11:30
+
+(defun ⌚ (timestamp &optional (tz *default-timezone*))
+  "Convert a LOCAL-TIME:TIMESTAMP into the nearest Unicode clock face.
+  Use TZ (which defaults to LOCAL-TIME:*DEFAULT-TIMEZONE*) to determine
+  the UTC offset to factor when determining the local clock face."
+  (let* ((offset (multiple-value-bind (offset-secs _dst _name)
+                   (timestamp-subtimezone timestamp tz)
+                   offset-secs))
+         (secs (+ (sec-of timestamp) offset)))
+    (elt *clock-emojis* (mod (round (/ secs 1800)) 24))))