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

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>
This commit is contained in:
sterni 2021-05-29 16:02:00 +02:00
parent f60d174591
commit 8418e01a84
4 changed files with 162 additions and 0 deletions

3
fun/🕰️/OWNERS Normal file
View file

@ -0,0 +1,3 @@
inherited: true
owners:
- sterni

91
fun/🕰️/bin.lisp Normal file
View file

@ -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)))))

36
fun/🕰️/default.nix Normal file
View file

@ -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;
}

32
fun/🕰️/lib.lisp Normal file
View file

@ -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))))